/[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.5 by jahn, Tue Dec 30 00:13:35 2008 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 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 105  C !LOCAL VARIABLES: Line 108  C !LOCAL VARIABLES:
108        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
109        LOGICAL writeMetaF        LOGICAL writeMetaF
110        INTEGER irecord        INTEGER irecord
111        INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,bi,bj,i,j,k,nNz
112        INTEGER dimList(3,3),nDims        INTEGER irec,dUnit,IL,pIL
113        INTEGER x_size,y_size,length_of_rec        INTEGER dimList(3,3), nDims, map2gl(2)
114          INTEGER iGjLoc, jGjLoc
115          INTEGER length_of_rec
116  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
117        INTEGER iG_IO,jG_IO,npe        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 )  
118  #endif  #endif
119        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
120        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)  
121  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
122  c     INTEGER tGy,tGx,tNy,tNx,tn  c     INTEGER tGy,tGx,tNy,tNx,tN
123        INTEGER tGy,tGx,    tNx,tn        INTEGER tGy,tGx,    tNx,tN
124  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
125        INTEGER tNy        INTEGER tNy
126    
127  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128    
129    C-    default:
130          iGjLoc = 0
131          jGjLoc = 1
132    
133  C Assume nothing  C Assume nothing
134        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
135        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
136        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
137          nNz = 1 + kHi - kLo
138        irecord = ABS(jrecord)        irecord = ABS(jrecord)
139        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
140    
# Line 153  C Record number must be >= 1 Line 155  C Record number must be >= 1
155           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
156           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
157          ENDIF          ENDIF
158    C check for valid sub-set of levels:
159            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
160             WRITE(msgBuf,'(3(A,I6))')
161         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
162         &     ' , kLo=', kLo, ' , kHi=', kHi
163             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
164         &                       SQUEEZE_RIGHT , myThid)
165             WRITE(msgBuf,'(A)')
166         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
167             CALL PRINT_ERROR( msgBuf, myThid )
168             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
169            ENDIF
170    
171  C Assign special directory  C Assign special directory
172          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
# Line 186  C Master thread of process 0, only, open Line 200  C Master thread of process 0, only, open
200         ENDIF         ENDIF
201    
202  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
203         DO k=1,nNz         DO k=kLo,kHi
204  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
205          IF ( arrType.EQ.'RS' ) THEN          IF ( arrType.EQ.'RS' ) THEN
206            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
207          ELSEIF ( arrType.EQ.'RL' ) THEN          ELSEIF ( arrType.EQ.'RL' ) THEN
208            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
209          ELSE          ELSE
210            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
211       &         ' 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 215  C-      copy from arr(level=k) to 2-D "l
215          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )
216    
217          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
           irec=k+nNz*(irecord-1)  
           IF (filePrec .EQ. precFloat32) THEN  
218  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
219              IF (filePrec .EQ. precFloat32) THEN
220             DO J=1,y_size             DO J=1,y_size
221              DO I=1,x_size              DO I=1,x_size
222               xy_buffer_r4(I,J) = 0.0               xy_buffer_r4(I,J) = 0.0
223              ENDDO              ENDDO
224             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) */  
 #ifdef _BYTESWAPIO  
            CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )  
 #endif  
            WRITE(dUnit,rec=irec) xy_buffer_r4  
