/[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.4 by jmc, Tue Nov 13 19:37:44 2007 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 dimList(3,3), nDims, map2gl(2)
114          INTEGER iGjLoc, jGjLoc
115        INTEGER x_size,y_size,length_of_rec        INTEGER x_size,y_size,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
118        PARAMETER ( x_size = exch2_domain_nxt * sNx )        PARAMETER ( x_size = exch2_domain_nxt * sNx )
119        PARAMETER ( y_size = exch2_domain_nyt * sNy )        PARAMETER ( y_size = exch2_domain_nyt * sNy )
120  #else  #else
# Line 122  C !LOCAL VARIABLES: Line 127  C !LOCAL VARIABLES:
127        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
128        Real*8 globalBuf(Nx,Ny)        Real*8 globalBuf(Nx,Ny)
129  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
130  c     INTEGER tGy,tGx,tNy,tNx,tn  c     INTEGER tGy,tGx,tNy,tNx,tN
131        INTEGER tGy,tGx,    tNx,tn        INTEGER tGy,tGx,    tNx,tN
132  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
133        INTEGER tNy        INTEGER tNy
134    
135  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
136    
137    C-    default:
138          iGjLoc = 0
139          jGjLoc = 1
140    
141  C Assume nothing  C Assume nothing
142        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
143        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
144        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
145          nNz = 1 + kHi - kLo
146        irecord = ABS(jrecord)        irecord = ABS(jrecord)
147        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
148    
# Line 153  C Record number must be >= 1 Line 163  C Record number must be >= 1
163           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
164           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
165          ENDIF          ENDIF
166    C check for valid sub-set of levels:
167            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
168             WRITE(msgBuf,'(3(A,I6))')
169         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
170         &     ' , kLo=', kLo, ' , kHi=', kHi
171             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
172         &                       SQUEEZE_RIGHT , myThid)
173             WRITE(msgBuf,'(A)')
174         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
175             CALL PRINT_ERROR( msgBuf, myThid )
176             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
177            ENDIF
178    
179  C Assign special directory  C Assign special directory
180          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 208  C Master thread of process 0, only, open
208         ENDIF         ENDIF
209    
210  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
211         DO k=1,nNz         DO k=kLo,kHi
212  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
213          IF ( arrType.EQ.'RS' ) THEN          IF ( arrType.EQ.'RS' ) THEN
214            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
215          ELSEIF ( arrType.EQ.'RL' ) THEN          ELSEIF ( arrType.EQ.'RL' ) THEN
216            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,kSize,.FALSE.,myThid)
217          ELSE          ELSE
218            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
219       &         ' 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 223  C-      copy from arr(level=k) to 2-D "l
223          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )
224    
225          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
           irec=k+nNz*(irecord-1)  
           IF (filePrec .EQ. precFloat32) THEN  
