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

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

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

revision 1.12 by jmc, Mon Jun 8 14:38:54 2009 UTC revision 1.17 by jmc, Thu Dec 23 02:41:47 2010 UTC
# Line 13  C !INTERFACE: Line 13  C !INTERFACE:
13       I   useCurrentDir,       I   useCurrentDir,
14       I   arrType,       I   arrType,
15       I   kSize,kLo,kHi,       I   kSize,kLo,kHi,
16       I   arr,       I   fldRL, fldRS,
17       I   jrecord,       I   jrecord,
18       I   myIter,       I   myIter,
19       I   myThid )       I   myThid )
# Line 26  C filePrec  (integer) :: number of bits Line 26  C filePrec  (integer) :: number of bits
26  C globalFile (logical):: selects between writing a global or tiled file  C globalFile (logical):: selects between writing a global or tiled file
27  C useCurrentDir(logic):: always write to the current directory (even if  C useCurrentDir(logic):: always write to the current directory (even if
28  C                        "mdsioLocalDir" is set)  C                        "mdsioLocalDir" is set)
29  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: which array (fldRL/RS) to write, either "RL" or "RS"
30  C kSize     (integer) :: size of third dimension: normally either 1 or Nr  C kSize     (integer) :: size of third dimension: normally either 1 or Nr
31  C kLo       (integer) :: 1rst vertical level (of array "arr") to write  C kLo       (integer) :: 1rst vertical level (of array fldRL/RS) to write
32  C kHi       (integer) :: last vertical level (of array "arr") to write  C kHi       (integer) :: last vertical level (of array fldRL/RS) to write
33  C arr       ( RS/RL ) :: array to write, arr(:,:,kSize,:,:)  C fldRL       ( RL )  :: array to write if arrType="RL", fldRL(:,:,kSize,:,:)
34    C fldRS       ( RS )  :: array to write if arrType="RS", fldRS(:,:,kSize,:,:)
35  C irecord   (integer) :: record number to write  C irecord   (integer) :: record number to write
36  C myIter    (integer) :: time step number  C myIter    (integer) :: time step number
37  C myThid    (integer) :: thread identifier  C myThid    (integer) :: thread identifier
# Line 43  C Currently, the meta-files are not read Line 44  C Currently, the meta-files are not read
44  C  to parse files in fortran. We should read meta information before  C  to parse files in fortran. We should read meta information before
45  C  adding records to an existing multi-record file.  C  adding records to an existing multi-record file.
46  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
47  C  to floatPrec32 or floatPrec64. The precision or declaration of  C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either
48  C  the array argument must be consistently described by the char*(2)  C  "RL" or "RS", selects which array is written, either fldRL or fldRS.
 C  string arrType, either "RS" or "RL".  
49  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
50  C  the option to only write a sub-set of consecutive vertical levels (from  C  the option to only write a sub-set of consecutive vertical levels (from
51  C  kLo to kHi); (kSize,kLo,kHi)=(1,1,1) implies a 2-D model field and  C  kLo to kHi); (kSize,kLo,kHi)=(1,1,1) implies a 2-D model field and
# Line 57  C  routine arguments and file, i.e., if Line 57  C  routine arguments and file, i.e., if
57  C  the meta information will record the number of records to be 2. This,  C  the meta information will record the number of records to be 2. This,
58  C  again, is because we have read the meta information. To be fixed.  C  again, is because we have read the meta information. To be fixed.
59  C  C
60    C- Multi-threaded: Only Master thread does IO (and MPI calls) and get data
61    C   from a shared buffer that any thread can copy to.
62    C- Convention regarding thread synchronisation (BARRIER):
63    C  A per-thread (or per tile) partition of the 2-D shared-buffer (sharedLocBuf_r4/r8)
64    C   is readily available => any access (e.g., by master-thread) to a portion
65    C   owned by an other thread is put between BARRIER (protected).
66    C  No thread partition exist for the 3-D shared buffer (shared3dBuf_r4/r8);
67    C   Therefore, the 3-D buffer is considered to be owned by master-thread and
68    C   any access by other than master thread is put between BARRIER (protected).
69    C
70  C Created: 03/16/99 adcroft@mit.edu  C Created: 03/16/99 adcroft@mit.edu
71  C Changed: 01/06/02 menemenlis@jpl.nasa.gov  C Changed: 01/06/02 menemenlis@jpl.nasa.gov
72  C          added useSingleCpuIO hack  C          added useSingleCpuIO hack
# Line 88  C !INPUT PARAMETERS: Line 98  C !INPUT PARAMETERS:
98        LOGICAL useCurrentDir        LOGICAL useCurrentDir
99        CHARACTER*(2) arrType        CHARACTER*(2) arrType
100        INTEGER kSize, kLo, kHi        INTEGER kSize, kLo, kHi
101  cph(        _RL fldRL(*)
102  cph      Real arr(*)        _RS fldRS(*)
       _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,kSize,nSx,nSy)  
 cph)  