225            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
226             DO J=1,y_size             DO J=1,y_size
227              DO I=1,x_size              DO I=1,x_size
228               xy_buffer_r8(I,J) = 0.0               xy_buffer_r8(I,J) = 0.0
229              ENDDO              ENDDO
230             ENDDO             ENDDO
231             bj=1            ENDIF
232             DO npe=1,nPx*nPy  
233              DO bi=1,nSx            bj=1
234               DO J=1,sNy            DO npe=1,nPx*nPy
235                DO I=1,sNx             DO bi=1,nSx
236  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
237                 iG=mpi_myXGlobalLo(npe)-1+(bi-1)*sNx+i              loc_xGlobalLo = mpi_myXGlobalLo(npe)
238                 jG=mpi_myYGlobalLo(npe)-1+(bj-1)*sNy+j              loc_yGlobalLo = mpi_myYGlobalLo(npe)
239  #else  #else  /* ALLOW_USE_MPI */
240                 iG= myXGlobalLo-1+(bi-1)*sNx+i              loc_xGlobalLo = myXGlobalLo
241                 jG= myYGlobalLo-1+(bj-1)*sNy+j              loc_yGlobalLo = myYGlobalLo
242  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
243                 iG_IO=exch2_txGlobalo(W2_mpi_myTileList(npe,bi))+i-1              tN = W2_mpi_myTileList(npe,bi)
244                 jG_IO=exch2_tyGlobalo(W2_mpi_myTileList(npe,bi))+j-1              IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
245    C-          face x-size larger than glob-size : fold it
246                  iGjLoc = 0
247                  jGjLoc = exch2_mydNx(tN) / x_size
248                ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
249    C-          tile y-size larger than glob-size : make a long line
250                  iGjLoc = exch2_mydNx(tN)
251                  jGjLoc = 0
252                ELSE
253    C-          default (face fit into global-IO-array)
254                  iGjLoc = 0
255                  jGjLoc = 1
256                ENDIF
257    
258                IF (filePrec .EQ. precFloat32) THEN
259                 DO J=1,sNy
260                  DO I=1,sNx
261                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
262                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
263                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
264                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
265                   xy_buffer_r4(iG_IO,jG_IO) = globalBuf(iG,jG)
266                  ENDDO
267                 ENDDO
268                ELSEIF (filePrec .EQ. precFloat64) THEN
269                 DO J=1,sNy
270                  DO I=1,sNx
271                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
272                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
273                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
274                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
275                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)
276                ENDDO                ENDDO
277               ENDDO               ENDDO
278              ENDDO              ENDIF
279    
280    C--    end of npe & bi loops
281             ENDDO             ENDDO
282              ENDDO
283  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
284              IF (filePrec .EQ. precFloat32) THEN
285               DO J=1,Ny
286                DO I=1,Nx
287                 xy_buffer_r4(I,J) = globalBuf(I,J)
288                ENDDO
289               ENDDO
290              ELSEIF (filePrec .EQ. precFloat64) THEN
291             DO J=1,Ny             DO J=1,Ny
292              DO I=1,Nx              DO I=1,Nx
293               xy_buffer_r8(I,J) = globalBuf(I,J)               xy_buffer_r8(I,J) = globalBuf(I,J)
294              ENDDO              ENDDO
295             ENDDO             ENDDO
296              ENDIF
297  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
298    
299              irec=k+1-kLo+nNz*(irecord-1)
300              IF (filePrec .EQ. precFloat32) THEN
301    #ifdef _BYTESWAPIO
302               CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
303    #endif
304               WRITE(dUnit,rec=irec) xy_buffer_r4
305              ELSEIF (filePrec .EQ. precFloat64) THEN
306  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
307             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
308  #endif  #endif
# Line 282  C-      copy from arr(level=k) to 2-D "l Line 313  C-      copy from arr(level=k) to 2-D "l
313             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
314             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
315            ENDIF            ENDIF
316    C-      end if iAmDoingIO
317          ENDIF          ENDIF
318    C-     end of k loop
319         ENDDO         ENDDO
320    
321  C Close data-file  C Close data-file
# Line 334  C If we are writing to a tiled MDS file Line 367  C If we are writing to a tiled MDS file
367              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
368             ENDIF             ENDIF
369            ENDIF            ENDIF
370    
371            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
372             tNy = sNy             tNy = sNy
373  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
374             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
375             tGy = exch2_tyGlobalo(tn)             tGy = exch2_tyGlobalo(tN)
376             tGx = exch2_txGlobalo(tn)             tGx = exch2_txGlobalo(tN)
377             tNy = exch2_tNy(tn)             tNy = exch2_tNy(tN)
378             tNx = exch2_tNx(tn)             tNx = exch2_tNx(tN)
379               IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
380    C-         face x-size larger than glob-size : fold it
381                 iGjLoc = 0
382                 jGjLoc = exch2_mydNx(tN) / x_size
383               ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
384    C-         tile y-size larger than glob-size : make a long line
385                 iGjLoc = exch2_mydNx(tN)
386                 jGjLoc = 0
387               ELSE
388    C-         default (face fit into global-IO-array)
389                 iGjLoc = 0
390                 jGjLoc = 1
391               ENDIF
392  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
393             DO k=1,nNz             DO k=1,nNz
394              DO j=1,tNy              DO j=1,tNy
395               IF (globalFile) THEN               IF (globalFile) THEN
396  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
397                irec = 1 + (tGx-1)/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
398       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt
399       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
400       &                   )*tNy*exch2_domain_nyt*exch2_domain_nxt       &                   )*y_size*exch2_domain_nxt
401  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
402                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
403                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
404                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)
405       &                + nSx*nPx*Ny*(k-1)       &                + nSx*nPx*Ny*(k-kLo)
406       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
407  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
408               ELSE               ELSE
409                iG = 0                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)
               jG = 0  
               irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)  
410               ENDIF               ENDIF
411               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
412                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
413                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
414                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
415                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
416                ELSE                ELSE
417                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
418       &           ' 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 425  C If we are writing to a tiled MDS file
425                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
426               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
427                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
428                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
429                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
430                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
431                ELSE                ELSE
432                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
433       &           ' 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 467  C Create meta-file for each tile if we a
467             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
468       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
469  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
470             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
471             dimList(1,1)=x_size             dimList(1,1)=x_size
472             dimList(2,1)=exch2_txGlobalo(tn)             dimList(2,1)=exch2_txGlobalo(tN)
473             dimList(3,1)=exch2_txGlobalo(tn)+sNx-1             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1
474             dimList(1,2)=y_size             dimList(1,2)=y_size
475             dimList(2,2)=exch2_tyGlobalo(tn)             dimList(2,2)=exch2_tyGlobalo(tN)
476             dimList(3,2)=exch2_tyGlobalo(tn)+sNy-1             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1
477  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
478  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
479  C       to stay consistent with global file structure  C       to stay consistent with global file structure
# Line 444  C       to stay consistent with global f Line 489  C       to stay consistent with global f
489             dimList(3,3)=nNz             dimList(3,3)=nNz
490             nDims=3             nDims=3
491             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims=2
492               map2gl(1) = iGjLoc
493               map2gl(2) = jGjLoc
494             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
495       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
496       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
497       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
498            ENDIF            ENDIF
499  C End of bi,bj loops  C End of bi,bj loops
# Line 478  C Create meta-file for the global-file ( Line 525  C Create meta-file for the global-file (
525           dimList(1,3)=nNz           dimList(1,3)=nNz
526           dimList(2,3)=1           dimList(2,3)=1
527           dimList(3,3)=nNz           dimList(3,3)=nNz
528           ndims=3           nDims=3
529           IF ( nNz.EQ.1 ) ndims=2           IF ( nNz.EQ.1 ) nDims=2
530             map2gl(1) = 0
531             map2gl(2) = 1
532           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
533       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
534       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
535       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
536  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
537  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
538  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
539        ENDIF        ENDIF
540    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22