/[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.1 by jmc, Fri Dec 29 05:41:27 2006 UTC revision 1.9 by jmc, Sat May 16 13:37:38 2009 UTC
# Line 12  C !INTERFACE: Line 12  C !INTERFACE:
12       I   globalFile,       I   globalFile,
13       I   useCurrentDir,       I   useCurrentDir,
14       I   arrType,       I   arrType,
15       I   zSize,nNz,       I   kSize,kLo,kHi,
16       I   arr,       I   arr,
17       I   jrecord,       I   jrecord,
18       I   myIter,       I   myIter,
# Line 27  C globalFile (logical):: selects between Line 27  C globalFile (logical):: selects between
27  C useCurrentDir(logic):: always write to the current directory (even if  C useCurrentDir(logic):: always write to the current directory (even if
28  C                        "mdsioLocalDir" is set)  C                        "mdsioLocalDir" is set)
29  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"  C arrType   (char(2)) :: declaration of "arr": either "RS" or "RL"
30  C zSize     (integer) :: size of third dimension: normally either 1 or Nr  C kSize     (integer) :: size of third dimension: normally either 1 or Nr
31  C nNz       (integer) :: number of vertical levels to write  C kLo       (integer) :: 1rst vertical level (of array "arr") to write
32  C arr       ( RS/RL ) :: array to write, arr(:,:,zSize,:,:)  C kHi       (integer) :: last vertical level (of array "arr") to write
33    C arr       ( RS/RL ) :: array to write, arr(:,:,kSize,:,:)
34  C irecord   (integer) :: record number to write  C irecord   (integer) :: record number to write
35  C myIter    (integer) :: time step number  C myIter    (integer) :: time step number
36  C myThid    (integer) :: thread identifier  C myThid    (integer) :: thread identifier
37  C  C
38  C MDS_WRITE_FIELD creates either a file of the form "fName.data" and  C MDS_WRITE_FIELD creates either a file of the form "fName.data" and
39  C "fName.meta" if the logical flag "globalFile" is set true. Otherwise  C  "fName.meta" if the logical flag "globalFile" is set true. Otherwise
40  C it creates MDS tiled files of the form "fName.xxx.yyy.data" and  C  it creates MDS tiled files of the form "fName.xxx.yyy.data" and
41  C "fName.xxx.yyy.meta". If jrecord > 0, a meta-file is created.  C  "fName.xxx.yyy.meta". If jrecord > 0, a meta-file is created.
42  C Currently, the meta-files are not read because it is difficult  C Currently, the meta-files are not read because it is difficult
43  C to parse files in fortran. We should read meta information before  C  to parse files in fortran. We should read meta information before
44  C adding records to an existing multi-record file.  C  adding records to an existing multi-record file.
45  C The precision of the file is decsribed by filePrec, set either  C The precision of the file is decsribed by filePrec, set either
46  C to floatPrec32 or floatPrec64. The precision or declaration of  C  to floatPrec32 or floatPrec64. The precision or declaration of
47  C the array argument must be consistently described by the char*(2)  C  the array argument must be consistently described by the char*(2)
48  C string arrType, either "RS" or "RL". nNz allows for both 2-D and  C  string arrType, either "RS" or "RL".
49  C 3-D arrays to be handled. nNz=1 implies a 2-D model field and  C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with
50  C nNz=Nr implies a 3-D model field. irecord=|jrecord| is the record number  C  the option to only write a sub-set of consecutive vertical levels (from
51  C to be written and must be >= 1. NOTE: It is currently assumed that  C  kLo to kHi); (kSize,kLo,kHi)=(1,1,1) implies a 2-D model field and
52  C the highest record number in the file was the last record written.  C  (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.
53  C Nor is there a consistency check between the routine arguments and file.  C irecord=|jrecord| is the record number to be written and must be >= 1.
54  C ie. If your write record 2 after record 4 the meta information  C NOTE: It is currently assumed that the highest record number in the file
55  C will record the number of records to be 2. This, again, is because  C  was the last record written. Nor is there a consistency check between the
56  C we have read the meta information. To be fixed.  C  routine arguments and file, i.e., if you write record 2 after record 4
57    C  the meta information will record the number of records to be 2. This,
58    C  again, is because we have read the meta information. To be fixed.
59  C  C
60  C Created: 03/16/99 adcroft@mit.edu  C Created: 03/16/99 adcroft@mit.edu
61  C Changed: 01/06/02 menemenlis@jpl.nasa.gov  C Changed: 01/06/02 menemenlis@jpl.nasa.gov
# Line 66  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 80  C !INPUT PARAMETERS: Line 83  C !INPUT PARAMETERS:
83        LOGICAL globalFile        LOGICAL globalFile
84        LOGICAL useCurrentDir        LOGICAL useCurrentDir
85        CHARACTER*(2) arrType        CHARACTER*(2) arrType
86        INTEGER zSize, nNz        INTEGER kSize, kLo, kHi
87  cph(  cph(
88  cph      Real arr(*)  cph      Real arr(*)
89        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,zSize,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,kSize,nSx,nSy)
90  cph)  cph)
91        INTEGER jrecord        INTEGER jrecord
92        INTEGER myIter        INTEGER myIter
# Line 104  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,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,bi,bj,i,j,k,nNz
115        INTEGER dimList(3,3),nDims        INTEGER irec,dUnit,IL,pIL
116        INTEGER x_size,y_size,length_of_rec        INTEGER dimList(3,3), nDims, map2gl(2)
117  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)        INTEGER length_of_rec
       INTEGER iG_IO,jG_IO,npe  
       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:
