Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:41:57 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
3a279374db Alis*0001 #include "MDSIO_OPTIONS.h"
                0002 
3b7351743b Jean*0003 CBOP
a50692f9cd Jean*0004 C !ROUTINE: MDS_WRITELOCAL
3b7351743b Jean*0005 C !INTERFACE:
3a279374db Alis*0006       SUBROUTINE MDS_WRITELOCAL(
                0007      I   fName,
                0008      I   filePrec,
585cdcb8de Jean*0009      I   globFile,
3a279374db Alis*0010      I   arrType,
                0011      I   nNz,
608f4af3c8 Jean*0012      I   fldRL, fldRS,
3b7351743b Jean*0013      I   biArg, bjArg,
3a279374db Alis*0014      I   irecord,
                0015      I   myIter,
3b7351743b Jean*0016      I   myThArg )
                0017 
                0018 C !DESCRIPTION:
3a279374db Alis*0019 C Arguments:
                0020 C
3b7351743b Jean*0021 C fName     (string)  :: base name for file to write
                0022 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0023 C globalFile (logical):: selects between writing a global or tiled file
608f4af3c8 Jean*0024 C arrType   (char(2)) :: which array (fldRL/RS) to write, either "RL" or "RS"
eb5e2b9a92 Jean*0025 C nNz       (integer) :: size of third dimension: normally either 1 or Nr
608f4af3c8 Jean*0026 C fldRL       ( RL )  :: array to write if arrType="RL", fldRL(:,:,nNz)
                0027 C fldRS       ( RS )  :: array to write if arrType="RS", fldRS(:,:,nNz)
3b7351743b Jean*0028 C biArg     (integer) :: tile X-index argument
                0029 C bjArg     (integer) :: tile Y-index argument
                0030 C irecord   (integer) :: record number to write
                0031 C myIter    (integer) :: time step number
                0032 C myThArg   (integer) :: thread argument (= my Thread Id or = 0 to simply
                0033 C                        write 1 tile without thread synchronisation)
3a279374db Alis*0034 C
3b7351743b Jean*0035 C MDS_WRITELOCAL write a local-tile array corresponding to tile biArg,bjArg
                0036 C  of this Process. Threading: with myThArg=0 or when LOCBIN_IO_THREAD_SAFE
                0037 C  is defined, go for a strait writing of this tile ; otherwise, use the
                0038 C  shared buffer IO to store data from all threads, then synchronise and
                0039 C  let the master thread write nThreads tiles. If multiple tiles per thread,
                0040 C  will repeat this sequence each time this S/R is called by the master thread
                0041 C  with a different biArg,biArg. IMPORTANT: 2nd case requires that all threads
2186fe42a7 Jean*0042 C  call this S/R and assumes symmetry in tiles per thread treatment.
                0043 C Convention regarding thread synchronisation (BARRIER): see mdsio_write_field.F
3a279374db Alis*0044 C MDS_WRITELOCAL creates either a file of the form "fName.data" and
3b7351743b Jean*0045 C  "fName.meta" if the logical flag "globalFile" is set true. Otherwise
                0046 C  it creates MDS tiled files of the form "fName.xxx.yyy.data" and
                0047 C  "fName.xxx.yyy.meta". A meta-file is always created.
3a279374db Alis*0048 C Currently, the meta-files are not read because it is difficult
3b7351743b Jean*0049 C  to parse files in fortran. We should read meta information before
                0050 C  adding records to an existing multi-record file.
3a279374db Alis*0051 C The precision of the file is decsribed by filePrec, set either
608f4af3c8 Jean*0052 C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either
                0053 C  "RL" or "RS", selects which array is written, either fldRL or fldRS.
3b7351743b Jean*0054 C nNz allows for both 2-D and 3-D arrays to be handled. nNz=1 implies
                0055 C  a 2-D model field and nNz=Nr implies a 3-D model field.
                0056 C irecord is the record number to be written and must be >= 1.
                0057 C NOTE: It is currently assumed that the highest record number in the file
                0058 C  was the last record written. Nor is there a consistency check between the
                0059 C  routine arguments and file, i.e., if you write record 2 after record 4
                0060 C  the meta information will record the number of records to be 2. This,
                0061 C  again, is because we have read the meta information. To be fixed.
