/[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.4 by jmc, Tue Nov 13 19:37:44 2007 UTC revision 1.8 by jmc, Tue May 12 19:56:36 2009 UTC
# Line 69  C !USES: Line 69  C !USES:
69  C Global variables / common blocks  C Global variables / common blocks
70  #include "SIZE.h"  #include "SIZE.h"
71  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
72  #include "PARAMS.h"  #include "PARAMS.h"
73  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
74    #include "W2_EXCH2_SIZE.h"
75  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
76  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
77  #include "MDSIO_SCPU.h"  #include "MDSIO_SCPU.h"
78    
# Line 107  C !LOCAL VARIABLES: Line 106  C !LOCAL VARIABLES:
106        LOGICAL fileIsOpen        LOGICAL fileIsOpen
107        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
108        LOGICAL writeMetaF        LOGICAL writeMetaF
109          LOGICAL keepBlankTileIO
110          LOGICAL zeroBuff
111          INTEGER xSize, ySize
112        INTEGER irecord        INTEGER irecord
113        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj,i,j,k,nNz
114        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
115        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
116        INTEGER iGjLoc, jGjLoc        INTEGER iGjLoc, jGjLoc
117        INTEGER x_size,y_size,length_of_rec        INTEGER length_of_rec
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
       INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo  
       PARAMETER ( x_size = exch2_domain_nxt * sNx )  
       PARAMETER ( y_size = exch2_domain_nyt * sNy )  
 #else  
       PARAMETER ( x_size = Nx )  
       PARAMETER ( y_size = Ny )  
 #endif  
118        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
119        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
       Real*4 xy_buffer_r4(x_size,y_size)  
       Real*8 xy_buffer_r8(x_size,y_size)  
       Real*8 globalBuf(Nx,Ny)  
120  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
121  c     INTEGER tGy,tGx,tNy,tNx,tN  c     INTEGER tGy,tGx,tNy,tNx,tN
122        INTEGER tGy,tGx,    tNx,tN        INTEGER tGy,tGx,    tNx,tN
123          INTEGER global_nTx
124  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
125        INTEGER tNy        INTEGER tNy
126    
127  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128    C Set dimensions:
129          xSize = Nx
130          ySize = Ny
131          keepBlankTileIO = .FALSE.
132    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
133          xSize = exch2_global_Nx
134          ySize = exch2_global_Ny
135          keepBlankTileIO = .TRUE.
136    #endif
137    
138  C-    default:  C-    default:
139        iGjLoc = 0        iGjLoc = 0
# Line 197  C globalFile is too slow, then try using Line 198  C globalFile is too slow, then try using
198  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
199         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
200           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
201           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,myThid)           length_of_rec=MDS_RECLEN(filePrec,xSize*ySize,myThid)
202           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
203            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
204       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
# Line 209  C Master thread of process 0, only, open Line 210  C Master thread of process 0, only, open
210    
211  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
212         DO k=kLo,kHi         DO k=kLo,kHi
213            zeroBuff = k.EQ.kLo
214  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
215          IF ( arrType.EQ.'RS' ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
216            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)            IF ( arrType.EQ.'RS' ) THEN
217          ELSEIF ( arrType.EQ.'RL' ) THEN              CALL MDS_PASS_R4toRS( sharedLocBuf_r4,
218            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)       &                            arr, k, kSize, .FALSE., myThid )
219          ELSE            ELSEIF ( arrType.EQ.'RL' ) THEN
220            WRITE(msgBuf,'(A)')              CALL MDS_PASS_R4toRL( sharedLocBuf_r4,
221         &                            arr, k, kSize, .FALSE., myThid )
222              ELSE
223                WRITE(msgBuf,'(A)')
224       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
225            CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
226            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
         ENDIF  
         CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )  
   
         IF ( iAmDoingIO ) THEN  
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
           IF (filePrec .EQ. precFloat32) THEN  
            DO J=1,y_size  
             DO I=1,x_size  
              xy_buffer_r4(I,J) = 0.0  
             ENDDO  
            ENDDO  
           ELSEIF (filePrec .EQ. precFloat64) THEN  
            DO J=1,y_size  
             DO I=1,x_size  
              xy_buffer_r8(I,J) = 0.0  
             ENDDO  
            ENDDO  
