/[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.6 by jmc, Wed May 6 02:42:49 2009 UTC revision 1.9 by jmc, Sat May 16 13:37:38 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"
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 106  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        LOGICAL zeroBuff
112        INTEGER xSize, ySize        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)
       INTEGER iGjLoc, jGjLoc  
117        INTEGER length_of_rec        INTEGER length_of_rec
118        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
119        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
120          INTEGER tNx, tNy, global_nTx
121          INTEGER tBx, tBy, iGjLoc, jGjLoc
122  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
123  c     INTEGER tGy,tGx,tNy,tNx,tN        INTEGER tN
       INTEGER tGy,tGx,    tNx,tN  
       INTEGER global_nTx  
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:  C Set dimensions:
128        xSize = Nx        xSize = Nx
129        ySize = Ny        ySize = Ny
130  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)        useExch2ioLayOut = .FALSE.
131        xSize = exch2_global_Nx  #ifdef ALLOW_EXCH2
132        ySize = exch2_global_Ny        IF ( W2_useE2ioLayOut ) THEN
133  #endif          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 207  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'
228              ENDIF
229              CALL GATHER_2D_R4(
230         O                       xy_buffer_r4,
231         I                       sharedLocBuf_r4,
232         I                       xSize, ySize,
233         I                       useExch2ioLayOut, zeroBuff, myThid )
234            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
235              IF ( arrType.EQ.'RS' ) THEN
236                CALL MDS_PASS_R8toRS( sharedLocBuf_r8,
237         &                            arr, k, kSize, .FALSE., myThid )
238              ELSEIF ( arrType.EQ.'RL' ) THEN
239                CALL MDS_PASS_R8toRL( sharedLocBuf_r8,
240         &                            arr, k, kSize, .FALSE., myThid )
241              ELSE
242                WRITE(msgBuf,'(A)')
243         &         ' MDS_WRITE_FIELD: illegal value for arrType'
244                CALL PRINT_ERROR( msgBuf, myThid )
245                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
246              ENDIF
247              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          ENDIF
         CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )  
258    
259          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
 C Map  global model (real*8) array to the appropriate global io-buffer  
           zeroBuff = k.EQ.kLo  
           CALL MDS_MAP_GLOBAL(  
      U                 xy_buffer_r4, xy_buffer_r8,  
      U                 globalBuf,  
      I                 xSize, ySize, filePrec,  
      I                 .FALSE., zeroBuff )  
   
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
# Line 284  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 302  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. xSize ) 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) / xSize  C-           face x-size larger than glob-size : fold it
348             ELSEIF ( exch2_tNy(tN) .GT. ySize ) 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
            global_nTx = exch2_global_Nx/tNx  
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 )*global_nTx       &             +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
      &                 + ( k-kLo + (irecord-1)*nNz  
      &                   )*ySize*global_nTx  
 #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 400  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'
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
            tN = W2_myTileList(bi)  
428             dimList(1,1) = xSize             dimList(1,1) = xSize
429             dimList(2,1) = exch2_txGlobalo(tN)             dimList(2,1) = tBx + 1
430             dimList(3,1) = exch2_txGlobalo(tN)+sNx-1             dimList(3,1) = tBx + tNx
431             dimList(1,2) = ySize             dimList(1,2) = ySize
432             dimList(2,2) = exch2_tyGlobalo(tN)             dimList(2,2) = tBy + 1
433             dimList(3,2) = exch2_tyGlobalo(tN)+sNy-1             dimList(3,2) = tBy + tNy
 #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
 C- jmc: if MISSING_TILE_IO, keep meta files unchanged  
 C       to stay consistent with global file structure  
            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) */  
434             dimList(1,3) = nNz             dimList(1,3) = nNz
435             dimList(2,3) = 1             dimList(2,3) = 1
436             dimList(3,3) = nNz             dimList(3,3) = nNz
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22