3a279374db Alis*0062 C
                0063 C Created: 03/16/99 adcroft@mit.edu
                0064 C Changed: 05/31/00 heimbach@mit.edu
                0065 C          open(dUnit, ..., status='old', ... -> status='unknown'
3b7351743b Jean*0066 CEOP
3a279374db Alis*0067 
3b7351743b Jean*0068 C !USES:
20b1679b8a Jean*0069       IMPLICIT NONE
3a279374db Alis*0070 C Global variables / common blocks
                0071 #include "SIZE.h"
                0072 #include "EEPARAMS.h"
                0073 #include "PARAMS.h"
b2683f8cec Jean*0074 #ifdef ALLOW_EXCH2
f9f661930b Jean*0075 #include "W2_EXCH2_SIZE.h"
b2683f8cec Jean*0076 #include "W2_EXCH2_TOPOLOGY.h"
f14a858a6e Jean*0077 #include "W2_EXCH2_PARAMS.h"
b2683f8cec Jean*0078 #endif /* ALLOW_EXCH2 */
d24daa2c55 Jean*0079 #ifdef ALLOW_FIZHI
                0080 # include "fizhi_SIZE.h"
                0081 #endif /* ALLOW_FIZHI */
8decba0243 Jean*0082 #include "MDSIO_BUFF_3D.h"
3a279374db Alis*0083 
3b7351743b Jean*0084 C !INPUT PARAMETERS:
20b1679b8a Jean*0085       CHARACTER*(*) fName
                0086       INTEGER filePrec
                0087       LOGICAL globFile
                0088       CHARACTER*(2) arrType
                0089       INTEGER nNz
608f4af3c8 Jean*0090       _RL fldRL(*)
                0091       _RS fldRS(*)
3b7351743b Jean*0092       INTEGER biArg, bjArg
20b1679b8a Jean*0093       INTEGER irecord
                0094       INTEGER myIter
3b7351743b Jean*0095       INTEGER myThArg
                0096 C !OUTPUT PARAMETERS:
8decba0243 Jean*0097 
                0098 C !FUNCTIONS
20b1679b8a Jean*0099       INTEGER ILNBLNK
                0100       INTEGER MDS_RECLEN
3b7351743b Jean*0101       EXTERNAL ILNBLNK, MDS_RECLEN
8decba0243 Jean*0102 
                0103 C !LOCAL VARIABLES:
                0104 C     bBij  :: base shift in Buffer index for tile bi,bj
20b1679b8a Jean*0105       CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName
320e8435cd Jean*0106       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0107       LOGICAL fileIsOpen
                0108       LOGICAL globalFile
                0109       LOGICAL iAmDoingIO
                0110       INTEGER xSize, ySize
8decba0243 Jean*0111       INTEGER iG,jG
                0112       INTEGER i1,i2,i,j,k
320e8435cd Jean*0113       INTEGER irec,dUnit,IL
20b1679b8a Jean*0114       INTEGER dimList(3,3),nDims, map2gl(2)
                0115       INTEGER length_of_rec
8decba0243 Jean*0116       INTEGER bBij
3b7351743b Jean*0117       INTEGER bi, bj
                0118       INTEGER myThid, ith, nthLoop
f14a858a6e Jean*0119       INTEGER tNx, tNy, global_nTx
                0120       INTEGER tBx, tBy, iGjLoc, jGjLoc
b2683f8cec Jean*0121 #ifdef ALLOW_EXCH2
f14a858a6e Jean*0122       INTEGER tN
b2683f8cec Jean*0123 #endif /* ALLOW_EXCH2 */
fbc6fb65d0 Jean*0124       _RL dummyRL(1)
                0125       CHARACTER*8 blank8c
                0126 
                0127       DATA dummyRL(1) / 0. _d 0 /
                0128       DATA blank8c / '        ' /
320e8435cd Jean*0129 
                0130 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0131 C Set dimensions:
                0132       xSize = Nx
                0133       ySize = Ny
f14a858a6e Jean*0134 #ifdef ALLOW_EXCH2
                0135       IF ( W2_useE2ioLayOut ) THEN
                0136         xSize = exch2_global_Nx
                0137         ySize = exch2_global_Ny
                0138       ENDIF
                0139 #endif /* ALLOW_EXCH2 */
3a279374db Alis*0140 
20b1679b8a Jean*0141 C-    default:
                0142       iGjLoc = 0
                0143       jGjLoc = 1
                0144 
585cdcb8de Jean*0145       IL = ILNBLNK( fName )
                0146       globalFile = globFile
3b7351743b Jean*0147       myThid = MAX(myThArg,1)
                0148 #ifdef LOCBIN_IO_THREAD_SAFE
                0149       nthLoop = 1
                0150       iAmDoingIO = .TRUE.
                0151 #else /* LOCBIN_IO_THREAD_SAFE */
                0152       nthLoop = nThreads
                0153       IF ( myThArg.EQ.0 ) nthLoop = 1
                0154       iAmDoingIO = .FALSE.
                0155       IF ( myThid.EQ.1 ) iAmDoingIO = .TRUE.
                0156 #endif /* LOCBIN_IO_THREAD_SAFE */
585cdcb8de Jean*0157 
                0158       IF ( nThreads.GT.1 .AND. globFile ) THEN
                0159 C-    do not assume safe Muti-Threaded Binary IO to a single global file
                0160 C      => switch to tiled file
                0161         globalFile = .FALSE.
                0162         IF ( debugLevel.GE.debLevA .AND. IL.GT.0 ) THEN
20b1679b8a Jean*0163          WRITE(msgBuf,'(A,I10,A,2I5,A)')
3b7351743b Jean*0164      &    'MDS_WRITELOCAL (it=', myIter, ' ; bi,bj=', biArg,bjArg,
585cdcb8de Jean*0165      &    ' ): No global-file multi-threaded IO'
d24daa2c55 Jean*0166          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0167      &                       SQUEEZE_RIGHT , myThid )
20b1679b8a Jean*0168          WRITE(msgBuf,'(2A)')
585cdcb8de Jean*0169      &    'MDS_WRITELOCAL: => write tiled file: ', fName(1:IL)
d24daa2c55 Jean*0170          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0171      &                       SQUEEZE_RIGHT , myThid )
585cdcb8de Jean*0172         ENDIF
                0173       ENDIF
                0174 
