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

Diff of /MITgcm/pkg/mdsio/mdsio_read_field.F

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

revision 1.10 by jmc, Mon Jun 8 03:32:33 2009 UTC revision 1.17 by jmc, Tue Jun 7 22:33:35 2011 UTC
# Line 12  C !INTERFACE: Line 12  C !INTERFACE:
12       I   useCurrentDir,       I   useCurrentDir,
13       I   arrType,       I   arrType,
14       I   kSize,kLo,kHi,       I   kSize,kLo,kHi,
15       O   arr,       O   fldRL, fldRS,
16       I   irecord,       I   irecord,
17       I   myThid )       I   myThid )
18    
# Line 23  C fName     (string)  :: base name for f Line 23  C fName     (string)  :: base name for f
23  C filePrec  (integer) :: number of bits per word in file (32 or 64)  C filePrec  (integer) :: number of bits per word in file (32 or 64)
24  C useCurrentDir(logic):: always read from the current directory (even if  C useCurrentDir(logic):: always read from the current directory (even if
25  C                        "mdsioLocalDir" is set)  C                        "mdsioLocalDir" is set)
26  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: which array (fldRL/RS) to read into, either "RL" or "RS"
27  C kSize     (integer) :: size of third dimension: normally either 1 or Nr  C kSize     (integer) :: size of third dimension: normally either 1 or Nr
28  C kLo       (integer) :: 1rst vertical level (of array "arr") to read-in  C kLo       (integer) :: 1rst vertical level (of array fldRL/RS) to read-in
29  C kHi       (integer) :: last vertical level (of array "arr") to read-in  C kHi       (integer) :: last vertical level (of array fldRL/RS) to read-in
30  C arr       ( RS/RL ) :: array to read into, arr(:,:,kSize,:,:)  C fldRL       ( RL )  :: array to read into if arrType="RL", fldRL(:,:,kSize,:,:)
31    C fldRS       ( RS )  :: array to read into if arrType="RS", fldRS(:,:,kSize,:,:)
32  C irecord   (integer) :: record number to read  C irecord   (integer) :: record number to read
33  C myIter    (integer) :: time step number  C myIter    (integer) :: time step number
34  C myThid    (integer) :: thread identifier  C myThid    (integer) :: thread identifier
# Line 37  C  IF the file "fName.data" exists and f Line 38  C  IF the file "fName.data" exists and f
38  C  form "fName.xxx.yyy.data" exist. Currently, the meta-files are not  C  form "fName.xxx.yyy.data" exist. Currently, the meta-files are not
39  C  read because it is difficult to parse files in fortran.  C  read because it is difficult to parse files in fortran.
40  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
41  C  to floatPrec32 or floatPrec64. The precision or declaration of  C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL"
42  C  the array argument must be consistently described by the char*(2)  C  or "RS", selects which array is filled in, either fldRL or fldRS.
 C  string arrType, either "RS" or "RL".  