227            ENDIF            ENDIF
228              CALL GATHER_2D_R4(
229            bj=1       U                       xy_buffer_r4,
230            DO npe=1,nPx*nPy       O                       sharedLocBuf_r4,
231             DO bi=1,nSx       I                       xSize, ySize,
232  #ifdef ALLOW_USE_MPI       I                       keepBlankTileIO, zeroBuff, myThid )
233              loc_xGlobalLo = mpi_myXGlobalLo(npe)          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
234              loc_yGlobalLo = mpi_myYGlobalLo(npe)            IF ( arrType.EQ.'RS' ) THEN
235  #else  /* ALLOW_USE_MPI */              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,
236              loc_xGlobalLo = myXGlobalLo       &                            arr, k, kSize, .FALSE., myThid )
237              loc_yGlobalLo = myYGlobalLo            ELSEIF ( arrType.EQ.'RL' ) THEN
238  #endif /* ALLOW_USE_MPI */              CALL MDS_PASS_R8toRL( sharedLocBuf_r8,
239              tN = W2_mpi_myTileList(npe,bi)       &                            arr, k, kSize, .FALSE., myThid )
240              IF   ( exch2_mydNx(tN) .GT. x_size ) THEN            ELSE
241  C-          face x-size larger than glob-size : fold it              WRITE(msgBuf,'(A)')
242                iGjLoc = 0       &         ' MDS_WRITE_FIELD: illegal value for arrType'
243                jGjLoc = exch2_mydNx(tN) / x_size              CALL PRINT_ERROR( msgBuf, myThid )
244              ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
 C-          tile y-size larger than glob-size : make a long line  
               iGjLoc = exch2_mydNx(tN)  
               jGjLoc = 0  
             ELSE  
 C-          default (face fit into global-IO-array)  
               iGjLoc = 0  
               jGjLoc = 1  
             ENDIF  
   
             IF (filePrec .EQ. precFloat32) THEN  
              DO J=1,sNy  
               DO I=1,sNx  
                iG = loc_xGlobalLo-1+(bi-1)*sNx+i  
                jG = loc_yGlobalLo-1+(bj-1)*sNy+j  
                iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1  
                jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)  
                xy_buffer_r4(iG_IO,jG_IO) = globalBuf(iG,jG)  
               ENDDO  
              ENDDO  
             ELSEIF (filePrec .EQ. precFloat64) THEN  
              DO J=1,sNy  
               DO I=1,sNx  
                iG = loc_xGlobalLo-1+(bi-1)*sNx+i  
                jG = loc_yGlobalLo-1+(bj-1)*sNy+j  
                iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1  
                jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)  
                xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)  
               ENDDO  
              ENDDO  
             ENDIF  
   
 C--    end of npe & bi loops  
            ENDDO  
           ENDDO  
 #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
           IF (filePrec .EQ. precFloat32) THEN  
            DO J=1,Ny  
             DO I=1,Nx  
              xy_buffer_r4(I,J) = globalBuf(I,J)  
             ENDDO  
            ENDDO  
           ELSEIF (filePrec .EQ. precFloat64) THEN  
            DO J=1,Ny  
             DO I=1,Nx  
              xy_buffer_r8(I,J) = globalBuf(I,J)  
             ENDDO  
            ENDDO  