3a279374db Alis*0175 C Record number must be >= 1
20b1679b8a Jean*0176       IF (irecord .LT. 1) THEN
e5df3a82bd Jean*0177         WRITE(msgBuf,'(3A,I10)')
d24daa2c55 Jean*0178      &    ' MDS_WRITELOCAL: file="', fName(1:IL), '" , iter=', myIter
                0179         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0180      &                      SQUEEZE_RIGHT , myThid )
                0181         WRITE(msgBuf,'(A,I9.8)')
                0182      &    ' MDS_WRITELOCAL: argument irecord = ',irecord
                0183         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0184      &                      SQUEEZE_RIGHT , myThid )
                0185         WRITE(msgBuf,'(A)')
                0186      &    ' MDS_WRITELOCAL: invalid value for irecord'
                0187         CALL PRINT_ERROR( msgBuf, myThid )
6a4571c0cf Jean*0188         CALL ALL_PROC_DIE( myThArg )
d24daa2c55 Jean*0189         STOP 'ABNORMAL END: S/R MDS_WRITELOCAL'
20b1679b8a Jean*0190       ENDIF
8decba0243 Jean*0191 C check for 3-D Buffer size:
                0192       IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
e5df3a82bd Jean*0193         WRITE(msgBuf,'(3A,I10)')
d24daa2c55 Jean*0194      &    ' MDS_WRITELOCAL: file="', fName(1:IL), '" , iter=', myIter
                0195         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0196      &                      SQUEEZE_RIGHT , myThid )
8decba0243 Jean*0197         WRITE(msgBuf,'(3(A,I6))')
                0198      &    ' MDS_WRITELOCAL: Nb Lev to write =', nNz,
                0199      &    ' >', size3dBuf, ' = buffer 3rd Dim'
                0200         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
d24daa2c55 Jean*0201      &                      SQUEEZE_RIGHT , myThid )
8decba0243 Jean*0202         WRITE(msgBuf,'(A)')
                0203      &    ' MDS_WRITELOCAL: buffer 3rd Dim. too small'
                0204         CALL PRINT_ERROR( msgBuf, myThid )
                0205         WRITE(msgBuf,'(A)')
                0206      &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
                0207         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
d24daa2c55 Jean*0208      &                      SQUEEZE_RIGHT , myThid )
6a4571c0cf Jean*0209         CALL ALL_PROC_DIE( myThArg )
8decba0243 Jean*0210         STOP 'ABNORMAL END: S/R MDS_WRITELOCAL'
                0211       ENDIF
                0212 
