/[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.6 by jmc, Wed May 6 02:42:49 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_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
# Line 80  C !INPUT PARAMETERS: Line 82  C !INPUT PARAMETERS:
82        LOGICAL globalFile        LOGICAL globalFile
83        LOGICAL useCurrentDir        LOGICAL useCurrentDir
84        CHARACTER*(2) arrType        CHARACTER*(2) arrType
85        INTEGER zSize, nNz        INTEGER kSize, kLo, kHi
86  cph(  cph(
87  cph      Real arr(*)  cph      Real arr(*)
88        _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)
89  cph)  cph)
90        INTEGER jrecord        INTEGER jrecord
91        INTEGER myIter        INTEGER myIter
# Line 104  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,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,bi,bj,i,j,k,nNz
113        INTEGER dimList(3,3),nDims        INTEGER irec,dUnit,IL,pIL
114        INTEGER x_size,y_size,length_of_rec        INTEGER dimList(3,3), nDims, map2gl(2)
115  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)        INTEGER iGjLoc, jGjLoc
116        INTEGER iG_IO,jG_IO,npe        INTEGER length_of_rec
       PARAMETER ( x_size = exch2_domain_nxt * sNx )  
       PARAMETER ( y_size = exch2_domain_nyt * sNy )  
 #else  
       PARAMETER ( x_size = Nx )  
       PARAMETER ( y_size = Ny )  
 #endif  
117        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
118        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
       Real*4 xy_buffer_r4(x_size,y_size)  
       Real*8 xy_buffer_r8(x_size,y_size)  
       Real*8 globalBuf(Nx,Ny)  
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:
136          iGjLoc = 0
137          jGjLoc = 1
138    
139  C Assume nothing  C Assume nothing
140        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
141        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
142        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
143          nNz = 1 + kHi - kLo
144        irecord = ABS(jrecord)        irecord = ABS(jrecord)
145        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
146    
# Line 153  C Record number must be >= 1 Line 161  C Record number must be >= 1
161           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
162           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
163          ENDIF          ENDIF
164    C check for valid sub-set of levels:
165            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
166             WRITE(msgBuf,'(3(A,I6))')
167         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
168         &     ' , kLo=', kLo, ' , kHi=', kHi
169             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
170         &                       SQUEEZE_RIGHT , myThid)
171             WRITE(msgBuf,'(A)')
172         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
173             CALL PRINT_ERROR( msgBuf, myThid )
174             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
175            ENDIF
176    
177  C Assign special directory  C Assign special directory
178          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 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 186  C Master thread of process 0, only, open Line 206  C Master thread of process 0, only, open
206         ENDIF         ENDIF
207    
208  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
209         DO k=1,nNz         DO k=kLo,kHi
210  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
211          IF ( arrType.EQ.'RS' ) THEN          IF ( arrType.EQ.'RS' ) THEN
212            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
213          ELSEIF ( arrType.EQ.'RL' ) THEN          ELSEIF ( arrType.EQ.'RL' ) THEN
214            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
215          ELSE          ELSE
216            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
217       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 201  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            irec=k+nNz*(irecord-1)  C Map  global model (real*8) array to the appropriate global io-buffer
225              zeroBuff = k.EQ.kLo
226              CALL MDS_MAP_GLOBAL(
227         U                 xy_buffer_r4, xy_buffer_r8,
228         U                 globalBuf,
229         I                 xSize, ySize, filePrec,
230         I                 .FALSE., zeroBuff )
231    
232              irec=k+1-kLo+nNz*(irecord-1)
233            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) */  
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
 #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) */  
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'
246             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
247             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
248            ENDIF            ENDIF
249    C-      end if iAmDoingIO
250          ENDIF          ENDIF
251    C-     end of k loop
252         ENDDO         ENDDO
253    
254  C Close data-file  C Close data-file
# Line 334  C If we are writing to a tiled MDS file Line 300  C If we are writing to a tiled MDS file
300              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
301             ENDIF             ENDIF
302            ENDIF            ENDIF
303    
304            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
305             tNy = sNy             tNy = sNy
306  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
307             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
308             tGy = exch2_tyGlobalo(tn)             tGy = exch2_tyGlobalo(tN)
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. xSize ) THEN
313    C-         face x-size larger than glob-size : fold it
314                 iGjLoc = 0
315                 jGjLoc = exch2_mydNx(tN) / xSize
316               ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
317    C-         tile y-size larger than glob-size : make a long line
318                 iGjLoc = exch2_mydNx(tN)
319                 jGjLoc = 0
320               ELSE
321    C-         default (face fit into global-IO-array)
322                 iGjLoc = 0
323                 jGjLoc = 1
324               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)/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
332       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx
333       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
334       &                   )*tNy*exch2_domain_nyt*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
338                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)
339       &                + nSx*nPx*Ny*(k-1)       &                + nSx*nPx*Ny*(k-kLo)
340       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
341  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
342               ELSE               ELSE
343                iG = 0                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)
               jG = 0  
               irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)  
344               ENDIF               ENDIF
345               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
346                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
347                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
348                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
349                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
350                ELSE                ELSE
351                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
352       &           ' 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 359  C If we are writing to a tiled MDS file
359                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
360               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
361                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
362                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
363                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
364                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
365                ELSE                ELSE
366                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
367       &           ' MDS_WRITE_FIELD: illegal value for arrType'       &           ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 422  C Create meta-file for each tile if we a Line 401  C Create meta-file for each tile if we a
401             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,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
427               map2gl(2) = jGjLoc
428             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
429       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
430       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
431       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
432            ENDIF            ENDIF
433  C End of bi,bj loops  C End of bi,bj loops
# Line 469  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
465             map2gl(2) = 1
466           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
467       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
468       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
469       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
470  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
471  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
472  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
473        ENDIF        ENDIF
474    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22