/[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.9 by jmc, Sat May 16 13:37:38 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"
76  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
77  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
78  #include "MDSIO_SCPU.h"  #include "EEBUFF_SCPU.h"
79    
80  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
81        CHARACTER*(*) fName        CHARACTER*(*) fName
# Line 107  C !LOCAL VARIABLES: Line 107  C !LOCAL VARIABLES:
107        LOGICAL fileIsOpen        LOGICAL fileIsOpen
108        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
109        LOGICAL writeMetaF        LOGICAL writeMetaF
110          LOGICAL useExch2ioLayOut
111          LOGICAL zeroBuff
112          INTEGER xSize, ySize
113        INTEGER irecord        INTEGER irecord
114        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj,i,j,k,nNz
115        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
116        INTEGER dimList(3,3), nDims, map2gl(2)        INTEGER dimList(3,3), nDims, map2gl(2)
117        INTEGER iGjLoc, jGjLoc        INTEGER length_of_rec
       INTEGER x_size,y_size,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)
120        Real*4 xy_buffer_r4(x_size,y_size)        INTEGER tNx, tNy, global_nTx
121        Real*8 xy_buffer_r8(x_size,y_size)        INTEGER tBx, tBy, iGjLoc, jGjLoc
       Real*8 globalBuf(Nx,Ny)  
122  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
123  c     INTEGER tGy,tGx,tNy,tNx,tN        INTEGER tN
       INTEGER tGy,tGx,    tNx,tN  
124  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
       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          useExch2ioLayOut = .FALSE.
