/[MITgcm]/MITgcm/pkg/mdsio/mdsio_read_whalos.F
ViewVC logotype

Annotation of /MITgcm/pkg/mdsio/mdsio_read_whalos.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (hide annotations) (download)
Fri Sep 24 23:21:03 2010 UTC (13 years, 9 months ago) by gforget
Branch: MAIN
Changes since 1.1: +1 -8 lines
Moving global buffers to common block,
for the sake of a reduced memory footprint.

1 gforget 1.2 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.1 2010/09/24 18:39:35 gforget Exp $
2 gforget 1.1 C $fName: $
3    
4     #include "MDSIO_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: mds_read_whalos
8     C !INTERFACE:
9     subroutine mds_read_whalos(
10     I fName,
11     I len,
12     I filePrec,
13     I fid,
14     I n2d,
15     O fldRL,
16     I irec,
17     I mythid
18     & )
19    
20     C !DESCRIPTION: \bv
21     c ==================================================================
22     c SUBROUTINE mds_read_whalos
23     c ==================================================================
24     c o Read file that includes halos. The main purpose is for
25     c adjoint related "tape I/O". The secondary purpose is debugging.
26     c ==================================================================
27     c SUBROUTINE mds_read_whalos
28     c ==================================================================
29     C \ev
30    
31     C !USES:
32     implicit none
33    
34     c == global variables ==
35     #include "EEPARAMS.h"
36     #include "SIZE.h"
37     #include "PARAMS.h"
38     #ifdef ALLOW_WHIO
39     #include "MDSIO_BUFF_WH.h"
40     #endif
41    
42     C !INPUT/OUTPUT PARAMETERS:
43     c == routine arguments ==
44     c fName - extended tape fName.
45     c len - number of characters in fName.
46     c filePrec - number of bits per word in file (32 or 64).
47     c fid - file unit (its use is not implemented yet).
48     C n2d - size of the fldRL third dimension.
49     c fldRL - array to read.
50     c irec - record number to be written.
51     c mythid - number of the thread or instance of the program.
52    
53     integer mythid
54     character*(*) fName
55     integer len
56     integer fid
57     integer filePrec
58     integer n2d
59     integer length
60     integer irec
61     _RL fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
62     CEOP
63    
64     #ifdef ALLOW_WHIO
65     C !LOCAL VARIABLES:
66     c == local variables ==
67    
68     C sNxWh :: x tile size with halo included
69     C sNyWh :: y tile size with halo included
70     C pocNyWh :: processor sum of sNyWh
71     C gloNyWh :: global sum of sNyWh
72     INTEGER sNxWh
73     INTEGER sNyWh
74     INTEGER procNyWh
75     INTEGER gloNyWh
76     PARAMETER ( sNxWh = sNx+2*Olx )
77     PARAMETER ( sNyWh = sNy+2*Oly )
78     PARAMETER ( procNyWh = sNyWh*nSy*nSx )
79     PARAMETER ( gloNyWh = procNyWh*nPy*nPx )
80    
81     character*(MAX_LEN_FNAM) pfName
82     character*(MAX_LEN_MBUF) msgBuf
83     integer IL,pIL
84     integer bx,by
85    
86     integer length2d, length3d, length_of_rec
87     integer i2d, i3d
88     integer i,j,k,bi,bj,ii
89     integer dUnit, irec2d
90     LOGICAL iAmDoingIO
91    
92     _RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)
93    
94     c == functions ==
95     INTEGER ILNBLNK
96     INTEGER MDS_RECLEN
97     LOGICAL MASTER_CPU_IO
98     EXTERNAL ILNBLNK
99     EXTERNAL MDS_RECLEN
100     EXTERNAL MASTER_CPU_IO
101    
102     c == end of interface ==
103    
104     length2d=sNxWh*procNyWh
105     length3d=length2d*nr
106    
107     C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):
108     iAmDoingIO = MASTER_CPU_IO(myThid)
109     IF ( iAmDoingIO ) THEN
110     c get the unit and open file
111     CALL MDSFINDUNIT( dUnit, myThid )
112     IL = ILNBLNK( fName )
113     pIL = ILNBLNK( mdsioLocalDir )
114     IF ( pIL.EQ.0 ) THEN
115     pfName = fName
116     ELSE
117     WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)
118     ENDIF
119     pIL=ILNBLNK( pfName )
120     IF ( .NOT.useSingleCpuIO ) THEN
121     WRITE(pfName,'(2A,I3.3,A)') pfName(1:pIL),'.',myProcId,'.data'
122     length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
123     ELSE
124     WRITE(pfName,'(2A)') pfName(1:pIL),'.data'
125     length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
126     ENDIF
127     OPEN( dUnit, file=pfName, status='old',
128     & access='direct', recl=length_of_rec )
129     ENDIF
130    
131    
132     do i2d=1,n2d
133    
134     _BARRIER
135     IF ( iAmDoingIO ) THEN
136     irec2d=i2d+n2d*(irec-1)
137     IF ( .NOT.useSingleCpuIO ) then
138     IF (filePrec .EQ. precFloat32) THEN
139     READ(dUnit,rec=irec2d) fld2d_procbuff_r4
140     ELSE
141     READ(dUnit,rec=irec2d) fld2d_procbuff_r8
142     ENDIF
143     ELSE
144     IF (filePrec .EQ. precFloat32) THEN
145     READ(dUnit,rec=irec2d) fld2d_globuff_r4
146     ELSE
147     READ(dUnit,rec=irec2d) fld2d_globuff_r8
148     ENDIF
149     ENDIF
150     ENDIF
151     _BARRIER
152    
153     IF (filePrec .EQ. precFloat32) THEN
154     IF ( useSingleCpuIO ) then
155     CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
156     & fld2d_procbuff_r4,myThid)
157     CALL BAR2( myThid )
158     ENDIF
159     CALL MDS_PASS_WH_R4toRL( fld2d_procbuff_r4, fldRL,
160     & 1, i2d, n2d, 0, 0, .TRUE., myThid )
161     ELSE
162     IF ( useSingleCpuIO ) then
163     CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
164     & fld2d_procbuff_r8,myThid)
165     CALL BAR2( myThid )
166     ENDIF
167     CALL MDS_PASS_WH_R8toRL( fld2d_procbuff_r8, fldRL,
168     & 1, i2d, n2d, 0, 0, .TRUE., myThid )
169     ENDIF
170    
171     enddo
172    
173     IF ( iAmDoingIO ) THEN
174     CLOSE( dUnit )
175     ENDIF
176    
177     #endif
178    
179     return
180     end

  ViewVC Help
Powered by ViewVC 1.1.22