/[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.8 by jmc, Tue May 12 19:56:36 2009 UTC revision 1.9 by jmc, Sat May 16 13:37:38 2009 UTC
# Line 73  C Global variables / common blocks Line 73  C Global variables / common blocks
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"
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 keepBlankTileIO        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        keepBlankTileIO = .FALSE.        useExch2ioLayOut = .FALSE.
131  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #ifdef ALLOW_EXCH2
132        xSize = exch2_global_Nx        IF ( W2_useE2ioLayOut ) THEN
133        ySize = exch2_global_Ny          xSize = exch2_global_Nx
134        keepBlankTileIO = .TRUE.          ySize = exch2_global_Ny
135  #endif          useExch2ioLayOut = .TRUE.
136          ENDIF
137    #endif /* ALLOW_EXCH2 */
138    
139  C-    default:  C-    default:
140        iGjLoc = 0        iGjLoc = 0
# Line 226  C-      copy from arr(level=k) to 2-D "l Line 227  C-      copy from arr(level=k) to 2-D "l
227              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
228            ENDIF            ENDIF
229            CALL GATHER_2D_R4(            CALL GATHER_2D_R4(
230       U                       xy_buffer_r4,       O                       xy_buffer_r4,
231       O                       sharedLocBuf_r4,       I                       sharedLocBuf_r4,
232       I                       xSize, ySize,       I                       xSize, ySize,
233       I                       keepBlankTileIO, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
234          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
235            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
236              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,
# Line 244  C-      copy from arr(level=k) to 2-D "l Line 245  C-      copy from arr(level=k) to 2-D "l
245              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
246            ENDIF            ENDIF
247            CALL GATHER_2D_R8(            CALL GATHER_2D_R8(
248       U                       xy_buffer_r8,       O                       xy_buffer_r8,
249       O                       sharedLocBuf_r8,       I                       sharedLocBuf_r8,
250       I                       xSize, ySize,       I                       xSize, ySize,
251       I                       keepBlankTileIO, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
252          ELSE          ELSE
253             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
254       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
# Line 311  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 329  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 427  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.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22