43  C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with  C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with
44  C  the option to only read and fill-in a sub-set of consecutive vertical  C  the option to only read and fill-in a sub-set of consecutive vertical
45  C  levels (from kLo to kHi) ; (kSize,kLo,kHi)=(1,1,1) implies a 2-D model  C  levels (from kLo to kHi) ; (kSize,kLo,kHi)=(1,1,1) implies a 2-D model
46  C  field and (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.  C  field and (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.
47  C irecord is the record number to be read and must be >= 1.  C irecord is the record number to be read and must be >= 1.
48  C The file data is stored in arr *but* the overlaps are *not* updated,  C The file data is stored in fldRL/RS *but* the overlaps are *not* updated,
49  C  i.e., an exchange must be called. This is because the routine is  C  i.e., an exchange must be called.
50  C  sometimes called from within a MASTER_THID region.  C
51    C- Multi-threaded: Only Master thread does IO (and MPI calls) and put data
52    C   to a shared buffer that any thread can get access to.
53    C- Convention regarding thread synchronisation (BARRIER):
54    C  A per-thread (or per tile) partition of the 2-D shared-buffer (sharedLocBuf_r4/r8)
55    C   is readily available => any access (e.g., by master-thread) to a portion
56    C   owned by an other thread is put between BARRIER (protected).
57    C  No thread partition exist for the 3-D shared buffer (shared3dBuf_r4/r8).
58    C   Therefore, the 3-D buffer is considered to be owned by master-thread and
59    C   any access by other than master thread is put between BARRIER (protected).
60  C  C
61  C Created: 03/16/99 adcroft@mit.edu  C Created: 03/16/99 adcroft@mit.edu
62  CEOP  CEOP
# Line 64  C Global variables / common blocks Line 73  C Global variables / common blocks
73  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
74  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
75  #include "EEBUFF_SCPU.h"  #include "EEBUFF_SCPU.h"
76    #ifdef ALLOW_FIZHI
77    # include "fizhi_SIZE.h"
78    #endif /* ALLOW_FIZHI */
79  #include "MDSIO_BUFF_3D.h"  #include "MDSIO_BUFF_3D.h"
80    
81  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
# Line 75  C !INPUT PARAMETERS: Line 87  C !INPUT PARAMETERS:
87        INTEGER irecord        INTEGER irecord
88        INTEGER myThid        INTEGER myThid
89  C !OUTPUT PARAMETERS:  C !OUTPUT PARAMETERS:
90        Real arr(*)        _RL  fldRL(*)
91          _RS  fldRS(*)
92    
93  C !FUNCTIONS  C !FUNCTIONS
94        INTEGER  ILNBLNK        INTEGER  ILNBLNK
# Line 130  C Only do I/O if I am the master thread Line 143  C Only do I/O if I am the master thread
143    
144  C Record number must be >= 1  C Record number must be >= 1
145        IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
146            WRITE(msgBuf,'(3A,I10)')
147         &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
148            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
149         &                      SQUEEZE_RIGHT , myThid )
150          WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(A,I9.8)')
151       &    ' MDS_READ_FIELD: argument irecord = ',irecord       &    ' MDS_READ_FIELD: argument irecord = ',irecord
152          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
153       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
154          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
155       &    ' MDS_READ_FIELD: Invalid value for irecord'       &    ' MDS_READ_FIELD: Invalid value for irecord'
156          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 142  C Record number must be >= 1 Line 159  C Record number must be >= 1
159        ENDIF        ENDIF
160  C check for valid sub-set of levels:  C check for valid sub-set of levels:
161        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
162            WRITE(msgBuf,'(3A,I10)')
163         &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
164            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
165         &                      SQUEEZE_RIGHT , myThid )
166          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
167       &    ' MDS_READ_FIELD: arguments kSize=', kSize,       &    ' MDS_READ_FIELD: arguments kSize=', kSize,
168       &    ' , kLo=', kLo, ' , kHi=', kHi       &    ' , kLo=', kLo, ' , kHi=', kHi
169          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
170       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
171          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
172       &    ' MDS_READ_FIELD: invalid sub-set of levels'       &    ' MDS_READ_FIELD: invalid sub-set of levels'
173          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 155  C check for valid sub-set of levels: Line 176  C check for valid sub-set of levels:
176        ENDIF        ENDIF
177  C check for 3-D Buffer size:  C check for 3-D Buffer size:
178        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
179            WRITE(msgBuf,'(3A,I10)')
180         &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
181            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
182         &                      SQUEEZE_RIGHT , myThid )
183          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
184       &    ' MDS_READ_FIELD: Nb Lev to read =', nNz,       &    ' MDS_READ_FIELD: Nb Lev to read =', nNz,
185       &    ' >', size3dBuf, ' = buffer 3rd Dim'       &    ' >', size3dBuf, ' = buffer 3rd Dim'
186          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
187       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
188          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
189       &    ' MDS_READ_FIELD: buffer 3rd Dim. too small'       &    ' MDS_READ_FIELD: buffer 3rd Dim. too small'
190          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
191          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
192       &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'       &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
193          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
194       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
195          CALL ALL_PROC_DIE( myThid )          CALL ALL_PROC_DIE( myThid )
196          STOP 'ABNORMAL END: S/R MDS_READ_FIELD'          STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
197        ENDIF        ENDIF
# Line 189  C Check first for global file with simpl Line 214  C Check first for global file with simpl
214          dataFName = fName          dataFName = fName
215          INQUIRE( file=dataFName, exist=exst )          INQUIRE( file=dataFName, exist=exst )
216          IF (exst) THEN          IF (exst) THEN
217            IF ( debugLevel .GE. debLevA ) THEN            IF ( debugLevel .GE. debLevB ) THEN
218              WRITE(msgBuf,'(A,A)')              WRITE(msgBuf,'(A,A)')
219       &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL)       &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL)
 #ifndef ALLOW_ECCO  
220              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
221       &                          SQUEEZE_RIGHT , myThid)       &                          SQUEEZE_RIGHT , myThid)
 #endif  
222            ENDIF            ENDIF
223            globalFile = .TRUE.            globalFile = .TRUE.
224          ENDIF          ENDIF
# Line 205  C If negative check for global file with Line 228  C If negative check for global file with
228            WRITE(dataFName,'(2a)') fName(1:IL),'.data'            WRITE(dataFName,'(2a)') fName(1:IL),'.data'
229            INQUIRE( file=dataFName, exist=exst )            INQUIRE( file=dataFName, exist=exst )
230            IF (exst) THEN            IF (exst) THEN
231             IF ( debugLevel .GE. debLevA ) THEN             IF ( debugLevel .GE. debLevB ) THEN
232              WRITE(msgBuf,'(A,A)')              WRITE(msgBuf,'(A,A)')
233       &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL+5)       &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL+5)
 #ifndef ALLOW_ECCO  
234              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
235       &                          SQUEEZE_RIGHT , myThid)       &                          SQUEEZE_RIGHT , myThid)
 #endif  