131    #ifdef ALLOW_EXCH2
132          IF ( W2_useE2ioLayOut ) THEN
133            xSize = exch2_global_Nx
134            ySize = exch2_global_Ny
135            useExch2ioLayOut = .TRUE.
136          ENDIF
137    #endif /* ALLOW_EXCH2 */
138    
139  C-    default:  C-    default:
140        iGjLoc = 0        iGjLoc = 0
# Line 197  C globalFile is too slow, then try using Line 199  C globalFile is too slow, then try using
199  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
200         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
201           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
202           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,myThid)           length_of_rec=MDS_RECLEN(filePrec,xSize*ySize,myThid)
203           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
204            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
205       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
# Line 209  C Master thread of process 0, only, open Line 211  C Master thread of process 0, only, open
211    
212  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
213         DO k=kLo,kHi         DO k=kLo,kHi
214            zeroBuff = k.EQ.kLo
215  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
216          IF ( arrType.EQ.'RS' ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
217            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)            IF ( arrType.EQ.'RS' ) THEN
218          ELSEIF ( arrType.EQ.'RL' ) THEN              CALL MDS_PASS_R4toRS( sharedLocBuf_r4,
219            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)       &                            arr, k, kSize, .FALSE., myThid )
220          ELSE            ELSEIF ( arrType.EQ.'RL' ) THEN
221            WRITE(msgBuf,'(A)')              CALL MDS_PASS_R4toRL( sharedLocBuf_r4,
222         &                            arr, k, kSize, .FALSE., myThid )
223              ELSE
224                WRITE(msgBuf,'(A)')
225       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
226            CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
227            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  
228            ENDIF            ENDIF
229              CALL GATHER_2D_R4(
230            bj=1       O                       xy_buffer_r4,
231            DO npe=1,nPx*nPy       I                       sharedLocBuf_r4,
232             DO bi=1,nSx       I                       xSize, ySize,
233  #ifdef ALLOW_USE_MPI       I                       useExch2ioLayOut, zeroBuff, myThid )
234              loc_xGlobalLo = mpi_myXGlobalLo(npe)          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
235              loc_yGlobalLo = mpi_myYGlobalLo(npe)            IF ( arrType.EQ.'RS' ) THEN
236  #else  /* ALLOW_USE_MPI */              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,
237              loc_xGlobalLo = myXGlobalLo       &                            arr, k, kSize, .FALSE., myThid )
238              loc_yGlobalLo = myYGlobalLo            ELSEIF ( arrType.EQ.'RL' ) THEN
239  #endif /* ALLOW_USE_MPI */              CALL MDS_PASS_R8toRL( sharedLocBuf_r8,
240              tN = W2_mpi_myTileList(npe,bi)       &                            arr, k, kSize, .FALSE., myThid )
241              IF   ( exch2_mydNx(tN) .GT. x_size ) THEN            ELSE
242  C-          face x-size larger than glob-size : fold it              WRITE(msgBuf,'(A)')
243                iGjLoc = 0       &         ' MDS_WRITE_FIELD: illegal value for arrType'
244                jGjLoc = exch2_mydNx(tN) / x_size              CALL PRINT_ERROR( msgBuf, myThid )
245              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  
246            ENDIF            ENDIF
247  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */            CALL GATHER_2D_R8(
248         O                       xy_buffer_r8,
249         I                       sharedLocBuf_r8,
250         I                       xSize, ySize,
251         I                       useExch2ioLayOut, zeroBuff, myThid )
252            ELSE
253               WRITE(msgBuf,'(A)')
254         &       ' MDS_WRITE_FIELD: illegal value for filePrec'
255               CALL PRINT_ERROR( msgBuf, myThid )
256               STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
257            ENDIF
258    
259            IF ( iAmDoingIO ) THEN
260            irec=k+1-kLo+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
261            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
262  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
263             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
264  #endif  #endif
265             WRITE(dUnit,rec=irec) xy_buffer_r4             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
266            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
267  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
268             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
269  #endif  #endif
270             WRITE(dUnit,rec=irec) xy_buffer_r8             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
271            ELSE            ELSE
272             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
273       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
# Line 359  C Loop over all tiles Line 312  C Loop over all tiles
312           DO bi=1,nSx           DO bi=1,nSx
313  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
314            IF (.NOT. globalFile) THEN            IF (.NOT. globalFile) THEN
315             iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles             iG=bi+(myXGlobalLo-1)/sNx
316             jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles             jG=bj+(myYGlobalLo-1)/sNy
317             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
318       &              pfName(1:pIL),'.',iG,'.',jG,'.data'       &              pfName(1:pIL),'.',iG,'.',jG,'.data'
319             IF (irecord .EQ. 1) THEN             IF (irecord .EQ. 1) THEN
# Line 377  C If we are writing to a tiled MDS file Line 330  C If we are writing to a tiled MDS file
330            ENDIF            ENDIF
331    
332            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
333               tNx = sNx
334             tNy = sNy             tNy = sNy
335               global_nTx = xSize/sNx
336               tBx = myXGlobalLo-1 + (bi-1)*sNx
337               tBy = myYGlobalLo-1 + (bj-1)*sNy
338  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
339             tN = W2_myTileList(bi)             IF ( useExch2ioLayOut ) THEN
340             tGy = exch2_tyGlobalo(tN)               tN = W2_myTileList(bi)
341             tGx = exch2_txGlobalo(tN)  c            tNx = exch2_tNx(tN)
342             tNy = exch2_tNy(tN)  c            tNy = exch2_tNy(tN)
343             tNx = exch2_tNx(tN)  c            global_nTx = exch2_global_Nx/tNx
344             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN               tBx = exch2_txGlobalo(tN) - 1
345  C-         face x-size larger than glob-size : fold it               tBy = exch2_tyGlobalo(tN) - 1
346               iGjLoc = 0               IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
347               jGjLoc = exch2_mydNx(tN) / x_size  C-           face x-size larger than glob-size : fold it
348             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN                 iGjLoc = 0
349  C-         tile y-size larger than glob-size : make a long line                 jGjLoc = exch2_mydNx(tN) / xSize
350               iGjLoc = exch2_mydNx(tN)               ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
351               jGjLoc = 0  C-           tile y-size larger than glob-size : make a long line
352             ELSE                 iGjLoc = exch2_mydNx(tN)
353  C-         default (face fit into global-IO-array)                 jGjLoc = 0
354               iGjLoc = 0               ELSE
355               jGjLoc = 1  C-           default (face fit into global-IO-array)
356                   iGjLoc = 0
357                   jGjLoc = 1
358                 ENDIF
359             ENDIF             ENDIF
360  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
361             DO k=1,nNz             DO k=1,nNz
362              DO j=1,tNy              DO j=1,tNy
363               IF (globalFile) THEN               IF (globalFile) THEN
364  #ifdef ALLOW_EXCH2                irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
365                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx       &                 + ( tBy + (j-1)*jGjLoc )*global_nTx
366       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt       &             +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
      &                 + ( k-kLo + (irecord-1)*nNz  
      &                   )*y_size*exch2_domain_nxt  
 #else /* ALLOW_EXCH2 */  
               iG = myXGlobalLo-1 + (bi-1)*sNx  
               jG = myYGlobalLo-1 + (bj-1)*sNy  
               irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)  
      &                + nSx*nPx*Ny*(k-kLo)  
      &                + nSx*nPx*Ny*nNz*(irecord-1)  
 #endif /* ALLOW_EXCH2 */  
