/[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.15 by jmc, Sun Aug 2 20:42:43 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 253  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 277  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 335  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 352  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)')
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22