/[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.16 by jmc, Tue Sep 1 19:08:27 2009 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 88  C !INPUT PARAMETERS: Line 88  C !INPUT PARAMETERS:
88        LOGICAL useCurrentDir        LOGICAL useCurrentDir
89        CHARACTER*(2) arrType        CHARACTER*(2) arrType
90        INTEGER kSize, kLo, kHi        INTEGER kSize, kLo, kHi
91  cph(        _RL fldRL(*)
92  cph      Real arr(*)        _RS fldRS(*)
       _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,kSize,nSx,nSy)  
 cph)  
93        INTEGER jrecord        INTEGER jrecord
94        INTEGER myIter        INTEGER myIter
95        INTEGER myThid        INTEGER myThid
# Line 127  C     bBij  :: base shift in Buffer inde Line 125  C     bBij  :: base shift in Buffer inde
125  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
126        INTEGER tN        INTEGER tN
127  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
128          _RL dummyRL(1)
129          CHARACTER*8 blank8c
130    
131          DATA dummyRL(1) / 0. _d 0 /
132          DATA blank8c / '        ' /
133    
134  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
135  C Set dimensions:  C Set dimensions:
# Line 158  C Only do I/O if I am the master thread Line 161  C Only do I/O if I am the master thread
161    
162  C Record number must be >= 1  C Record number must be >= 1
163        IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
164          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
165       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
166          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
167       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 174  C Record number must be >= 1 Line 177  C Record number must be >= 1
177        ENDIF        ENDIF
178  C check for valid sub-set of levels:  C check for valid sub-set of levels:
179        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
180          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
181       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
182          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
183       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 191  C check for valid sub-set of levels: Line 194  C check for valid sub-set of levels:
194        ENDIF        ENDIF
195  C check for 3-D Buffer size:  C check for 3-D Buffer size:
196        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
197          WRITE(msgBuf,'(3A,I10))')          WRITE(msgBuf,'(3A,I10)')
198       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
199          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
200       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
# Line 248  C Master thread of process 0, only, open Line 251  C Master thread of process 0, only, open
251  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
252         DO k=kLo,kHi         DO k=kLo,kHi
253          zeroBuff = k.EQ.kLo          zeroBuff = k.EQ.kLo
254  C-      copy from arr(level=k) to 2-D "local":  C-      copy from fldRL/RS(level=k) to 2-D "local":
255          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
256            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
257              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, fldRS,
258       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
259            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
260              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, fldRL,
261       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
262            ELSE            ELSE
263              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
# Line 272  C Wait for all threads to finish filling Line 275  C Wait for all threads to finish filling
275       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
276          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
277            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
278              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, fldRS,
279       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
280    
281            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
282              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, fldRL,
283       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
284            ELSE            ELSE
285              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
# Line 330  C---+----1----+----2----+----3----+----4 Line 333  C---+----1----+----2----+----3----+----4
333  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
334        ELSE        ELSE
335    
336  C---    Copy from arr to 3-D buffer (multi-threads):  C---    Copy from fldRL/RS to 3-D buffer (multi-threads):
337          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
338            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
339              CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRS( shared3dBuf_r4, fldRS,
340       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
341            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
342              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRL( shared3dBuf_r4, fldRL,
343       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
344            ELSE            ELSE
345              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
# Line 347  C---    Copy from arr to 3-D buffer (mul Line 350  C---    Copy from arr to 3-D buffer (mul
350            ENDIF            ENDIF
351          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
352            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
353              CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRS( shared3dBuf_r8, fldRS,
354       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
355            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
356              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRL( shared3dBuf_r8, fldRL,
357       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
358            ELSE            ELSE
359              WRITE(msgBuf,'(2A)')              WRITE(msgBuf,'(2A)')
# Line 407  C Loop over all tiles Line 410  C Loop over all tiles
410            tBy = myYGlobalLo-1 + (bj-1)*sNy            tBy = myYGlobalLo-1 + (bj-1)*sNy
411  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
412            IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
413              tN = W2_myTileList(bi)              tN = W2_myTileList(bi,bj)
414  c           tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
415  c           tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
416  c           global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
# Line 508  c          dimList(3,3) = kHi Line 511  c          dimList(3,3) = kHi
511             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
512             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
513       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
514       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
515       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
516            ENDIF            ENDIF
517    
518  C End of bi,bj loops  C End of bi,bj loops
# Line 554  c        dimList(3,3) = kHi Line 557  c        dimList(3,3) = kHi
557           map2gl(2) = 1           map2gl(2) = 1
558           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
559       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
560       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
561       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
562  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
563  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
564  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.16
  ViewVC Help
Powered by ViewVC 1.1.22