245            ENDIF            ENDIF
246  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */            CALL GATHER_2D_R8(
247         U                       xy_buffer_r8,
248         O                       sharedLocBuf_r8,
249         I                       xSize, ySize,
250         I                       keepBlankTileIO, zeroBuff, myThid )
251            ELSE
252               WRITE(msgBuf,'(A)')
253         &       ' MDS_WRITE_FIELD: illegal value for filePrec'
254               CALL PRINT_ERROR( msgBuf, myThid )
255               STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
256            ENDIF
257    
258            IF ( iAmDoingIO ) THEN
259            irec=k+1-kLo+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
260            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
261  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
262             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
263  #endif  #endif
264             WRITE(dUnit,rec=irec) xy_buffer_r4             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
265            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
266  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
267             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
268  #endif  #endif
269             WRITE(dUnit,rec=irec) xy_buffer_r8             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
270            ELSE            ELSE
271             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
272       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
# Line 384  C If we are writing to a tiled MDS file Line 336  C If we are writing to a tiled MDS file
336             tGx = exch2_txGlobalo(tN)             tGx = exch2_txGlobalo(tN)
337             tNy = exch2_tNy(tN)             tNy = exch2_tNy(tN)
338             tNx = exch2_tNx(tN)             tNx = exch2_tNx(tN)
339             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
340  C-         face x-size larger than glob-size : fold it  C-         face x-size larger than glob-size : fold it
341               iGjLoc = 0               iGjLoc = 0
342               jGjLoc = exch2_mydNx(tN) / x_size               jGjLoc = exch2_mydNx(tN) / xSize
343             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
344  C-         tile y-size larger than glob-size : make a long line  C-         tile y-size larger than glob-size : make a long line
345               iGjLoc = exch2_mydNx(tN)               iGjLoc = exch2_mydNx(tN)
346               jGjLoc = 0               jGjLoc = 0
# Line 397  C-         default (face fit into global Line 349  C-         default (face fit into global
349               iGjLoc = 0               iGjLoc = 0
350               jGjLoc = 1               jGjLoc = 1
351             ENDIF             ENDIF
352               global_nTx = exch2_global_Nx/tNx
353  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
354             DO k=1,nNz             DO k=1,nNz
355              DO j=1,tNy              DO j=1,tNy
356               IF (globalFile) THEN               IF (globalFile) THEN
357  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
358                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
359       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx
360       &                 + ( k-kLo + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
361       &                   )*y_size*exch2_domain_nxt       &                   )*ySize*global_nTx
362  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
363                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
364                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
# Line 476  C Create meta-file for each tile if we a Line 429  C Create meta-file for each tile if we a
429       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
430  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
431             tN = W2_myTileList(bi)             tN = W2_myTileList(bi)
432             dimList(1,1)=x_size             dimList(1,1) = xSize
433             dimList(2,1)=exch2_txGlobalo(tN)             dimList(2,1) = exch2_txGlobalo(tN)
434             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1             dimList(3,1) = exch2_txGlobalo(tN)+sNx-1
435             dimList(1,2)=y_size             dimList(1,2) = ySize
436             dimList(2,2)=exch2_tyGlobalo(tN)             dimList(2,2) = exch2_tyGlobalo(tN)
437             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1             dimList(3,2) = exch2_tyGlobalo(tN)+sNy-1
438  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
439  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
440  C       to stay consistent with global file structure  C       to stay consistent with global file structure
441             dimList(1,1)=Nx             dimList(1,1) = Nx
442             dimList(2,1)=myXGlobalLo+(bi-1)*sNx             dimList(2,1) = myXGlobalLo+(bi-1)*sNx
443             dimList(3,1)=myXGlobalLo+bi*sNx-1             dimList(3,1) = myXGlobalLo+bi*sNx-1
444             dimList(1,2)=Ny             dimList(1,2) = Ny
445             dimList(2,2)=myYGlobalLo+(bj-1)*sNy             dimList(2,2) = myYGlobalLo+(bj-1)*sNy
446             dimList(3,2)=myYGlobalLo+bj*sNy-1             dimList(3,2) = myYGlobalLo+bj*sNy-1
447  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
448             dimList(1,3)=nNz             dimList(1,3) = nNz
449             dimList(2,3)=1             dimList(2,3) = 1
450             dimList(3,3)=nNz             dimList(3,3) = nNz
451             nDims=3             nDims = 3
452             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims = 2
453             map2gl(1) = iGjLoc             map2gl(1) = iGjLoc
454             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
455             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
# Line 524  C Create meta-file for the global-file ( Line 477  C Create meta-file for the global-file (
477        IF ( writeMetaF .AND. iAmDoingIO .AND.        IF ( writeMetaF .AND. iAmDoingIO .AND.
478       &    (globalFile .OR. useSingleCpuIO) ) THEN       &    (globalFile .OR. useSingleCpuIO) ) THEN
479           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
480           dimList(1,1)=x_size           dimList(1,1) = xSize
481           dimList(2,1)=1           dimList(2,1) = 1
482           dimList(3,1)=x_size           dimList(3,1) = xSize
483           dimList(1,2)=y_size           dimList(1,2) = ySize
484           dimList(2,2)=1           dimList(2,2) = 1
485           dimList(3,2)=y_size           dimList(3,2) = ySize
486           dimList(1,3)=nNz           dimList(1,3) = nNz
487           dimList(2,3)=1           dimList(2,3) = 1
488           dimList(3,3)=nNz           dimList(3,3) = nNz
489           nDims=3           nDims = 3
490           IF ( nNz.EQ.1 ) nDims=2           IF ( nNz.EQ.1 ) nDims = 2
491           map2gl(1) = 0           map2gl(1) = 0
492           map2gl(2) = 1           map2gl(2) = 1
493           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22