/[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.7 by jmc, Mon May 11 02:20:48 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 keepBlankTileIO
110          LOGICAL zeroBuff
111          INTEGER xSize, ySize
112        INTEGER irecord        INTEGER irecord
113        INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,bi,bj,i,j,k,nNz
114        INTEGER dimList(3,3),nDims        INTEGER irec,dUnit,IL,pIL
115        INTEGER x_size,y_size,length_of_rec        INTEGER dimList(3,3), nDims, map2gl(2)
116  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)        INTEGER iGjLoc, jGjLoc
117        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  
118        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
119        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)  
120  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
121  c     INTEGER tGy,tGx,tNy,tNx,tn  c     INTEGER tGy,tGx,tNy,tNx,tN
122        INTEGER tGy,tGx,    tNx,tn        INTEGER tGy,tGx,    tNx,tN
123          INTEGER global_nTx
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    C Set dimensions:
129          xSize = Nx
130          ySize = Ny
131          keepBlankTileIO = .FALSE.
132    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
133          xSize = exch2_global_Nx
134          ySize = exch2_global_Ny
135          keepBlankTileIO = .TRUE.
136    #endif
137    
138    C-    default:
139          iGjLoc = 0
140          jGjLoc = 1
141    
142  C Assume nothing  C Assume nothing
143        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
144        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
145        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
146          nNz = 1 + kHi - kLo
147        irecord = ABS(jrecord)        irecord = ABS(jrecord)
148        writeMetaF = jrecord.GT.0        writeMetaF = jrecord.GT.0
149    
# Line 153  C Record number must be >= 1 Line 164  C Record number must be >= 1
164           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
165           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'           STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
166          ENDIF          ENDIF
167    C check for valid sub-set of levels:
168            IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
169             WRITE(msgBuf,'(3(A,I6))')
170         &     ' MDS_WRITE_FIELD: arguments kSize=', kSize,
171         &     ' , kLo=', kLo, ' , kHi=', kHi
172             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
173         &                       SQUEEZE_RIGHT , myThid)
174             WRITE(msgBuf,'(A)')
175         &     ' MDS_WRITE_FIELD: invalid sub-set of levels'
176             CALL PRINT_ERROR( msgBuf, myThid )
177             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
178            ENDIF
179    
180  C Assign special directory  C Assign special directory
181          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 198  C globalFile is too slow, then try using
198  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
199         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
200           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
201           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,myThid)           length_of_rec=MDS_RECLEN(filePrec,xSize*ySize,myThid)
202           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
203            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
204       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
# Line 186  C Master thread of process 0, only, open Line 209  C Master thread of process 0, only, open
209         ENDIF         ENDIF
210    
211  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
212         DO k=1,nNz         DO k=kLo,kHi
213            zeroBuff = k.EQ.kLo
214  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
215          IF ( arrType.EQ.'RS' ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
216            CALL MDS_PASStoRS(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)            IF ( arrType.EQ.'RS' ) THEN
217          ELSEIF ( arrType.EQ.'RL' ) THEN              CALL MDS_PASS_R4toRS( sharedLocBuf_r4,
218            CALL MDS_PASStoRL(sharedLocalBuf,arr,k,zSize,.FALSE.,myThid)       &                            arr, k, kSize, .FALSE., myThid )
219          ELSE            ELSEIF ( arrType.EQ.'RL' ) THEN
220            WRITE(msgBuf,'(A)')              CALL MDS_PASS_R4toRL( sharedLocBuf_r4,
221         &                            arr, k, kSize, .FALSE., myThid )
222              ELSE
223                WRITE(msgBuf,'(A)')
224         &         ' MDS_WRITE_FIELD: illegal value for arrType'
225                CALL PRINT_ERROR( msgBuf, myThid )
226                STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
227              ENDIF
228              CALL GATHER_2D_R4(
229         U                       xy_buffer_r4,
230         O                       sharedLocBuf_r4,
231         I                       xSize, ySize,
232         I                       keepBlankTileIO, zeroBuff, myThid )
233            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
234              IF ( arrType.EQ.'RS' ) THEN
235                CALL MDS_PASS_R8toRS( sharedLocBuf_r8,
236         &                            arr, k, kSize, .FALSE., myThid )
237              ELSEIF ( arrType.EQ.'RL' ) THEN
238                CALL MDS_PASS_R8toRL( sharedLocBuf_r8,
239         &                            arr, k, kSize, .FALSE., myThid )
240              ELSE
241                WRITE(msgBuf,'(A)')
242       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
243            CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
244            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
245              ENDIF
246              CALL GATHER_2D_R8(
247         U                       xy_buffer_r8,
248         O                       sharedLocBuf_r8,
249         I                       xSize, ySize,
250         I                       keepBlankTileIO, zeroBuff, myThid )
251            ELSE
252               WRITE(msgBuf,'(A)')
253         &       ' MDS_WRITE_FIELD: illegal value for filePrec'
254               CALL PRINT_ERROR( msgBuf, myThid )
255               STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
256          ENDIF          ENDIF
         CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )  
