/[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.10 by jmc, Mon Jun 1 14:20:31 2009 UTC revision 1.15 by jmc, Sun Aug 2 20:42:43 2009 UTC
# Line 71  C Global variables / common blocks Line 71  C Global variables / common blocks
71  #include "EEPARAMS.h"  #include "EEPARAMS.h"
72  #include "PARAMS.h"  #include "PARAMS.h"
73  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
74  #include "W2_EXCH2_SIZE.h"  # include "W2_EXCH2_SIZE.h"
75  #include "W2_EXCH2_TOPOLOGY.h"  # include "W2_EXCH2_TOPOLOGY.h"
76  #include "W2_EXCH2_PARAMS.h"  # include "W2_EXCH2_PARAMS.h"
77  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
78  #include "EEBUFF_SCPU.h"  #include "EEBUFF_SCPU.h"
79    #ifdef ALLOW_FIZHI
80    # include "fizhi_SIZE.h"
81    #endif /* ALLOW_FIZHI */
82    #include "MDSIO_BUFF_3D.h"
83    
84  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
85        CHARACTER*(*) fName        CHARACTER*(*) fName
# Line 102  C !FUNCTIONS Line 106  C !FUNCTIONS
106        EXTERNAL MASTER_CPU_IO        EXTERNAL MASTER_CPU_IO
107    
108  C !LOCAL VARIABLES:  C !LOCAL VARIABLES:
109    C     bBij  :: base shift in Buffer index for tile bi,bj
110        CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName,pfName        CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName,pfName
111        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
112        LOGICAL fileIsOpen        LOGICAL fileIsOpen
# Line 111  C !LOCAL VARIABLES: Line 116  C !LOCAL VARIABLES:
116        LOGICAL zeroBuff        LOGICAL zeroBuff
117        INTEGER xSize, ySize        INTEGER xSize, ySize
118        INTEGER irecord        INTEGER irecord
119        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj
120          INTEGER i1,i2,i,j,k,nNz
121        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
122        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
123        INTEGER length_of_rec        INTEGER length_of_rec
124        Real*4 r4seg(sNx)        INTEGER bBij
       Real*8 r8seg(sNx)  
       Real*4 r4loc(sNx,sNy)  
       Real*8 r8loc(sNx,sNy)  
125        INTEGER tNx, tNy, global_nTx        INTEGER tNx, tNy, global_nTx
126        INTEGER tBx, tBy, iGjLoc, jGjLoc        INTEGER tBx, tBy, iGjLoc, jGjLoc
127  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
128        INTEGER tN        INTEGER tN
129  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
130          _RL dummyRL(1)
131          CHARACTER*8 blank8c
132    
133          DATA dummyRL(1) / 0. _d 0 /
134          DATA blank8c / '        ' /
135    
136  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137  C Set dimensions:  C Set dimensions:
# Line 153  C Assume nothing Line 161  C Assume nothing
161  C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):  C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):
162        iAmDoingIO = MASTER_CPU_IO(myThid)        iAmDoingIO = MASTER_CPU_IO(myThid)
163    
 C Only do I/O if I am the master thread  
       IF ( iAmDoingIO ) THEN  
   