2186fe42a7 Jean*0213 C Wait for all thread to finish. This prevents other threads (e.g., master)
                0214 C  to continue to acces 3-D buffer while this thread is filling it.
                0215       IF ( nthLoop.GT.1 ) CALL BAR2( myThid )
                0216 
8decba0243 Jean*0217 C-------------------------------------------------
608f4af3c8 Jean*0218 C---    Copy from fldRL/RS to 3-D buffer (multi-threads):
3b7351743b Jean*0219       IF ( filePrec.EQ.precFloat32 ) THEN
8decba0243 Jean*0220           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0221             CALL MDS_PASS_R4toRS( shared3dBuf_r4, fldRS,
2186fe42a7 Jean*0222      I           0, 0, nNz, 1, nNz, biArg, bjArg, .FALSE., myThid )
8decba0243 Jean*0223           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0224             CALL MDS_PASS_R4toRL( shared3dBuf_r4, fldRL,
2186fe42a7 Jean*0225      I           0, 0, nNz, 1, nNz, biArg, bjArg, .FALSE., myThid )
8decba0243 Jean*0226           ELSE
                0227             WRITE(msgBuf,'(A)')
                0228      &         ' MDS_WRITELOCAL: illegal value for arrType'
                0229             CALL PRINT_ERROR( msgBuf, myThid )
6a4571c0cf Jean*0230             CALL ALL_PROC_DIE( myThArg )
8decba0243 Jean*0231             STOP 'ABNORMAL END: S/R MDS_WRITELOCAL'
                0232           ENDIF
3b7351743b Jean*0233       ELSEIF ( filePrec.EQ.precFloat64 ) THEN
8decba0243 Jean*0234           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0235             CALL MDS_PASS_R8toRS( shared3dBuf_r8, fldRS,
2186fe42a7 Jean*0236      I           0, 0, nNz, 1, nNz, biArg, bjArg, .FALSE., myThid )
8decba0243 Jean*0237           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0238             CALL MDS_PASS_R8toRL( shared3dBuf_r8, fldRL,
2186fe42a7 Jean*0239      I           0, 0, nNz, 1, nNz, biArg, bjArg, .FALSE., myThid )
8decba0243 Jean*0240           ELSE
                0241             WRITE(msgBuf,'(A)')
                0242      &         ' MDS_WRITELOCAL: illegal value for arrType'
                0243             CALL PRINT_ERROR( msgBuf, myThid )
6a4571c0cf Jean*0244             CALL ALL_PROC_DIE( myThArg )
8decba0243 Jean*0245             STOP 'ABNORMAL END: S/R MDS_WRITELOCAL'
                0246           ENDIF
3b7351743b Jean*0247       ELSE
8decba0243 Jean*0248           WRITE(msgBuf,'(A)')
                0249      &         ' MDS_WRITELOCAL: illegal value for filePrec'
                0250           CALL PRINT_ERROR( msgBuf, myThid )
6a4571c0cf Jean*0251           CALL ALL_PROC_DIE( myThArg )
8decba0243 Jean*0252           STOP 'ABNORMAL END: S/R MDS_WRITELOCAL'
3b7351743b Jean*0253       ENDIF
8decba0243 Jean*0254 C-------------------------------------------------
3a279374db Alis*0255 
3b7351743b Jean*0256 C Wait for all threads to finish filling shared buffer
                0257       IF ( nthLoop.GT.1 ) CALL BAR2( myThid )
                0258 
                0259 C Only do I/O if I am the master thread
20b1679b8a Jean*0260       IF ( iAmDoingIO ) THEN
585cdcb8de Jean*0261 
3a279374db Alis*0262 C Assume nothing
3b7351743b Jean*0263         fileIsOpen=.FALSE.
3a279374db Alis*0264 
                0265 C Assign a free unit number as the I/O channel for this routine
3b7351743b Jean*0266         CALL MDSFINDUNIT( dUnit, myThid )
3a279374db Alis*0267 
                0268 C If we are writing to a global file then we open it here