236             ENDIF             ENDIF
237             globalFile = .TRUE.             globalFile = .TRUE.
238            ENDIF            ENDIF
# Line 280  C  to acces shared buffer while master t Line 301  C  to acces shared buffer while master t
301  C All threads wait for Master to finish loading into shared buffer  C All threads wait for Master to finish loading into shared buffer
302            CALL BAR2( myThid )            CALL BAR2( myThid )
303            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
304              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, fldRS,
305       I                        1, k, kSize, 0, 0, .TRUE., myThid )       I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
306            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
307              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, fldRL,
308       I                        1, k, kSize, 0, 0, .TRUE., myThid )       I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
309            ELSE            ELSE
310              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
311       &          ' MDS_READ_FIELD: illegal value for arrType'       &          ' MDS_READ_FIELD: illegal value for arrType'
# Line 301  C All threads wait for Master to finish Line 322  C All threads wait for Master to finish
322  C All threads wait for Master to finish loading into shared buffer  C All threads wait for Master to finish loading into shared buffer
323            CALL BAR2( myThid )            CALL BAR2( myThid )
324            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
325              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, fldRS,
326       I                        1, k, kSize, 0, 0, .TRUE., myThid )       I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
327            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
328              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, fldRL,
329       I                        1, k, kSize, 0, 0, .TRUE., myThid )       I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
330            ELSE            ELSE
331              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
332       &          ' MDS_READ_FIELD: illegal value for arrType'       &          ' MDS_READ_FIELD: illegal value for arrType'
# Line 334  C---  else .NOT.useSingleCpuIO Line 355  C---  else .NOT.useSingleCpuIO
355    
356  C Wait for all thread to finish. This prevents other threads to continue  C Wait for all thread to finish. This prevents other threads to continue
357  C  to acces 3-D buffer while master thread is reading  C  to acces 3-D buffer while master thread is reading
358         CALL BAR2( myThid )  c      CALL BAR2( myThid )
359    
360  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
361         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
# Line 365  c         IF (fileIsOpen) THEN Line 386  c         IF (fileIsOpen) THEN
386             jGjLoc = 1             jGjLoc = 1
387  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
388             IF ( useExch2ioLayOut ) THEN             IF ( useExch2ioLayOut ) THEN
389               tN = W2_myTileList(bi)               tN = W2_myTileList(bi,bj)
390  c            tNx = exch2_tNx(tN)  c            tNx = exch2_tNx(tN)
391  c            tNy = exch2_tNy(tN)  c            tNy = exch2_tNy(tN)
392  c            global_nTx = exch2_global_Nx/tNx  c            global_nTx = exch2_global_Nx/tNx
# Line 418  C If we are reading from a tiled MDS fil Line 439  C If we are reading from a tiled MDS fil
439  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
440  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
441             IF (exst) THEN             IF (exst) THEN
442              IF ( debugLevel .GE. debLevA ) THEN              IF ( debugLevel .GE. debLevB ) THEN
443               WRITE(msgBuf,'(A,A)')               WRITE(msgBuf,'(A,A)')
444       &       ' MDS_READ_FIELD: opening file: ',dataFName(1:pIL+13)       &       ' MDS_READ_FIELD: opening file: ',dataFName(1:pIL+13)
445               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
# Line 485  C- endif iAmDoingIO Line 506  C- endif iAmDoingIO
506  C All threads wait for Master to finish reading into shared buffer  C All threads wait for Master to finish reading into shared buffer
507         CALL BAR2( myThid )         CALL BAR2( myThid )
508    
509  C---    Copy from 3-D buffer to arr (multi-threads):  C---    Copy from 3-D buffer to fldRL/RS (multi-threads):
510          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
511            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
512              CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRS( shared3dBuf_r4, fldRS,
513       I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )       I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
514            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
515              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRL( shared3dBuf_r4, fldRL,
516       I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )       I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
517            ELSE            ELSE
518              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
519       &         ' MDS_READ_FIELD: illegal value for arrType'       &         ' MDS_READ_FIELD: illegal value for arrType'
# Line 502  C---    Copy from 3-D buffer to arr (mul Line 523  C---    Copy from 3-D buffer to arr (mul
523            ENDIF            ENDIF
524          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
525            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
526              CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRS( shared3dBuf_r8, fldRS,
527       I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )       I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
528            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
529              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRL( shared3dBuf_r8, fldRL,
530       I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )       I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
531            ELSE            ELSE
532              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
533       &         ' MDS_READ_FIELD: illegal value for arrType'       &         ' MDS_READ_FIELD: illegal value for arrType'
# Line 522  C---    Copy from 3-D buffer to arr (mul Line 543  C---    Copy from 3-D buffer to arr (mul
543            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
544          ENDIF          ENDIF
545    
546    C Wait for all threads to finish getting data from 3-D shared buffer.
547    C  This prevents the master-thread to change the buffer content before
548    C  every one got his data.
549           CALL BAR2( myThid )
550    
551  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
552  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
553        ENDIF        ENDIF
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22