164  C Record number must be >= 1  C Record number must be >= 1
165          IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
166           WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(3A,I10)')
167       &     ' MDS_WRITE_FIELD: argument irecord = ',irecord       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
168           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
169       &                       SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
170            WRITE(msgBuf,'(A,I9.8)')
171         &    ' MDS_WRITE_FIELD: argument irecord = ',irecord
172            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
173         &                      SQUEEZE_RIGHT , myThid )
174           WRITE(msgBuf,'(A)')           WRITE(msgBuf,'(A)')
175       &     ' MDS_WRITE_FIELD: invalid value for irecord'       &    ' MDS_WRITE_FIELD: invalid value for irecord'
176           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
177           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'          CALL ALL_PROC_DIE( myThid )
178          ENDIF          STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
179          ENDIF
180  C check for valid sub-set of levels:  C check for valid sub-set of levels:
181          IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
182           WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3A,I10)')
183       &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
184       &     ' , kLo=', kLo, ' , kHi=', kHi          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
185           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,       &                      SQUEEZE_RIGHT , myThid )
186       &                       SQUEEZE_RIGHT , myThid)          WRITE(msgBuf,'(3(A,I6))')
187           WRITE(msgBuf,'(A)')       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,
188       &     ' MDS_WRITE_FIELD: invalid sub-set of levels'       &    ' , kLo=', kLo, ' , kHi=', kHi
189           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
190           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'       &                      SQUEEZE_RIGHT , myThid )
191          ENDIF          WRITE(msgBuf,'(A)')
192         &    ' MDS_WRITE_FIELD: invalid sub-set of levels'
193            CALL PRINT_ERROR( msgBuf, myThid )
194            CALL ALL_PROC_DIE( myThid )
195            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
196          ENDIF
197    C check for 3-D Buffer size:
198          IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
199            WRITE(msgBuf,'(3A,I10)')
200         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
201            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
202         &                      SQUEEZE_RIGHT , myThid )
203            WRITE(msgBuf,'(3(A,I6))')
204         &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
205         &    ' >', size3dBuf, ' = buffer 3rd Dim'
206            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
207         &                      SQUEEZE_RIGHT , myThid )
208            WRITE(msgBuf,'(A)')
209         &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
210            CALL PRINT_ERROR( msgBuf, myThid )
211            WRITE(msgBuf,'(A)')
212         &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
213            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
214         &                      SQUEEZE_RIGHT , myThid)
215            CALL ALL_PROC_DIE( myThid )
216            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
217          ENDIF
218    
219    C Only do I/O if I am the master thread
220          IF ( iAmDoingIO ) THEN
221    
222  C Assign special directory  C Assign special directory
223          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
# Line 211  C Master thread of process 0, only, open Line 250  C Master thread of process 0, only, open
250           ENDIF           ENDIF
251         ENDIF         ENDIF
252    
253  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
254         DO k=kLo,kHi         DO k=kLo,kHi
255          zeroBuff = k.EQ.kLo          zeroBuff = k.EQ.kLo
256  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
257          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
258            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
259              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
260       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
261            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
262              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
263       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
264            ELSE            ELSE
265              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
266       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
267              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
268                CALL ALL_PROC_DIE( myThid )
269              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
270            ENDIF            ENDIF
271    C Wait for all threads to finish filling shared buffer
272              CALL BAR2( myThid )
273            CALL GATHER_2D_R4(            CALL GATHER_2D_R4(
274       O                       xy_buffer_r4,       O                       xy_buffer_r4,
275       I                       sharedLocBuf_r4,       I                       sharedLocBuf_r4,
# Line 236  C-      copy from arr(level=k) to 2-D "l Line 278  C-      copy from arr(level=k) to 2-D "l
278          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
279            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
280              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
281       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
282    
283            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
284              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
285       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
286            ELSE            ELSE
287              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
288       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
289              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
290                CALL ALL_PROC_DIE( myThid )
291              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
292            ENDIF            ENDIF
293    C Wait for all threads to finish filling shared buffer
294              CALL BAR2( myThid )
295            CALL GATHER_2D_R8(            CALL GATHER_2D_R8(
296       O                       xy_buffer_r8,       O                       xy_buffer_r8,
297       I                       sharedLocBuf_r8,       I                       sharedLocBuf_r8,
298       I                       xSize, ySize,       I                       xSize, ySize,
299       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
300          ELSE          ELSE
301             WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
302       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
303             CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
304             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            CALL ALL_PROC_DIE( myThid )
305              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
306          ENDIF          ENDIF
307    C Make other threads wait for "gather" completion so that after this,
308    C  shared buffer can again be modified by any thread
309            CALL BAR2( myThid )
310    
311          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
312            irec = 1 + k-kLo + (irecord-1)*nNz            irec = 1 + k-kLo + (irecord-1)*nNz
313            IF (filePrec .EQ. precFloat32) THEN            IF ( filePrec.EQ.precFloat32 ) THEN
314  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
315             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
316  #endif  #endif
317             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
318            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSE
319  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
320             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
321  #endif  #endif
322             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
           ELSE  
            WRITE(msgBuf,'(A)')  
      &       ' MDS_WRITE_FIELD: illegal value for filePrec'  
            CALL PRINT_ERROR( msgBuf, myThid )  
            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
323            ENDIF            ENDIF
324  C-      end if iAmDoingIO  C-      end if iAmDoingIO
325          ENDIF          ENDIF
# Line 290  C---+----1----+----2----+----3----+----4 Line 335  C---+----1----+----2----+----3----+----4
335  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
336        ELSE        ELSE
337    
338    C---    Copy from arr to 3-D buffer (multi-threads):
339            IF ( filePrec.EQ.precFloat32 ) THEN
340              IF ( arrType.EQ.'RS' ) THEN
341                CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,
342         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
343              ELSEIF ( arrType.EQ.'RL' ) THEN
344                CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
345         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
346              ELSE
347                WRITE(msgBuf,'(2A)')
348         &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
349                CALL PRINT_ERROR( msgBuf, myThid )
350                CALL ALL_PROC_DIE( myThid )
351                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
352              ENDIF
353            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
354              IF ( arrType.EQ.'RS' ) THEN
355                CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,
356         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
357              ELSEIF ( arrType.EQ.'RL' ) THEN
358                CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
359         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
360              ELSE
361                WRITE(msgBuf,'(2A)')
362         &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
363                CALL PRINT_ERROR( msgBuf, myThid )
364                CALL ALL_PROC_DIE( myThid )
365                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
366              ENDIF
367            ELSE
368              WRITE(msgBuf,'(A,I6)')
369         &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
370              CALL PRINT_ERROR( msgBuf, myThid )
371              CALL ALL_PROC_DIE( myThid )
372              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
373            ENDIF
374    
375    C Wait for all threads to finish filling shared buffer
376           CALL BAR2( myThid )
377    
378  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
379         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
380    
381    #ifdef _BYTESWAPIO
382            IF ( filePrec.EQ.precFloat32 ) THEN
383              CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
384            ELSE
385              CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
386            ENDIF
387    #endif
388    
389  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
390          IF (globalFile) THEN          IF (globalFile) THEN
391           WRITE(dataFName,'(2a)') fName(1:IL),'.data'            WRITE(dataFName,'(2a)') fName(1:IL),'.data'
392           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )            length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
393           IF (irecord .EQ. 1) THEN            IF (irecord .EQ. 1) THEN
394            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,             OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
395       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
396           ELSE            ELSE
397            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,             OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
398       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
399           ENDIF            ENDIF
400           fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
401          ENDIF          ENDIF
402    
403  C Loop over all tiles  C Loop over all tiles
404          DO bj=1,nSy          DO bj=1,nSy
405           DO bi=1,nSx           DO bi=1,nSx
406              bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
407    
408            tNx = sNx            tNx = sNx
409            tNy = sNy            tNy = sNy
# Line 318  C Loop over all tiles Line 412  C Loop over all tiles
412            tBy = myYGlobalLo-1 + (bj-1)*sNy            tBy = myYGlobalLo-1 + (bj-1)*sNy
413  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
414            IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
415              tN = W2_myTileList(bi)              tN = W2_myTileList(bi,bj)
416  c           tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
417  c           tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
418  c           global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
# Line 348  C--- Case of 1 Global file: Line 442  C--- Case of 1 Global file:
442               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
443       &                + ( tBy + (j-1)*jGjLoc )*global_nTx       &                + ( tBy + (j-1)*jGjLoc )*global_nTx
444       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
445               IF (filePrec .EQ. precFloat32) THEN               i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
446                IF (arrType .EQ. 'RS') THEN               i2 = bBij +         j*sNx + (k-kLo)*sNx*sNy
447                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )               IF ( filePrec.EQ.precFloat32 ) THEN
448                ELSEIF (arrType .EQ. 'RL') THEN                WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
                CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &           ' MDS_WRITE_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
               ENDIF  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR4( sNx, r4seg )  
 #endif  
               WRITE(dUnit,rec=irec) r4seg  
              ELSEIF (filePrec .EQ. precFloat64) THEN  
               IF (arrType .EQ. 'RS') THEN  
                CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )  
               ELSEIF (arrType .EQ. 'RL') THEN  
                CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &           ' MDS_WRITE_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
               ENDIF  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR8( sNx, r8seg )  
 #endif  
               WRITE(dUnit,rec=irec) r8seg  
449               ELSE               ELSE
450                WRITE(msgBuf,'(A)')                WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
      &          ' MDS_WRITE_FIELD: illegal value for filePrec'  
               CALL PRINT_ERROR( msgBuf, myThid )  
               STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
451               ENDIF               ENDIF
452  C End of j loop  C End of j,k loops
453              ENDDO              ENDDO
 C End of k loop  
454             ENDDO             ENDDO
455    
456            ELSE            ELSE
# Line 396  C If we are writing to a tiled MDS file Line 460  C If we are writing to a tiled MDS file
460             iG=bi+(myXGlobalLo-1)/sNx             iG=bi+(myXGlobalLo-1)/sNx
461             jG=bj+(myYGlobalLo-1)/sNy             jG=bj+(myYGlobalLo-1)/sNy
462             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
463       &              pfName(1:pIL),'.',iG,'.',jG,'.data'       &            pfName(1:pIL),'.',iG,'.',jG,'.data'
464             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy, myThid )             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
465             IF (irecord .EQ. 1) THEN             IF (irecord .EQ. 1) THEN
466              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
467       &            access='direct', recl=length_of_rec )       &            access='direct', recl=length_of_rec )
# Line 407  C If we are writing to a tiled MDS file Line 471  C If we are writing to a tiled MDS file
471             ENDIF             ENDIF
472             fileIsOpen=.TRUE.             fileIsOpen=.TRUE.
473    
474             DO k=kLo,kHi             irec = irecord
475               i1 = bBij + 1
476               irec = 1 + k-kLo + (irecord-1)*nNz             i2 = bBij + sNx*sNy*nNz
477               IF (filePrec .EQ. precFloat32) THEN             IF ( filePrec.EQ.precFloat32 ) THEN
478                IF ( arrType.EQ.'RS' ) THEN               WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
479                 CALL MDS_PASS_R4toRS( r4loc, arr,             ELSE
480       I                           k, kSize, bi,bj,.FALSE., myThid )               WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
481                ELSEIF ( arrType.EQ.'RL' ) THEN             ENDIF
                CALL MDS_PASS_R4toRL( r4loc, arr,  
      I                           k, kSize, bi,bj,.FALSE., myThid )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &           ' MDS_WRITE_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
               ENDIF  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR4( sNx*sNy, r4loc )  
 #endif  
               WRITE(dUnit,rec=irec) r4loc  
              ELSEIF (filePrec .EQ. precFloat64) THEN  
               IF ( arrType.EQ.'RS' ) THEN  
                CALL MDS_PASS_R8toRS( r8loc, arr,  
      I                           k, kSize, bi,bj,.FALSE., myThid )  
               ELSEIF ( arrType.EQ.'RL' ) THEN  
                CALL MDS_PASS_R8toRL( r8loc, arr,  
      I                           k, kSize, bi,bj,.FALSE., myThid )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &           ' MDS_WRITE_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
               ENDIF  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR8( sNx*sNy, r8loc )  
 #endif  
               WRITE(dUnit,rec=irec) r8loc  
              ELSE  
               WRITE(msgBuf,'(A)')  
      &          ' MDS_WRITE_FIELD: illegal value for filePrec'  
               CALL PRINT_ERROR( msgBuf, myThid )  
               STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'  
              ENDIF  
   
 C End of k loop  
            ENDDO  