3b7351743b Jean*0269         IF (globalFile) THEN
                0270           WRITE(dataFName,'(2A)') fName(1:IL),'.data'
                0271           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
                0272           IF (irecord .EQ. 1) THEN
                0273            OPEN( dUnit, file=dataFName, status='unknown',
                0274      &           access='direct', recl=length_of_rec )
                0275           ELSE
                0276            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
                0277      &           access='direct', recl=length_of_rec )
                0278           ENDIF
                0279           fileIsOpen=.TRUE.
                0280         ENDIF
                0281 
                0282 C Loop over tiles
                0283         DO ith=1,nthLoop
                0284           bi = biArg + myBxLo(ith) - 1
                0285           bj = bjArg + myByLo(ith) - 1
3a279374db Alis*0286 
3b7351743b Jean*0287           bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
                0288           i1 = bBij + 1
                0289 #ifdef _BYTESWAPIO
                0290           IF ( filePrec.EQ.precFloat32 ) THEN
                0291             CALL MDS_BYTESWAPR4( sNx*sNy*nNz, shared3dBuf_r4(i1) )
                0292           ELSE
                0293             CALL MDS_BYTESWAPR8( sNx*sNy*nNz, shared3dBuf_r8(i1) )
                0294           ENDIF
                0295 #endif
20b1679b8a Jean*0296 
3b7351743b Jean*0297           tNx = sNx
                0298           tNy = sNy
                0299           global_nTx = xSize/sNx
                0300           tBx = myXGlobalLo-1 + (bi-1)*sNx
                0301           tBy = myYGlobalLo-1 + (bj-1)*sNy
20b1679b8a Jean*0302 #ifdef ALLOW_EXCH2
3b7351743b Jean*0303           IF ( W2_useE2ioLayOut ) THEN
c424ee7cc7 Jean*0304             tN = W2_myTileList(bi,bj)
3b7351743b Jean*0305 c           global_nTx = exch2_global_Nx/sNx
                0306             tBx = exch2_txGlobalo(tN) - 1
                0307             tBy = exch2_tyGlobalo(tN) - 1
                0308             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
9a33636256 Jean*0309 C-          face x-size larger than glob-size : fold it
3b7351743b Jean*0310               iGjLoc = 0
                0311               jGjLoc = exch2_mydNx(tN) / xSize
                0312             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
9a33636256 Jean*0313 C-          tile y-size larger than glob-size : make a long line
3b7351743b Jean*0314               iGjLoc = exch2_mydNx(tN)
                0315               jGjLoc = 0
                0316             ELSE
9a33636256 Jean*0317 C-          default (face fit into global-IO-array)
3b7351743b Jean*0318               iGjLoc = 0
                0319               jGjLoc = 1
                0320             ENDIF
9a33636256 Jean*0321           ENDIF
20b1679b8a Jean*0322 #endif /* ALLOW_EXCH2 */
9a33636256 Jean*0323 
3b7351743b Jean*0324           IF (globalFile) THEN
9a33636256 Jean*0325 C--- Case of 1 Global file:
                0326 
3b7351743b Jean*0327            DO k=1,nNz
                0328             DO j=1,sNy
20b1679b8a Jean*0329 C-       compute record number:
3b7351743b Jean*0330              irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
                0331      &                + ( tBy + (j-1)*jGjLoc )*global_nTx
                0332      &            +  ( k-1 + (irecord-1)*nNz )*global_nTx*ySize
                0333              i1 = bBij + 1 + (j-1)*sNx + (k-1)*sNx*sNy
                0334              i2 = bBij +         j*sNx + (k-1)*sNx*sNy
                0335              IF ( filePrec.EQ.precFloat32 ) THEN
                0336                WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
                0337              ELSE
                0338                WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
                0339              ENDIF
8decba0243 Jean*0340 C End of j,k loops
3b7351743b Jean*0341             ENDDO
                0342            ENDDO
9a33636256 Jean*0343 
3b7351743b Jean*0344           ELSE
9a33636256 Jean*0345 C--- Case of 1 file per tile (globalFile=F):
                0346 
                0347 C If we are writing to a tiled MDS file then we open each one here
3b7351743b Jean*0348             iG=bi+(myXGlobalLo-1)/sNx
                0349             jG=bj+(myYGlobalLo-1)/sNy
                0350             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