140          iGjLoc = 0
141          jGjLoc = 1
142    
143  C Assume nothing  C Assume nothing
144        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
145        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
146        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
147          nNz = 1 + kHi - kLo
148        irecord = ABS(jrecord)        irecord = ABS(jrecord)
149        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
150    
# Line 153  C Record number must be >= 1 Line 165  C Record number must be >= 1
165           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
166           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
167          ENDIF          ENDIF
168    C check for valid sub-set of levels:
169            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
170             WRITE(msgBuf,'(3(A,I6))')
171         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
172         &     ' , kLo=', kLo, ' , kHi=', kHi
173             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
174         &                       SQUEEZE_RIGHT , myThid)
175             WRITE(msgBuf,'(A)')
176         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
177             CALL PRINT_ERROR( msgBuf, myThid )
178             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
179            ENDIF
180    
181  C Assign special directory  C Assign special directory
182          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
# Line 175  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 186  C Master thread of process 0, only, open Line 210  C Master thread of process 0, only, open
210         ENDIF         ENDIF
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=1,nNz         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,zSize,.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,zSize,.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'
226                CALL PRINT_ERROR( msgBuf, myThid )
227                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'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
244            CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
245            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              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
260            irec=k+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
261            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
            DO J=1,y_size  
             DO I=1,x_size  
              xy_buffer_r4(I,J) = 0.0  
             ENDDO  
            ENDDO  
            bj=1  
            DO npe=1,nPx*nPy  
             DO bi=1,nSx  
              DO J=1,sNy  
               DO I=1,sNx  
 #ifdef ALLOW_USE_MPI  
                iG=mpi_myXGlobalLo(npe)-1+(bi-1)*sNx+i  
                jG=mpi_myYGlobalLo(npe)-1+(bj-1)*sNy+j  
 #else  
                iG= myXGlobalLo-1+(bi-1)*sNx+i  
                jG= myYGlobalLo-1+(bj-1)*sNy+j  
 #endif /* ALLOW_USE_MPI */  
                iG_IO=exch2_txGlobalo(W2_mpi_myTileList(npe,bi))+i-1  
                jG_IO=exch2_tyGlobalo(W2_mpi_myTileList(npe,bi))+j-1  
                xy_buffer_r4(iG_IO,jG_IO) = globalBuf(iG,jG)  
               ENDDO  
              ENDDO  
             ENDDO  
            ENDDO  
 #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
            DO J=1,Ny  
             DO I=1,Nx  
              xy_buffer_r4(I,J) = globalBuf(I,J)  
             ENDDO  
            ENDDO  
 #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
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
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
            DO J=1,y_size  
             DO I=1,x_size  
              xy_buffer_r8(I,J) = 0.0  
             ENDDO  
            ENDDO  
            bj=1  
            DO npe=1,nPx*nPy  
             DO bi=1,nSx  
              DO J=1,sNy  
               DO I=1,sNx  
 #ifdef ALLOW_USE_MPI  
                iG=mpi_myXGlobalLo(npe)-1+(bi-1)*sNx+i  
                jG=mpi_myYGlobalLo(npe)-1+(bj-1)*sNy+j  
 #else  
                iG= myXGlobalLo-1+(bi-1)*sNx+i  
                jG= myYGlobalLo-1+(bj-1)*sNy+j  
 #endif /* ALLOW_USE_MPI */  
                iG_IO=exch2_txGlobalo(W2_mpi_myTileList(npe,bi))+i-1  
                jG_IO=exch2_tyGlobalo(W2_mpi_myTileList(npe,bi))+j-1  
                xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)  
               ENDDO  
              ENDDO  
             ENDDO  
            ENDDO  
 #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
            DO J=1,Ny  
             DO I=1,Nx  
              xy_buffer_r8(I,J) = globalBuf(I,J)  
             ENDDO  
            ENDDO  
 #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
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'
274             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
275             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
276            ENDIF            ENDIF
277    C-      end if iAmDoingIO
278          ENDIF          ENDIF
279    C-     end of k loop
280         ENDDO         ENDDO
281    
282  C Close data-file  C Close data-file
# Line 318  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 334  C If we are writing to a tiled MDS file Line 328  C If we are writing to a tiled MDS file
328              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
329             ENDIF             ENDIF
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                 tBx = exch2_txGlobalo(tN) - 1
345                 tBy = exch2_tyGlobalo(tN) - 1
346                 IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
347    C-           face x-size larger than glob-size : fold it
348                   iGjLoc = 0
349                   jGjLoc = exch2_mydNx(tN) / xSize
350                 ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
351    C-           tile y-size larger than glob-size : make a long line
352                   iGjLoc = exch2_mydNx(tN)
353                   jGjLoc = 0
354                 ELSE
355    C-           default (face fit into global-IO-array)
356                   iGjLoc = 0
357                   jGjLoc = 1
358                 ENDIF
359               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)/tNx       &                 + ( tBy + (j-1)*jGjLoc )*global_nTx
366       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &             +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
      &                 + ( k-1 + (irecord-1)*nNz  
      &                   )*tNy*exch2_domain_nyt*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-1)  
      &                + nSx*nPx*Ny*nNz*(irecord-1)  
 #endif /* ALLOW_EXCH2 */  
367               ELSE               ELSE
368                iG = 0                irec = j + ( k-kLo + (irecord-1)*nNz )*sNy
               jG = 0  
               irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)  
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
372                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
373                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
374                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
375                ELSE                ELSE
376                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
377       &           ' MDS_WRITE_FIELD: illegal value for arrType'       &           ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 380  C If we are writing to a tiled MDS file Line 384  C If we are writing to a tiled MDS file
384                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
385               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
386                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
387                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
388                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
389                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
390                ELSE                ELSE
391                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
392       &           ' MDS_WRITE_FIELD: illegal value for arrType'       &           ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 421  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
439             dimList(1,1)=Nx             map2gl(1) = iGjLoc
440             dimList(2,1)=myXGlobalLo+(bi-1)*sNx             map2gl(2) = jGjLoc
            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  
441             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
442       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
443       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
444       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
445            ENDIF            ENDIF
446  C End of bi,bj loops  C End of bi,bj loops
# Line 469  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
478             map2gl(2) = 1
479           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
480       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
481       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
482       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
483  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
484  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
485  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
486        ENDIF        ENDIF
487    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22