482    
483  C here We close the tiled MDS file  C here We close the tiled MDS file
484             IF ( fileIsOpen ) THEN             IF ( fileIsOpen ) THEN
485              CLOSE( dUnit )               CLOSE( dUnit )
486              fileIsOpen = .FALSE.               fileIsOpen = .FALSE.
487             ENDIF             ENDIF
488    
489  C--- End Global File / tile-file cases  C--- End Global File / tile-file cases
# Line 487  c          dimList(3,3) = kHi Line 513  c          dimList(3,3) = kHi
513             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
514             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
515       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
516       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
517       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
518            ENDIF            ENDIF
519    
520  C End of bi,bj loops  C End of bi,bj loops
# Line 497  C End of bi,bj loops Line 523  C End of bi,bj loops
523    
524  C If global file was opened then close it  C If global file was opened then close it
525          IF (fileIsOpen .AND. globalFile) THEN          IF (fileIsOpen .AND. globalFile) THEN
526           CLOSE( dUnit )            CLOSE( dUnit )
527           fileIsOpen = .FALSE.            fileIsOpen = .FALSE.
528          ENDIF          ENDIF
529    
530  C- endif iAmDoingIO  C- endif iAmDoingIO
531         ENDIF         ENDIF
532    
533    C Make other threads wait for I/O completion so that after this,
534    C  3-D buffer can again be modified by any thread
535           CALL BAR2( myThid )
536    
537  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
538        ENDIF        ENDIF
539    
# Line 529  c        dimList(3,3) = kHi Line 559  c        dimList(3,3) = kHi
559           map2gl(2) = 1           map2gl(2) = 1
560           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
561       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
562       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
563       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
564  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
565  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
566  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
567        ENDIF        ENDIF
568    
 C To be safe, make other processes wait for I/O completion  
       _BARRIER  
   
569  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
570        RETURN        RETURN
571        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22