/[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.11 by jmc, Mon Jun 8 03:32:33 2009 UTC
# Line 76  C Global variables / common blocks Line 76  C Global variables / common blocks
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    #include "MDSIO_BUFF_3D.h"
80    
81  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
82        CHARACTER*(*) fName        CHARACTER*(*) fName
# Line 102  C !FUNCTIONS Line 103  C !FUNCTIONS
103        EXTERNAL MASTER_CPU_IO        EXTERNAL MASTER_CPU_IO
104    
105  C !LOCAL VARIABLES:  C !LOCAL VARIABLES:
106    C     bBij  :: base shift in Buffer index for tile bi,bj
107        CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName,pfName        CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName,pfName
108        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
109        LOGICAL fileIsOpen        LOGICAL fileIsOpen
# Line 111  C !LOCAL VARIABLES: Line 113  C !LOCAL VARIABLES:
113        LOGICAL zeroBuff        LOGICAL zeroBuff
114        INTEGER xSize, ySize        INTEGER xSize, ySize
115        INTEGER irecord        INTEGER irecord
116        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj
117          INTEGER i1,i2,i,j,k,nNz
118        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
119        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
120        INTEGER length_of_rec        INTEGER length_of_rec
121        Real*4 r4seg(sNx)        INTEGER bBij
       Real*8 r8seg(sNx)  
       Real*4 r4loc(sNx,sNy)  
       Real*8 r8loc(sNx,sNy)  
122        INTEGER tNx, tNy, global_nTx        INTEGER tNx, tNy, global_nTx
123        INTEGER tBx, tBy, iGjLoc, jGjLoc        INTEGER tBx, tBy, iGjLoc, jGjLoc
124  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
# Line 153  C Assume nothing Line 153  C Assume nothing
153  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):
154        iAmDoingIO = MASTER_CPU_IO(myThid)        iAmDoingIO = MASTER_CPU_IO(myThid)
155    
 C Only do I/O if I am the master thread  
       IF ( iAmDoingIO ) THEN  
   
