/[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.5 by jahn, Tue Dec 30 00:13:35 2008 UTC revision 1.6 by jmc, Wed May 6 02:42:49 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_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
# 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 zeroBuff
110          INTEGER xSize, ySize
111        INTEGER irecord        INTEGER irecord
112        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj,i,j,k,nNz
113        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
114        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
115        INTEGER iGjLoc, jGjLoc        INTEGER iGjLoc, jGjLoc
116        INTEGER 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  
 #endif  
117        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
118        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
119  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
120  c     INTEGER tGy,tGx,tNy,tNx,tN  c     INTEGER tGy,tGx,tNy,tNx,tN
121        INTEGER tGy,tGx,    tNx,tN        INTEGER tGy,tGx,    tNx,tN
122          INTEGER global_nTx
123  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
124        INTEGER tNy        INTEGER tNy
125    
126  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
127    C Set dimensions:
128          xSize = Nx
129          ySize = Ny
130    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
131          xSize = exch2_global_Nx
132          ySize = exch2_global_Ny
133    #endif
134    
135  C-    default:  C-    default:
136        iGjLoc = 0        iGjLoc = 0
# Line 189  C globalFile is too slow, then try using Line 195  C globalFile is too slow, then try using
195  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
196         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
197           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
198           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,myThid)           length_of_rec=MDS_RECLEN(filePrec,xSize*ySize,myThid)
199           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
200            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
201       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
# Line 215  C-      copy from arr(level=k) to 2-D "l Line 221  C-      copy from arr(level=k) to 2-D "l
221          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )
222    
223          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
224  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  C Map  global model (real*8) array to the appropriate global io-buffer
225            IF (filePrec .EQ. precFloat32) THEN            zeroBuff = k.EQ.kLo
226             DO J=1,y_size            CALL MDS_MAP_GLOBAL(
227              DO I=1,x_size       U                 xy_buffer_r4, xy_buffer_r8,
228               xy_buffer_r4(I,J) = 0.0       U                 globalBuf,
229              ENDDO       I                 xSize, ySize, filePrec,
230             ENDDO       I                 .FALSE., zeroBuff )
           ELSEIF (filePrec .EQ. precFloat64) THEN  
            DO J=1,y_size  
             DO I=1,x_size  
              xy_buffer_r8(I,J) = 0.0  
             ENDDO  
            ENDDO  
           ENDIF  
   
           bj=1  
           DO npe=1,nPx*nPy  
            DO bi=1,nSx  
 #ifdef ALLOW_USE_MPI  
             loc_xGlobalLo = mpi_myXGlobalLo(npe)  
             loc_yGlobalLo = mpi_myYGlobalLo(npe)  
 #else  /* ALLOW_USE_MPI */  
             loc_xGlobalLo = myXGlobalLo  
             loc_yGlobalLo = myYGlobalLo  
 #endif /* ALLOW_USE_MPI */  
             tN = W2_mpi_myTileList(npe,bi)  
             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN  
 C-          face x-size larger than glob-size : fold it  
               iGjLoc = 0  
               jGjLoc = exch2_mydNx(tN) / x_size  
             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN  
 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  
           ENDIF  
 #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