103        INTEGER jrecord        INTEGER jrecord
104        INTEGER myIter        INTEGER myIter
105        INTEGER myThid        INTEGER myThid
# Line 127  C     bBij  :: base shift in Buffer inde Line 135  C     bBij  :: base shift in Buffer inde
135  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
136        INTEGER tN        INTEGER tN
137  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
138          _RL dummyRL(1)
139          CHARACTER*8 blank8c
140    
141          DATA dummyRL(1) / 0. _d 0 /
142          DATA blank8c / '        ' /
143    
144  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
145  C Set dimensions:  C Set dimensions:
# Line 158  C Only do I/O if I am the master thread Line 171  C Only do I/O if I am the master thread
171    
172  C Record number must be >= 1  C Record number must be >= 1
173        IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
174          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
175       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
176          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
177       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 174  C Record number must be >= 1 Line 187  C Record number must be >= 1
187        ENDIF        ENDIF
188  C check for valid sub-set of levels:  C check for valid sub-set of levels:
189        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
190          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
191       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
192          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
193       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 191  C check for valid sub-set of levels: Line 204  C check for valid sub-set of levels:
204        ENDIF        ENDIF
205  C check for 3-D Buffer size:  C check for 3-D Buffer size:
206        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
207          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
208       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
209          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
210       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 248  C Master thread of process 0, only, open Line 261  C Master thread of process 0, only, open
261  C Gather array and write it to file, one vertical level at a time  C Gather array and write it to file, one vertical level at a time
262         DO k=kLo,kHi         DO k=kLo,kHi
263          zeroBuff = k.EQ.kLo          zeroBuff = k.EQ.kLo
264  C-      copy from arr(level=k) to 2-D "local":  C-      copy from fldRL/RS(level=k) to 2-D "local":
265          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
266            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
267              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, fldRS,
268       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                 0, 0, 1, k, kSize, 0, 0, .FALSE., myThid )
269            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
270              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, fldRL,
271       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                 0, 0, 1, k, kSize, 0, 0, .FALSE., myThid )
272            ELSE            ELSE
273              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
274       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
# Line 272  C Wait for all threads to finish filling Line 285  C Wait for all threads to finish filling
285       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
286          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
287            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
288              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, fldRS,
289       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                 0, 0, 1, k, kSize, 0, 0, .FALSE., myThid )
   
290            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
291              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, fldRL,
292       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                 0, 0, 1, k, kSize, 0, 0, .FALSE., myThid )
293            ELSE            ELSE
294              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
295       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
# Line 330  C---+----1----+----2----+----3----+----4 Line 342  C---+----1----+----2----+----3----+----4
342  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
343        ELSE        ELSE
344    
345  C---    Copy from arr to 3-D buffer (multi-threads):  C Wait for all thread to finish. This prevents other threads (e.g., master)
346    C  to continue to acces 3-D buffer while this thread is filling it.
347            CALL BAR2( myThid )
348    
349    C---    Copy from fldRL/RS to 3-D buffer (multi-threads):
350          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
351            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
352              CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRS( shared3dBuf_r4, fldRS,
353       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I              0, 0, nNz, kLo, kSize, 0,0, .FALSE., myThid )
354            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
355              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRL( shared3dBuf_r4, fldRL,
356       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I              0, 0, nNz, kLo, kSize, 0,0, .FALSE., myThid )
357            ELSE            ELSE
358              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
359       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
# Line 347  C---    Copy from arr to 3-D buffer (mul Line 363  C---    Copy from arr to 3-D buffer (mul
363            ENDIF            ENDIF
364          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
365            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
366              CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRS( shared3dBuf_r8, fldRS,
367       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I              0, 0, nNz, kLo, kSize, 0,0, .FALSE., myThid )
368            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
369              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRL( shared3dBuf_r8, fldRL,
370       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I              0, 0, nNz, kLo, kSize, 0,0, .FALSE., myThid )
371            ELSE            ELSE
372              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
373       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
# Line 407  C Loop over all tiles Line 423  C Loop over all tiles
423            tBy = myYGlobalLo-1 + (bj-1)*sNy            tBy = myYGlobalLo-1 + (bj-1)*sNy
424  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
425            IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
426              tN = W2_myTileList(bi)              tN = W2_myTileList(bi,bj)
427  c           tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
428  c           tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
429  c           global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
# Line 508  c          dimList(3,3) = kHi Line 524  c          dimList(3,3) = kHi
524             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
525             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
526       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
527       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
528       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
529            ENDIF            ENDIF
530    
531  C End of bi,bj loops  C End of bi,bj loops
# Line 527  C- endif iAmDoingIO Line 543  C- endif iAmDoingIO
543    
544  C Make other threads wait for I/O completion so that after this,  C Make other threads wait for I/O completion so that after this,
545  C  3-D buffer can again be modified by any thread  C  3-D buffer can again be modified by any thread
546         CALL BAR2( myThid )  c      CALL BAR2( myThid )
547    
548  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
549        ENDIF        ENDIF
# Line 554  c        dimList(3,3) = kHi Line 570  c        dimList(3,3) = kHi
570           map2gl(2) = 1           map2gl(2) = 1
571           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
572       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
573       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
574       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
575  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
576  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
577  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22