/[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.14 by jmc, Sun Jun 28 01:06:39 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
# Line 153  C Assume nothing Line 156  C Assume nothing
156  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):
157        iAmDoingIO = MASTER_CPU_IO(myThid)        iAmDoingIO = MASTER_CPU_IO(myThid)
158    
 C Only do I/O if I am the master thread  
       IF ( iAmDoingIO ) THEN  
   
159  C Record number must be >= 1  C Record number must be >= 1
160          IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
161           WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(3A,I10)')
162       &     ' MDS_WRITE_FIELD: argument irecord = ',irecord       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
163           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
164       &                       SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
165            WRITE(msgBuf,'(A,I9.8)')
166         &    ' MDS_WRITE_FIELD: argument irecord = ',irecord
167            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
168         &                      SQUEEZE_RIGHT , myThid )
169           WRITE(msgBuf,'(A)')           WRITE(msgBuf,'(A)')
170       &     ' MDS_WRITE_FIELD: invalid value for irecord'       &    ' MDS_WRITE_FIELD: invalid value for irecord'
171           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
172           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'          CALL ALL_PROC_DIE( myThid )
173          ENDIF          STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
174          ENDIF
175  C check for valid sub-set of levels:  C check for valid sub-set of levels:
176          IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
177           WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3A,I10)')
178       &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,       &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
179       &     ' , kLo=', kLo, ' , kHi=', kHi          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
180           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,       &                      SQUEEZE_RIGHT , myThid )
181       &                       SQUEEZE_RIGHT , myThid)          WRITE(msgBuf,'(3(A,I6))')
182           WRITE(msgBuf,'(A)')       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,
183       &     ' MDS_WRITE_FIELD: invalid sub-set of levels'       &    ' , kLo=', kLo, ' , kHi=', kHi
184           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
185           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'       &                      SQUEEZE_RIGHT , myThid )
186          ENDIF          WRITE(msgBuf,'(A)')
187         &    ' MDS_WRITE_FIELD: invalid sub-set of levels'
188            CALL PRINT_ERROR( msgBuf, myThid )
189            CALL ALL_PROC_DIE( myThid )
190            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
191          ENDIF
192    C check for 3-D Buffer size:
193          IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
194            WRITE(msgBuf,'(3A,I10)')
195         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
196            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
197         &                      SQUEEZE_RIGHT , myThid )
198            WRITE(msgBuf,'(3(A,I6))')
199         &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
200         &    ' >', size3dBuf, ' = buffer 3rd Dim'
201            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
202         &                      SQUEEZE_RIGHT , myThid )
203            WRITE(msgBuf,'(A)')
204         &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
205            CALL PRINT_ERROR( msgBuf, myThid )
206            WRITE(msgBuf,'(A)')
207         &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
208            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
209         &                      SQUEEZE_RIGHT , myThid)
210            CALL ALL_PROC_DIE( myThid )
211            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
212          ENDIF
213    
214    C Only do I/O if I am the master thread
215          IF ( iAmDoingIO ) THEN
216    
217  C Assign special directory  C Assign special directory
218          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 245  C Master thread of process 0, only, open
245           ENDIF           ENDIF
246         ENDIF         ENDIF
247    
248  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
249         DO k=kLo,kHi         DO k=kLo,kHi
250          zeroBuff = k.EQ.kLo          zeroBuff = k.EQ.kLo
251  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
252          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
253            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
254              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
255       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
256            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
257              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
258       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
259            ELSE            ELSE
260              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
261       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
262              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
263                CALL ALL_PROC_DIE( myThid )
264              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
265            ENDIF            ENDIF
266    C Wait for all threads to finish filling shared buffer
267              CALL BAR2( myThid )
268            CALL GATHER_2D_R4(            CALL GATHER_2D_R4(
269       O                       xy_buffer_r4,       O                       xy_buffer_r4,
270       I                       sharedLocBuf_r4,       I                       sharedLocBuf_r4,
# Line 236  C-      copy from arr(level=k) to 2-D "l Line 273  C-      copy from arr(level=k) to 2-D "l
273          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
274            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
275              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
276       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
277    
278            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
279              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
280       I                            k, kSize, 0,0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
281            ELSE            ELSE
282              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
283       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
284              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
285                CALL ALL_PROC_DIE( myThid )
286              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
287            ENDIF            ENDIF
288    C Wait for all threads to finish filling shared buffer
289              CALL BAR2( myThid )
290            CALL GATHER_2D_R8(            CALL GATHER_2D_R8(
291       O                       xy_buffer_r8,       O                       xy_buffer_r8,
292       I                       sharedLocBuf_r8,       I                       sharedLocBuf_r8,
293       I                       xSize, ySize,       I                       xSize, ySize,
294       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
295          ELSE          ELSE
296             WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
297       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
298             CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
299             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            CALL ALL_PROC_DIE( myThid )
300              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
301          ENDIF          ENDIF
302    C Make other threads wait for "gather" completion so that after this,
303    C  shared buffer can again be modified by any thread
304            CALL BAR2( myThid )
305    
306          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
307            irec = 1 + k-kLo + (irecord-1)*nNz            irec = 1 + k-kLo + (irecord-1)*nNz
308            IF (filePrec .EQ. precFloat32) THEN            IF ( filePrec.EQ.precFloat32 ) THEN
309  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
310             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
311  #endif  #endif
312             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
313            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSE
314  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
315             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
316  #endif  #endif
317             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'  
318            ENDIF            ENDIF
319  C-      end if iAmDoingIO  C-      end if iAmDoingIO
320          ENDIF          ENDIF
# Line 290  C---+----1----+----2----+----3----+----4 Line 330  C---+----1----+----2----+----3----+----4
330  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
331        ELSE        ELSE
332    
333    C---    Copy from arr to 3-D buffer (multi-threads):
334            IF ( filePrec.EQ.precFloat32 ) THEN
335              IF ( arrType.EQ.'RS' ) THEN
336                CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,
337         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
338              ELSEIF ( arrType.EQ.'RL' ) THEN
339                CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
340         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
341              ELSE
342                WRITE(msgBuf,'(2A)')
343         &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
344                CALL PRINT_ERROR( msgBuf, myThid )
345                CALL ALL_PROC_DIE( myThid )
346                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
347              ENDIF
348            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
349              IF ( arrType.EQ.'RS' ) THEN
350                CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,
351         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
352              ELSEIF ( arrType.EQ.'RL' ) THEN
353                CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
354         I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
355              ELSE
356                WRITE(msgBuf,'(2A)')
357         &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
358                CALL PRINT_ERROR( msgBuf, myThid )
359                CALL ALL_PROC_DIE( myThid )
360                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
361              ENDIF
362            ELSE
363              WRITE(msgBuf,'(A,I6)')
364         &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
365              CALL PRINT_ERROR( msgBuf, myThid )
366              CALL ALL_PROC_DIE( myThid )
367              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
368            ENDIF
369    
370    C Wait for all threads to finish filling shared buffer
371           CALL BAR2( myThid )
372    
373  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
374         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
375    
376    #ifdef _BYTESWAPIO
377            IF ( filePrec.EQ.precFloat32 ) THEN
378              CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
379            ELSE
380              CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
381            ENDIF
382    #endif
383    
384  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
385          IF (globalFile) THEN          IF (globalFile) THEN
386           WRITE(dataFName,'(2a)') fName(1:IL),'.data'            WRITE(dataFName,'(2a)') fName(1:IL),'.data'
387           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )            length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
388           IF (irecord .EQ. 1) THEN            IF (irecord .EQ. 1) THEN
389            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,             OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
390       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
391           ELSE            ELSE
392            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,             OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
393       &            access='direct', recl=length_of_rec )       &             access='direct', recl=length_of_rec )
394           ENDIF            ENDIF
395           fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
396          ENDIF          ENDIF
397    
398  C Loop over all tiles  C Loop over all tiles
399          DO bj=1,nSy          DO bj=1,nSy
400           DO bi=1,nSx           DO bi=1,nSx
401              bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
402    
403            tNx = sNx            tNx = sNx
404            tNy = sNy            tNy = sNy
# Line 318  C Loop over all tiles Line 407  C Loop over all tiles
407            tBy = myYGlobalLo-1 + (bj-1)*sNy            tBy = myYGlobalLo-1 + (bj-1)*sNy
408  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
409            IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
410              tN = W2_myTileList(bi)              tN = W2_myTileList(bi,bj)
411  c           tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
412  c           tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
413  c           global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
# Line 348  C--- Case of 1 Global file: Line 437  C--- Case of 1 Global file:
437               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
438       &                + ( tBy + (j-1)*jGjLoc )*global_nTx       &                + ( tBy + (j-1)*jGjLoc )*global_nTx
439       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
440               IF (filePrec .EQ. precFloat32) THEN               i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
441                IF (arrType .EQ. 'RS') THEN               i2 = bBij +         j*sNx + (k-kLo)*sNx*sNy
442                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )               IF ( filePrec.EQ.precFloat32 ) THEN
443                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  
444               ELSE               ELSE
445                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'  
446               ENDIF               ENDIF
447  C End of j loop  C End of j,k loops
448              ENDDO              ENDDO
 C End of k loop  