9a33636256 Jean*0351      &               fName(1:IL),'.',iG,'.',jG,'.data'
3b7351743b Jean*0352             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
                0353             IF (irecord .EQ. 1) THEN
                0354              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
                0355      &             access='direct', recl=length_of_rec )
                0356             ELSE
                0357              OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
                0358      &             access='direct', recl=length_of_rec )
                0359             ENDIF
                0360             fileIsOpen=.TRUE.
                0361 
                0362             irec = irecord
                0363             i1 = bBij + 1
                0364             i2 = bBij + sNx*sNy*nNz
                0365             IF ( filePrec.EQ.precFloat32 ) THEN
                0366               WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
                0367             ELSE
                0368               WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
                0369             ENDIF
9a33636256 Jean*0370 
3b7351743b Jean*0371 C If we were writing to a tiled MDS file then we close it here
                0372             IF ( fileIsOpen ) THEN
                0373               CLOSE( dUnit )
                0374               fileIsOpen = .FALSE.
                0375             ENDIF
                0376 
                0377 C--- End Global File / tile-file cases
8decba0243 Jean*0378           ENDIF
9a33636256 Jean*0379 
3b7351743b Jean*0380 C Create meta-file for each tile if we are tiling
                0381           IF ( .NOT.globalFile ) THEN
                0382            iG=bi+(myXGlobalLo-1)/sNx
                0383            jG=bj+(myYGlobalLo-1)/sNy
                0384            WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
                0385      &                fName(1:IL),'.',iG,'.',jG,'.meta'
                0386            dimList(1,1) = xSize
                0387            dimList(2,1) = tBx + 1
                0388            dimList(3,1) = tBx + tNx
                0389            dimList(1,2) = ySize
                0390            dimList(2,2) = tBy + 1
                0391            dimList(3,2) = tBy + tNy
                0392            dimList(1,3) = Nr
                0393            dimList(2,3) = 1
                0394            dimList(3,3) = Nr
                0395            nDims = 3
                0396            IF ( nNz.EQ.1 ) nDims = 2
                0397            map2gl(1) = iGjLoc
                0398            map2gl(2) = jGjLoc
                0399            CALL MDS_WRITE_META(
                0400      I              metaFName, dataFName, the_run_name, ' ',
fbc6fb65d0 Jean*0401      I              filePrec, nDims, dimList, map2gl, 0, blank8c,
a50692f9cd Jean*0402      I              0, dummyRL, oneRL, irecord, myIter, myThid )
9a33636256 Jean*0403           ENDIF
                0404 
3b7351743b Jean*0405 C End of ith loop
                0406         ENDDO
                0407 
                0408 C If global file was opened then close it
                0409         IF (fileIsOpen .AND. globalFile) THEN
                0410           CLOSE( dUnit )
                0411           fileIsOpen = .FALSE.
20b1679b8a Jean*0412         ENDIF
9a33636256 Jean*0413 
3b7351743b Jean*0414 C Create meta-file for the global-file
                0415         IF (globalFile) THEN
                0416          WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
320e8435cd Jean*0417          dimList(1,1) = xSize
3b7351743b Jean*0418          dimList(2,1) = 1
                0419          dimList(3,1) = xSize
320e8435cd Jean*0420          dimList(1,2) = ySize
3b7351743b Jean*0421          dimList(2,2) = 1
                0422          dimList(3,2) = ySize
320e8435cd Jean*0423          dimList(1,3) = Nr
                0424          dimList(2,3) = 1
                0425          dimList(3,3) = Nr
f14a858a6e Jean*0426          nDims = 3
                0427          IF ( nNz.EQ.1 ) nDims = 2
3b7351743b Jean*0428          map2gl(1) = 0
                0429          map2gl(2) = 1
20b1679b8a Jean*0430          CALL MDS_WRITE_META(
                0431      I              metaFName, dataFName, the_run_name, ' ',
fbc6fb65d0 Jean*0432      I              filePrec, nDims, dimList, map2gl, 0, blank8c,
a50692f9cd Jean*0433      I              0, dummyRL, oneRL, irecord, myIter, myThid )
20b1679b8a Jean*0434         ENDIF
9a33636256 Jean*0435 
585cdcb8de Jean*0436 C-    end if iAmDoingIO
                0437       ENDIF
3a279374db Alis*0438 
3b7351743b Jean*0439 C Make other threads wait for I/O completion so that after this,
                0440 C  3-D buffer can again be modified by any thread
2186fe42a7 Jean*0441 c     IF ( nthLoop.GT.1 ) CALL BAR2( myThid )
3b7351743b Jean*0442 
320e8435cd Jean*0443 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
585cdcb8de Jean*0444       RETURN
                0445       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!