257    
258          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
259            irec=k+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
260            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) */  
261  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
262             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
263  #endif  #endif
264             WRITE(dUnit,rec=irec) xy_buffer_r4             WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
265            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) */  
266  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
267             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
268  #endif  #endif
269             WRITE(dUnit,rec=irec) xy_buffer_r8             WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
270            ELSE            ELSE
271             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
272       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &       ' MDS_WRITE_FIELD: illegal value for filePrec'
273             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
274             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
275            ENDIF            ENDIF
276    C-      end if iAmDoingIO
277          ENDIF          ENDIF
278    C-     end of k loop
279         ENDDO         ENDDO
280    
281  C Close data-file  C Close data-file
# Line 334  C If we are writing to a tiled MDS file Line 327  C If we are writing to a tiled MDS file
327              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
328             ENDIF             ENDIF
329            ENDIF            ENDIF
330    
331            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
332             tNy = sNy             tNy = sNy
333  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
334             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
335             tGy = exch2_tyGlobalo(tn)             tGy = exch2_tyGlobalo(tN)
336             tGx = exch2_txGlobalo(tn)             tGx = exch2_txGlobalo(tN)
337             tNy = exch2_tNy(tn)             tNy = exch2_tNy(tN)
338             tNx = exch2_tNx(tn)             tNx = exch2_tNx(tN)
339               IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
340    C-         face x-size larger than glob-size : fold it
341                 iGjLoc = 0
342                 jGjLoc = exch2_mydNx(tN) / xSize
343               ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
344    C-         tile y-size larger than glob-size : make a long line
345                 iGjLoc = exch2_mydNx(tN)
346                 jGjLoc = 0
347               ELSE
348    C-         default (face fit into global-IO-array)
349                 iGjLoc = 0
350                 jGjLoc = 1
351               ENDIF
352               global_nTx = exch2_global_Nx/tNx
353  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
354             DO k=1,nNz             DO k=1,nNz
355              DO j=1,tNy              DO j=1,tNy
356               IF (globalFile) THEN               IF (globalFile) THEN
357  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
358                irec = 1 + (tGx-1)/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
359       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx
360       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
361       &                   )*tNy*exch2_domain_nyt*exch2_domain_nxt       &                   )*ySize*global_nTx
362  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
363                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
364                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
365                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)                irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)
366       &                + nSx*nPx*Ny*(k-1)       &                + nSx*nPx*Ny*(k-kLo)
367       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
368  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
369               ELSE               ELSE
370                iG = 0                irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)
               jG = 0  
               irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)  