226  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
227              IF (filePrec .EQ. precFloat32) THEN
228             DO J=1,y_size             DO J=1,y_size
229              DO I=1,x_size              DO I=1,x_size
230               xy_buffer_r4(I,J) = 0.0               xy_buffer_r4(I,J) = 0.0
231              ENDDO              ENDDO
232             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  
233            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
234             DO J=1,y_size             DO J=1,y_size
235              DO I=1,x_size              DO I=1,x_size
236               xy_buffer_r8(I,J) = 0.0               xy_buffer_r8(I,J) = 0.0
237              ENDDO              ENDDO
238             ENDDO             ENDDO
239             bj=1            ENDIF
240             DO npe=1,nPx*nPy  
241              DO bi=1,nSx            bj=1
242               DO J=1,sNy            DO npe=1,nPx*nPy
243                DO I=1,sNx             DO bi=1,nSx
244  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
245                 iG=mpi_myXGlobalLo(npe)-1+(bi-1)*sNx+i              loc_xGlobalLo = mpi_myXGlobalLo(npe)
246                 jG=mpi_myYGlobalLo(npe)-1+(bj-1)*sNy+j              loc_yGlobalLo = mpi_myYGlobalLo(npe)
247  #else  #else  /* ALLOW_USE_MPI */
248                 iG= myXGlobalLo-1+(bi-1)*sNx+i              loc_xGlobalLo = myXGlobalLo
249                 jG= myYGlobalLo-1+(bj-1)*sNy+j              loc_yGlobalLo = myYGlobalLo
250  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
251                 iG_IO=exch2_txGlobalo(W2_mpi_myTileList(npe,bi))+i-1              tN = W2_mpi_myTileList(npe,bi)
252                 jG_IO=exch2_tyGlobalo(W2_mpi_myTileList(npe,bi))+j-1              IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
253    C-          face x-size larger than glob-size : fold it
254                  iGjLoc = 0
255                  jGjLoc = exch2_mydNx(tN) / x_size
256                ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
257    C-          tile y-size larger than glob-size : make a long line
258                  iGjLoc = exch2_mydNx(tN)
259                  jGjLoc = 0
260                ELSE
261    C-          default (face fit into global-IO-array)
262                  iGjLoc = 0
263                  jGjLoc = 1
264                ENDIF
265    
266                IF (filePrec .EQ. precFloat32) THEN
267                 DO J=1,sNy
268                  DO I=1,sNx
269                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
270                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
271                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
272                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
273                   xy_buffer_r4(iG_IO,jG_IO) = globalBuf(iG,jG)
274                  ENDDO
275                 ENDDO
276                ELSEIF (filePrec .EQ. precFloat64) THEN
277                 DO J=1,sNy
278                  DO I=1,sNx
279                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
280                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
281                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
282                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
283                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)
284                ENDDO                ENDDO
285               ENDDO               ENDDO
286              ENDDO              ENDIF
287    
288    C--    end of npe & bi loops
289             ENDDO             ENDDO
290              ENDDO
291  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
292              IF (filePrec .EQ. precFloat32) THEN
293               DO J=1,Ny
294                DO I=1,Nx
295                 xy_buffer_r4(I,J) = globalBuf(I,J)
296                ENDDO
297               ENDDO
298              ELSEIF (filePrec .EQ. precFloat64) THEN
299             DO J=1,Ny             DO J=1,Ny
300              DO I=1,Nx              DO I=1,Nx
301               xy_buffer_r8(I,J) = globalBuf(I,J)               xy_buffer_r8(I,J) = globalBuf(I,J)
302              ENDDO              ENDDO
303             ENDDO             ENDDO
304              ENDIF
305  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
306    
307              irec=k+1-kLo+nNz*(irecord-1)
308              IF (filePrec .EQ. precFloat32) THEN
309    #ifdef _BYTESWAPIO
310               CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
311    #endif
312               WRITE(dUnit,rec=irec) xy_buffer_r4
313              ELSEIF (filePrec .EQ. precFloat64) THEN
314  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
315             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
316  #endif  #endif
# Line 282  C-      copy from arr(level=k) to 2-D "l Line 321  C-      copy from arr(level=k) to 2-D "l
321             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
322             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
323            ENDIF            ENDIF
324    C-      end if iAmDoingIO
325          ENDIF          ENDIF
326    C-     end of k loop
327         ENDDO         ENDDO
328    
329  C Close data-file  C Close data-file
# Line 334  C If we are writing to a tiled MDS file Line 375  C If we are writing to a tiled MDS file
375              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
376             ENDIF             ENDIF
377            ENDIF            ENDIF
378    
379            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
380             tNy = sNy             tNy = sNy
381  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
382             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
383             tGy = exch2_tyGlobalo(tn)             tGy = exch2_tyGlobalo(tN)
384             tGx = exch2_txGlobalo(tn)             tGx = exch2_txGlobalo(tN)
385             tNy = exch2_tNy(tn)             tNy = exch2_tNy(tN)
386             tNx = exch2_tNx(tn)             tNx = exch2_tNx(tN)
387               IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
388    C-         face x-size larger than glob-size : fold it
389                 iGjLoc = 0
390                 jGjLoc = exch2_mydNx(tN) / x_size
391               ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
392    C-         tile y-size larger than glob-size : make a long line
393                 iGjLoc = exch2_mydNx(tN)
394                 jGjLoc = 0
395               ELSE
396    C-         default (face fit into global-IO-array)
397                 iGjLoc = 0
398                 jGjLoc = 1
399               ENDIF
400  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
401             DO k=1,nNz             DO k=1,nNz
402              DO j=1,tNy              DO j=1,tNy
403               IF (globalFile) THEN               IF (globalFile) THEN
404  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
405                irec = 1 + (tGx-1)/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
406       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt
407       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
408       &                   )*tNy*exch2_domain_nyt*exch2_domain_nxt       &                   )*y_size*exch2_domain_nxt
409  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
410                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
411                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
412                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)
413       &                + nSx*nPx*Ny*(k-1)       &                + nSx*nPx*Ny*(k-kLo)
414       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
415  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
416               ELSE               ELSE
417                iG = 0                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)
               jG = 0  
               irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)  
418               ENDIF               ENDIF
419               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
420                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
421                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
422                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
423                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
424                ELSE                ELSE
425                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
426       &           ' 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 433  C If we are writing to a tiled MDS file
433                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
434               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
435                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
436                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
437                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
438                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
439                ELSE                ELSE
440                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
441       &           ' 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 475  C Create meta-file for each tile if we a
475             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
476       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
477  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
478             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
479             dimList(1,1)=x_size             dimList(1,1)=x_size
480             dimList(2,1)=exch2_txGlobalo(tn)             dimList(2,1)=exch2_txGlobalo(tN)
481             dimList(3,1)=exch2_txGlobalo(tn)+sNx-1             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1
482             dimList(1,2)=y_size             dimList(1,2)=y_size
483             dimList(2,2)=exch2_tyGlobalo(tn)             dimList(2,2)=exch2_tyGlobalo(tN)
484             dimList(3,2)=exch2_tyGlobalo(tn)+sNy-1             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1
485  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
486  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
487  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 497  C       to stay consistent with global f
497             dimList(3,3)=nNz             dimList(3,3)=nNz
498             nDims=3             nDims=3
499             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims=2
500               map2gl(1) = iGjLoc
501               map2gl(2) = jGjLoc
502             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
503       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
504       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
505       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
506            ENDIF            ENDIF
507  C End of bi,bj loops  C End of bi,bj loops
# Line 478  C Create meta-file for the global-file ( Line 533  C Create meta-file for the global-file (
533           dimList(1,3)=nNz           dimList(1,3)=nNz
534           dimList(2,3)=1           dimList(2,3)=1
535           dimList(3,3)=nNz           dimList(3,3)=nNz
536           ndims=3           nDims=3
537           IF ( nNz.EQ.1 ) ndims=2           IF ( nNz.EQ.1 ) nDims=2
538             map2gl(1) = 0
539             map2gl(2) = 1
540           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
541       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
542       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
543       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
544  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
545  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
546  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
547        ENDIF        ENDIF
548    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22