367               ELSE               ELSE
368                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)                irec = j + ( k-kLo + (irecord-1)*nNz )*sNy
369               ENDIF               ENDIF
370               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
371                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
# Line 474  C Create meta-file for each tile if we a Line 425  C Create meta-file for each tile if we a
425             jG=bj+(myYGlobalLo-1)/sNy             jG=bj+(myYGlobalLo-1)/sNy
426             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
427       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
428  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)             dimList(1,1) = xSize
429             tN = W2_myTileList(bi)             dimList(2,1) = tBx + 1
430             dimList(1,1)=x_size             dimList(3,1) = tBx + tNx
431             dimList(2,1)=exch2_txGlobalo(tN)             dimList(1,2) = ySize
432             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1             dimList(2,2) = tBy + 1
433             dimList(1,2)=y_size             dimList(3,2) = tBy + tNy
434             dimList(2,2)=exch2_tyGlobalo(tN)             dimList(1,3) = nNz
435             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1             dimList(2,3) = 1
436  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */             dimList(3,3) = nNz
437  C- jmc: if MISSING_TILE_IO, keep meta files unchanged             nDims = 3
438  C       to stay consistent with global file structure             IF ( nNz.EQ.1 ) nDims = 2
            dimList(1,1)=Nx  
            dimList(2,1)=myXGlobalLo+(bi-1)*sNx  
            dimList(3,1)=myXGlobalLo+bi*sNx-1  
            dimList(1,2)=Ny  
            dimList(2,2)=myYGlobalLo+(bj-1)*sNy  
            dimList(3,2)=myYGlobalLo+bj*sNy-1  
 #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
            dimList(1,3)=nNz  
            dimList(2,3)=1  
            dimList(3,3)=nNz  
            nDims=3  
            IF ( nNz.EQ.1 ) nDims=2  
439             map2gl(1) = iGjLoc             map2gl(1) = iGjLoc
440             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
441             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
# Line 524  C Create meta-file for the global-file ( Line 463  C Create meta-file for the global-file (
463        IF ( writeMetaF .AND. iAmDoingIO .AND.        IF ( writeMetaF .AND. iAmDoingIO .AND.
464       &    (globalFile .OR. useSingleCpuIO) ) THEN       &    (globalFile .OR. useSingleCpuIO) ) THEN
465           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
466           dimList(1,1)=x_size           dimList(1,1) = xSize
467           dimList(2,1)=1           dimList(2,1) = 1
468           dimList(3,1)=x_size           dimList(3,1) = xSize
469           dimList(1,2)=y_size           dimList(1,2) = ySize
470           dimList(2,2)=1           dimList(2,2) = 1
471           dimList(3,2)=y_size           dimList(3,2) = ySize
472           dimList(1,3)=nNz           dimList(1,3) = nNz
473           dimList(2,3)=1           dimList(2,3) = 1
474           dimList(3,3)=nNz           dimList(3,3) = nNz
475           nDims=3           nDims = 3
476           IF ( nNz.EQ.1 ) nDims=2           IF ( nNz.EQ.1 ) nDims = 2
477           map2gl(1) = 0           map2gl(1) = 0
478           map2gl(2) = 1           map2gl(2) = 1
479           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22