371               ENDIF               ENDIF
372               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
373                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
374                 CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
375                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
376                 CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
377                ELSE                ELSE
378                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
379       &           ' 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 386  C If we are writing to a tiled MDS file
386                WRITE(dUnit,rec=irec) r4seg                WRITE(dUnit,rec=irec) r4seg
387               ELSEIF (filePrec .EQ. precFloat64) THEN               ELSEIF (filePrec .EQ. precFloat64) THEN
388                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
389                 CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
390                ELSEIF (arrType .EQ. 'RL') THEN                ELSEIF (arrType .EQ. 'RL') THEN
391                 CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg,.FALSE.,arr )                 CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg,.FALSE.,arr )
392                ELSE                ELSE
393                 WRITE(msgBuf,'(A)')                 WRITE(msgBuf,'(A)')
394       &           ' 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 428  C Create meta-file for each tile if we a
428             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
429       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
430  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
431             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
432             dimList(1,1)=x_size             dimList(1,1) = xSize
433             dimList(2,1)=exch2_txGlobalo(tn)             dimList(2,1) = exch2_txGlobalo(tN)
434             dimList(3,1)=exch2_txGlobalo(tn)+sNx-1             dimList(3,1) = exch2_txGlobalo(tN)+sNx-1
435             dimList(1,2)=y_size             dimList(1,2) = ySize
436             dimList(2,2)=exch2_tyGlobalo(tn)             dimList(2,2) = exch2_tyGlobalo(tN)
437             dimList(3,2)=exch2_tyGlobalo(tn)+sNy-1             dimList(3,2) = exch2_tyGlobalo(tN)+sNy-1
438  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
439  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
440  C       to stay consistent with global file structure  C       to stay consistent with global file structure
441             dimList(1,1)=Nx             dimList(1,1) = Nx
442             dimList(2,1)=myXGlobalLo+(bi-1)*sNx             dimList(2,1) = myXGlobalLo+(bi-1)*sNx
443             dimList(3,1)=myXGlobalLo+bi*sNx-1             dimList(3,1) = myXGlobalLo+bi*sNx-1
444             dimList(1,2)=Ny             dimList(1,2) = Ny
445             dimList(2,2)=myYGlobalLo+(bj-1)*sNy             dimList(2,2) = myYGlobalLo+(bj-1)*sNy
446             dimList(3,2)=myYGlobalLo+bj*sNy-1             dimList(3,2) = myYGlobalLo+bj*sNy-1
447  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
448             dimList(1,3)=nNz             dimList(1,3) = nNz
449             dimList(2,3)=1             dimList(2,3) = 1
450             dimList(3,3)=nNz             dimList(3,3) = nNz
451             nDims=3             nDims = 3
452             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims = 2
453               map2gl(1) = iGjLoc
454               map2gl(2) = jGjLoc
455             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
456       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
457       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
458       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
459            ENDIF            ENDIF
460  C End of bi,bj loops  C End of bi,bj loops
# Line 469  C Create meta-file for the global-file ( Line 477  C Create meta-file for the global-file (
477        IF ( writeMetaF .AND. iAmDoingIO .AND.        IF ( writeMetaF .AND. iAmDoingIO .AND.
478       &    (globalFile .OR. useSingleCpuIO) ) THEN       &    (globalFile .OR. useSingleCpuIO) ) THEN
479           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'           WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
480           dimList(1,1)=x_size           dimList(1,1) = xSize
481           dimList(2,1)=1           dimList(2,1) = 1
482           dimList(3,1)=x_size           dimList(3,1) = xSize
483           dimList(1,2)=y_size           dimList(1,2) = ySize
484           dimList(2,2)=1           dimList(2,2) = 1
485           dimList(3,2)=y_size           dimList(3,2) = ySize
486           dimList(1,3)=nNz           dimList(1,3) = nNz
487           dimList(2,3)=1           dimList(2,3) = 1
488           dimList(3,3)=nNz           dimList(3,3) = nNz
489           ndims=3           nDims = 3
490           IF ( nNz.EQ.1 ) ndims=2           IF ( nNz.EQ.1 ) nDims = 2
491             map2gl(1) = 0
492             map2gl(2) = 1
493           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
494       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
495       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
496       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
497  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
498  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
499  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
500        ENDIF        ENDIF
501    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22