449             ENDDO             ENDDO
450    
451            ELSE            ELSE
# Line 396  C If we are writing to a tiled MDS file Line 455  C If we are writing to a tiled MDS file
455             iG=bi+(myXGlobalLo-1)/sNx             iG=bi+(myXGlobalLo-1)/sNx
456             jG=bj+(myYGlobalLo-1)/sNy             jG=bj+(myYGlobalLo-1)/sNy
457             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
458       &              pfName(1:pIL),'.',iG,'.',jG,'.data'       &            pfName(1:pIL),'.',iG,'.',jG,'.data'
459             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy, myThid )             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
460             IF (irecord .EQ. 1) THEN             IF (irecord .EQ. 1) THEN
461              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
462       &            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 466  C If we are writing to a tiled MDS file
466             ENDIF             ENDIF
467             fileIsOpen=.TRUE.             fileIsOpen=.TRUE.
468    
469             DO k=kLo,kHi             irec = irecord
470               i1 = bBij + 1
471               irec = 1 + k-kLo + (irecord-1)*nNz             i2 = bBij + sNx*sNy*nNz
472               IF (filePrec .EQ. precFloat32) THEN             IF ( filePrec.EQ.precFloat32 ) THEN
473                IF ( arrType.EQ.'RS' ) THEN               WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
474                 CALL MDS_PASS_R4toRS( r4loc, arr,             ELSE
475       I                           k, kSize, bi,bj,.FALSE., myThid )               WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
476                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  
477    
478  C here We close the tiled MDS file  C here We close the tiled MDS file
479             IF ( fileIsOpen ) THEN             IF ( fileIsOpen ) THEN
480              CLOSE( dUnit )               CLOSE( dUnit )
481              fileIsOpen = .FALSE.               fileIsOpen = .FALSE.
482             ENDIF             ENDIF
483    
484  C--- End Global File / tile-file cases  C--- End Global File / tile-file cases
# Line 497  C End of bi,bj loops Line 518  C End of bi,bj loops
518    
519  C If global file was opened then close it  C If global file was opened then close it
520          IF (fileIsOpen .AND. globalFile) THEN          IF (fileIsOpen .AND. globalFile) THEN
521           CLOSE( dUnit )            CLOSE( dUnit )
522           fileIsOpen = .FALSE.            fileIsOpen = .FALSE.
523          ENDIF          ENDIF
524    
525  C- endif iAmDoingIO  C- endif iAmDoingIO
526         ENDIF         ENDIF
527    
528    C Make other threads wait for I/O completion so that after this,
529    C  3-D buffer can again be modified by any thread
530           CALL BAR2( myThid )
531    
532  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
533        ENDIF        ENDIF
534    
# Line 536  c    I              filePrec, nDims, dim Line 561  c    I              filePrec, nDims, dim
561  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
562        ENDIF        ENDIF
563    
 C To be safe, make other processes wait for I/O completion  
       _BARRIER  
   
564  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
565        RETURN        RETURN
566        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22