231    
232            irec=k+1-kLo+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
233            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
234  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
235             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
236  #endif  #endif
237             WRITE(dUnit,rec=irec) xy_buffer_r4             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
238            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
239  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
240             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
241  #endif  #endif
242             WRITE(dUnit,rec=irec) xy_buffer_r8             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
243            ELSE            ELSE
244             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
245       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
# Line 376  C If we are writing to a tiled MDS file Line 309  C If we are writing to a tiled MDS file
309             tGx = exch2_txGlobalo(tN)             tGx = exch2_txGlobalo(tN)
310             tNy = exch2_tNy(tN)             tNy = exch2_tNy(tN)
311             tNx = exch2_tNx(tN)             tNx = exch2_tNx(tN)
312             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
313  C-         face x-size larger than glob-size : fold it  C-         face x-size larger than glob-size : fold it
314               iGjLoc = 0               iGjLoc = 0
315               jGjLoc = exch2_mydNx(tN) / x_size               jGjLoc = exch2_mydNx(tN) / xSize
316             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
317  C-         tile y-size larger than glob-size : make a long line  C-         tile y-size larger than glob-size : make a long line
318               iGjLoc = exch2_mydNx(tN)               iGjLoc = exch2_mydNx(tN)
319               jGjLoc = 0               jGjLoc = 0
# Line 389  C-         default (face fit into global Line 322  C-         default (face fit into global
322               iGjLoc = 0               iGjLoc = 0
323               jGjLoc = 1               jGjLoc = 1
324             ENDIF             ENDIF
325               global_nTx = exch2_global_Nx/tNx
326  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
327             DO k=1,nNz             DO k=1,nNz
328              DO j=1,tNy              DO j=1,tNy
329               IF (globalFile) THEN               IF (globalFile) THEN
330  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
331                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
332       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx
333       &                 + ( k-kLo + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
334       &                   )*y_size*exch2_domain_nxt       &                   )*ySize*global_nTx
335  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
336                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
337                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
# Line 468  C Create meta-file for each tile if we a Line 402  C Create meta-file for each tile if we a
402       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
403  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
404             tN = W2_myTileList(bi)             tN = W2_myTileList(bi)
405             dimList(1,1)=x_size             dimList(1,1) = xSize
406             dimList(2,1)=exch2_txGlobalo(tN)             dimList(2,1) = exch2_txGlobalo(tN)
407             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1             dimList(3,1) = exch2_txGlobalo(tN)+sNx-1
408             dimList(1,2)=y_size             dimList(1,2) = ySize
409             dimList(2,2)=exch2_tyGlobalo(tN)             dimList(2,2) = exch2_tyGlobalo(tN)
410             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1             dimList(3,2) = exch2_tyGlobalo(tN)+sNy-1
411  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
412  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
413  C       to stay consistent with global file structure  C       to stay consistent with global file structure
414             dimList(1,1)=Nx             dimList(1,1) = Nx
415             dimList(2,1)=myXGlobalLo+(bi-1)*sNx             dimList(2,1) = myXGlobalLo+(bi-1)*sNx
416             dimList(3,1)=myXGlobalLo+bi*sNx-1             dimList(3,1) = myXGlobalLo+bi*sNx-1
417             dimList(1,2)=Ny             dimList(1,2) = Ny
418             dimList(2,2)=myYGlobalLo+(bj-1)*sNy             dimList(2,2) = myYGlobalLo+(bj-1)*sNy
419             dimList(3,2)=myYGlobalLo+bj*sNy-1             dimList(3,2) = myYGlobalLo+bj*sNy-1
420  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
421             dimList(1,3)=nNz             dimList(1,3) = nNz
422             dimList(2,3)=1             dimList(2,3) = 1
423             dimList(3,3)=nNz             dimList(3,3) = nNz
424             nDims=3             nDims = 3
425             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims = 2
426             map2gl(1) = iGjLoc             map2gl(1) = iGjLoc
427             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
428             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
# Line 516  C Create meta-file for the global-file ( Line 450  C Create meta-file for the global-file (
450        IF ( writeMetaF .AND. iAmDoingIO .AND.        IF ( writeMetaF .AND. iAmDoingIO .AND.
451       &    (globalFile .OR. useSingleCpuIO) ) THEN       &    (globalFile .OR. useSingleCpuIO) ) THEN
452           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
453           dimList(1,1)=x_size           dimList(1,1) = xSize
454           dimList(2,1)=1           dimList(2,1) = 1
455           dimList(3,1)=x_size           dimList(3,1) = xSize
456           dimList(1,2)=y_size           dimList(1,2) = ySize
457           dimList(2,2)=1           dimList(2,2) = 1
458           dimList(3,2)=y_size           dimList(3,2) = ySize
459           dimList(1,3)=nNz           dimList(1,3) = nNz
460           dimList(2,3)=1           dimList(2,3) = 1
461           dimList(3,3)=nNz           dimList(3,3) = nNz
462           nDims=3           nDims = 3
463           IF ( nNz.EQ.1 ) nDims=2           IF ( nNz.EQ.1 ) nDims = 2
464           map2gl(1) = 0           map2gl(1) = 0
465           map2gl(2) = 1           map2gl(2) = 1
466           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22