156  C Record number must be >= 1  C Record number must be >= 1
157          IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
158           WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(A,I9.8)')
159       &     ' MDS_WRITE_FIELD: argument irecord = ',irecord       &    ' MDS_WRITE_FIELD: argument irecord = ',irecord
160           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
161       &                       SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
162           WRITE(msgBuf,'(A)')           WRITE(msgBuf,'(A)')
163       &     ' MDS_WRITE_FIELD: invalid value for irecord'       &    ' MDS_WRITE_FIELD: invalid value for irecord'
164           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
165           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'          CALL ALL_PROC_DIE( myThid )
166          ENDIF          STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
167          ENDIF
168  C check for valid sub-set of levels:  C check for valid sub-set of levels:
169          IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
170           WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
171       &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,
172       &     ' , kLo=', kLo, ' , kHi=', kHi       &    ' , kLo=', kLo, ' , kHi=', kHi
173           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
174       &                       SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
175           WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
176       &     ' MDS_WRITE_FIELD: invalid sub-set of levels'       &    ' MDS_WRITE_FIELD: invalid sub-set of levels'
177           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
178           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'          CALL ALL_PROC_DIE( myThid )
179          ENDIF          STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
180          ENDIF
181    C check for 3-D Buffer size:
182          IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
183            WRITE(msgBuf,'(3(A,I6))')
184         &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
185         &    ' >', size3dBuf, ' = buffer 3rd Dim'
186            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
187         &                      SQUEEZE_RIGHT , myThid)
188            WRITE(msgBuf,'(A)')
189         &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
190            CALL PRINT_ERROR( msgBuf, myThid )
191            WRITE(msgBuf,'(A)')
192         &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
193            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
194         &                      SQUEEZE_RIGHT , myThid)
195            CALL ALL_PROC_DIE( myThid )
196            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
197          ENDIF
198    
199    C Only do I/O if I am the master thread
200          IF ( iAmDoingIO ) THEN
201    
202  C Assign special directory  C Assign special directory
203          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 230  C Master thread of process 0, only, open
230           ENDIF           ENDIF
231         ENDIF         ENDIF
232    
233  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
234         DO k=kLo,kHi         DO k=kLo,kHi
235          zeroBuff = k.EQ.kLo          zeroBuff = k.EQ.kLo
236  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
237          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
238            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
239              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
240       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
241            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
242              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
243       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
244            ELSE            ELSE
245              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
246       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
247              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
248                CALL ALL_PROC_DIE( myThid )
249              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
250            ENDIF            ENDIF
251    C Wait for all threads to finish filling shared buffer
252              CALL BAR2( myThid )
253            CALL GATHER_2D_R4(            CALL GATHER_2D_R4(
254       O                       xy_buffer_r4,       O                       xy_buffer_r4,
255       I                       sharedLocBuf_r4,       I                       sharedLocBuf_r4,
# Line 236  C-      copy from arr(level=k) to 2-D "l Line 258  C-      copy from arr(level=k) to 2-D "l
258          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
259            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
260              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
261       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
262    
263            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
264              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
265       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
266            ELSE            ELSE
267              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
268       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
269              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
270                CALL ALL_PROC_DIE( myThid )
271              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
272            ENDIF            ENDIF
273    C Wait for all threads to finish filling shared buffer
274              CALL BAR2( myThid )
275            CALL GATHER_2D_R8(            CALL GATHER_2D_R8(
276       O                       xy_buffer_r8,       O                       xy_buffer_r8,
277       I                       sharedLocBuf_r8,       I                       sharedLocBuf_r8,
# Line 255  C-      copy from arr(level=k) to 2-D "l Line 281  C-      copy from arr(level=k) to 2-D "l
281             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
282       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
283             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
284               CALL ALL_PROC_DIE( myThid )
285             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
286          ENDIF          ENDIF
287    C Make other threads wait for "gather" completion so that after this,
288    C  shared buffer can again be modified by any thread
289            CALL BAR2( myThid )
290    
291          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
292            irec = 1 + k-kLo + (irecord-1)*nNz            irec = 1 + k-kLo + (irecord-1)*nNz
293            IF (filePrec .EQ. precFloat32) THEN            IF ( filePrec.EQ.precFloat32 ) THEN
294  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
295             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
296  #endif  #endif
297             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
298            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSE
299  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
300             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
301  #endif  #endif
302             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'  
303            ENDIF            ENDIF
304  C-      end if iAmDoingIO  C-      end if iAmDoingIO
305          ENDIF          ENDIF
# Line 290  C---+----1----+----2----+----3----+----4 Line 315  C---+----1----+----2----+----3----+----4
315  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
316        ELSE        ELSE
317    
318    C---    Copy from arr to 3-D buffer (multi-threads):
319            IF ( filePrec.EQ.precFloat32 ) THEN
320              IF ( arrType.EQ.'RS' ) THEN
321                CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,
322         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
323              ELSEIF ( arrType.EQ.'RL' ) THEN
324                CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
325         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
326              ELSE
327                WRITE(msgBuf,'(A)')
328         &         ' MDS_WRITE_FIELD: illegal value for arrType'
329                CALL PRINT_ERROR( msgBuf, myThid )
330                CALL ALL_PROC_DIE( myThid )
331                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
332              ENDIF
333            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
334              IF ( arrType.EQ.'RS' ) THEN
335                CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,
336         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
337              ELSEIF ( arrType.EQ.'RL' ) THEN
338                CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
339         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
340              ELSE
341                WRITE(msgBuf,'(A)')
342         &         ' MDS_WRITE_FIELD: illegal value for arrType'
343                CALL PRINT_ERROR( msgBuf, myThid )
344                CALL ALL_PROC_DIE( myThid )
345                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
346              ENDIF
347            ELSE
348              WRITE(msgBuf,'(A)')
349         &         ' MDS_WRITE_FIELD: illegal value for filePrec'
350              CALL PRINT_ERROR( msgBuf, myThid )
351              CALL ALL_PROC_DIE( myThid )
352              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
353            ENDIF
354    
355    C Wait for all threads to finish filling shared buffer
356           CALL BAR2( myThid )
357    
358  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
359         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
360    
361    #ifdef _BYTESWAPIO
362            IF ( filePrec.EQ.precFloat32 ) THEN
363              CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
364            ELSE
365              CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
366            ENDIF
367    #endif
368    
369  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
370          IF (globalFile) THEN          IF (globalFile) THEN
371           WRITE(dataFName,'(2a)') fName(1:IL),'.data'            WRITE(dataFName,'(2a)') fName(1:IL),'.data'
372           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )            length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
373           IF (irecord .EQ. 1) THEN            IF (irecord .EQ. 1) THEN
374            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,             OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
375       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
376           ELSE            ELSE
377            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,             OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
378       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
379           ENDIF            ENDIF
380           fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
381          ENDIF          ENDIF
382    
383  C Loop over all tiles  C Loop over all tiles
384          DO bj=1,nSy          DO bj=1,nSy
385           DO bi=1,nSx           DO bi=1,nSx
386              bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
387    
388            tNx = sNx            tNx = sNx
389            tNy = sNy            tNy = sNy
# Line 348  C--- Case of 1 Global file: Line 422  C--- Case of 1 Global file:
422               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
423       &                + ( tBy + (j-1)*jGjLoc )*global_nTx       &                + ( tBy + (j-1)*jGjLoc )*global_nTx
424       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
425               IF (filePrec .EQ. precFloat32) THEN               i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
426                IF (arrType .EQ. 'RS') THEN               i2 = bBij +         j*sNx + (k-kLo)*sNx*sNy
427                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )               IF ( filePrec.EQ.precFloat32 ) THEN
428                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  
429               ELSE               ELSE
430                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'  
431               ENDIF               ENDIF
432  C End of j loop  C End of j,k loops
433              ENDDO              ENDDO
 C End of k loop  
434             ENDDO             ENDDO
435    
436            ELSE            ELSE
# Line 396  C If we are writing to a tiled MDS file Line 440  C If we are writing to a tiled MDS file
440             iG=bi+(myXGlobalLo-1)/sNx             iG=bi+(myXGlobalLo-1)/sNx
441             jG=bj+(myYGlobalLo-1)/sNy             jG=bj+(myYGlobalLo-1)/sNy
442             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
443       &              pfName(1:pIL),'.',iG,'.',jG,'.data'       &            pfName(1:pIL),'.',iG,'.',jG,'.data'
444             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy, myThid )             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
445             IF (irecord .EQ. 1) THEN             IF (irecord .EQ. 1) THEN
446              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
447       &            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 451  C If we are writing to a tiled MDS file
451             ENDIF             ENDIF
452             fileIsOpen=.TRUE.             fileIsOpen=.TRUE.
453    
454             DO k=kLo,kHi             irec = irecord
455               i1 = bBij + 1
456               irec = 1 + k-kLo + (irecord-1)*nNz             i2 = bBij + sNx*sNy*nNz
457               IF (filePrec .EQ. precFloat32) THEN             IF ( filePrec.EQ.precFloat32 ) THEN
458                IF ( arrType.EQ.'RS' ) THEN               WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
459                 CALL MDS_PASS_R4toRS( r4loc, arr,             ELSE
460       I                           k, kSize, bi,bj,.FALSE., myThid )               WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
461                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  
462    
463  C here We close the tiled MDS file  C here We close the tiled MDS file
464             IF ( fileIsOpen ) THEN             IF ( fileIsOpen ) THEN
465              CLOSE( dUnit )               CLOSE( dUnit )
466              fileIsOpen = .FALSE.               fileIsOpen = .FALSE.
467             ENDIF             ENDIF
468    
469  C--- End Global File / tile-file cases  C--- End Global File / tile-file cases
# Line 497  C End of bi,bj loops Line 503  C End of bi,bj loops
503    
504  C If global file was opened then close it  C If global file was opened then close it
505          IF (fileIsOpen .AND. globalFile) THEN          IF (fileIsOpen .AND. globalFile) THEN
506           CLOSE( dUnit )            CLOSE( dUnit )
507           fileIsOpen = .FALSE.            fileIsOpen = .FALSE.
508          ENDIF          ENDIF
509    
510  C- endif iAmDoingIO  C- endif iAmDoingIO
511         ENDIF         ENDIF
512    
513    C Make other threads wait for I/O completion so that after this,
514    C  3-D buffer can again be modified by any thread
515           CALL BAR2( myThid )
516    
517  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
518        ENDIF        ENDIF
519    
# Line 536  c    I              filePrec, nDims, dim Line 546  c    I              filePrec, nDims, dim
546  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
547        ENDIF        ENDIF
548    
 C To be safe, make other processes wait for I/O completion  
       _BARRIER  
   
549  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
550        RETURN        RETURN
551        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22