/[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.2 by jmc, Mon Mar 19 02:30:49 2007 UTC
# Line 50  C nNz=Nr implies a 3-D model field. irec Line 50  C nNz=Nr implies a 3-D model field. irec
50  C to be written and must be >= 1. NOTE: It is currently assumed that  C to be written and must be >= 1. NOTE: It is currently assumed that
51  C the highest record number in the file was the last record written.  C the highest record number in the file was the last record written.
52  C Nor is there a consistency check between the routine arguments and file.  C Nor is there a consistency check between the routine arguments and file.
53  C ie. If your write record 2 after record 4 the meta information  C ie. if you write record 2 after record 4 the meta information
54  C will record the number of records to be 2. This, again, is because  C will record the number of records to be 2. This, again, is because
55  C we have read the meta information. To be fixed.  C we have read the meta information. To be fixed.
56  C  C
# Line 106  C !LOCAL VARIABLES: Line 106  C !LOCAL VARIABLES:
106        LOGICAL writeMetaF        LOGICAL writeMetaF
107        INTEGER irecord        INTEGER irecord
108        INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL        INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL
109        INTEGER dimList(3,3),nDims        INTEGER dimList(3,3), nDims, map2gl(2)
110          INTEGER iGjLoc, jGjLoc
111        INTEGER x_size,y_size,length_of_rec        INTEGER x_size,y_size,length_of_rec
112  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
113        INTEGER iG_IO,jG_IO,npe        INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo
114        PARAMETER ( x_size = exch2_domain_nxt * sNx )        PARAMETER ( x_size = exch2_domain_nxt * sNx )
115        PARAMETER ( y_size = exch2_domain_nyt * sNy )        PARAMETER ( y_size = exch2_domain_nyt * sNy )
116  #else  #else
# Line 122  C !LOCAL VARIABLES: Line 123  C !LOCAL VARIABLES:
123        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
124        Real*8 globalBuf(Nx,Ny)        Real*8 globalBuf(Nx,Ny)
125  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
126  c     INTEGER tGy,tGx,tNy,tNx,tn  c     INTEGER tGy,tGx,tNy,tNx,tN
127        INTEGER tGy,tGx,    tNx,tn        INTEGER tGy,tGx,    tNx,tN
128  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
129        INTEGER tNy        INTEGER tNy
130    
131  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
132    
133    C-    default:
134          iGjLoc = 0
135          jGjLoc = 1
136    
137  C Assume nothing  C Assume nothing
138        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
139        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
# Line 201  C-      copy from arr(level=k) to 2-D "l Line 206  C-      copy from arr(level=k) to 2-D "l
206          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )          CALL GATHER_2D( globalBuf, sharedLocalBuf, myThid )
207    
208          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
           irec=k+nNz*(irecord-1)  
           IF (filePrec .EQ. precFloat32) THEN  
209  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
210              IF (filePrec .EQ. precFloat32) THEN
211             DO J=1,y_size             DO J=1,y_size
212              DO I=1,x_size              DO I=1,x_size
213               xy_buffer_r4(I,J) = 0.0               xy_buffer_r4(I,J) = 0.0
214              ENDDO              ENDDO
215             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  
216            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
217             DO J=1,y_size             DO J=1,y_size
218              DO I=1,x_size              DO I=1,x_size
219               xy_buffer_r8(I,J) = 0.0               xy_buffer_r8(I,J) = 0.0
220              ENDDO              ENDDO
221             ENDDO             ENDDO
222             bj=1            ENDIF
223             DO npe=1,nPx*nPy  
224              DO bi=1,nSx            bj=1
225               DO J=1,sNy            DO npe=1,nPx*nPy
226                DO I=1,sNx             DO bi=1,nSx
227  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
228                 iG=mpi_myXGlobalLo(npe)-1+(bi-1)*sNx+i              loc_xGlobalLo = mpi_myXGlobalLo(npe)
229                 jG=mpi_myYGlobalLo(npe)-1+(bj-1)*sNy+j              loc_yGlobalLo = mpi_myYGlobalLo(npe)
230  #else  #else  /* ALLOW_USE_MPI */
231                 iG= myXGlobalLo-1+(bi-1)*sNx+i              loc_xGlobalLo = myXGlobalLo
232                 jG= myYGlobalLo-1+(bj-1)*sNy+j              loc_yGlobalLo = myYGlobalLo
233  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
234                 iG_IO=exch2_txGlobalo(W2_mpi_myTileList(npe,bi))+i-1              tN = W2_mpi_myTileList(npe,bi)
235                 jG_IO=exch2_tyGlobalo(W2_mpi_myTileList(npe,bi))+j-1              IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
236    C-          face x-size larger than glob-size : fold it
237                  iGjLoc = 0
238                  jGjLoc = exch2_mydNx(tN) / x_size
239                ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
240    C-          tile y-size larger than glob-size : make a long line
241                  iGjLoc = exch2_mydNx(tN)
242                  jGjLoc = 0
243                ELSE
244    C-          default (face fit into global-IO-array)
245                  iGjLoc = 0
246                  jGjLoc = 1
247                ENDIF
248    
249                IF (filePrec .EQ. precFloat32) THEN
250                 DO J=1,sNy
251                  DO I=1,sNx
252                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
253                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
254                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
255                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
256                   xy_buffer_r4(iG_IO,jG_IO) = globalBuf(iG,jG)
257                  ENDDO
258                 ENDDO
259                ELSEIF (filePrec .EQ. precFloat64) THEN
260                 DO J=1,sNy
261                  DO I=1,sNx
262                   iG = loc_xGlobalLo-1+(bi-1)*sNx+i
263                   jG = loc_yGlobalLo-1+(bj-1)*sNy+j
264                   iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1
265                   jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
266                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)                 xy_buffer_r8(iG_IO,jG_IO) = globalBuf(iG,jG)
267                ENDDO                ENDDO
268               ENDDO               ENDDO
269              ENDDO              ENDIF
270    
271    C--    end of npe & bi loops
272             ENDDO             ENDDO
273              ENDDO
274  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
275              IF (filePrec .EQ. precFloat32) THEN
276               DO J=1,Ny
277                DO I=1,Nx
278                 xy_buffer_r4(I,J) = globalBuf(I,J)
279                ENDDO
280               ENDDO
281              ELSEIF (filePrec .EQ. precFloat64) THEN
282             DO J=1,Ny             DO J=1,Ny
283              DO I=1,Nx              DO I=1,Nx
284               xy_buffer_r8(I,J) = globalBuf(I,J)               xy_buffer_r8(I,J) = globalBuf(I,J)
285              ENDDO              ENDDO
286             ENDDO             ENDDO
287              ENDIF
288  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
289    
290              irec=k+nNz*(irecord-1)
291              IF (filePrec .EQ. precFloat32) THEN
292    #ifdef _BYTESWAPIO
293               CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
294    #endif
295               WRITE(dUnit,rec=irec) xy_buffer_r4
296              ELSEIF (filePrec .EQ. precFloat64) THEN
297  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
298             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
299  #endif  #endif
# Line 282  C-      copy from arr(level=k) to 2-D "l Line 304  C-      copy from arr(level=k) to 2-D "l
304             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
305             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
306            ENDIF            ENDIF
307    C-      end if iAmDoingIO
308          ENDIF          ENDIF
309    C-     end of k loop
310         ENDDO         ENDDO
311    
312  C Close data-file  C Close data-file
# Line 334  C If we are writing to a tiled MDS file Line 358  C If we are writing to a tiled MDS file
358              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
359             ENDIF             ENDIF
360            ENDIF            ENDIF
361    
362            IF (fileIsOpen) THEN            IF (fileIsOpen) THEN
363             tNy = sNy             tNy = sNy
364  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
365             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
366             tGy = exch2_tyGlobalo(tn)             tGy = exch2_tyGlobalo(tN)
367             tGx = exch2_txGlobalo(tn)             tGx = exch2_txGlobalo(tN)
368             tNy = exch2_tNy(tn)             tNy = exch2_tNy(tN)
369             tNx = exch2_tNx(tn)             tNx = exch2_tNx(tN)
370               IF   ( exch2_mydNx(tN) .GT. x_size ) THEN
371    C-         face x-size larger than glob-size : fold it
372                 iGjLoc = 0
373                 jGjLoc = exch2_mydNx(tN) / x_size
374               ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN
375    C-         tile y-size larger than glob-size : make a long line
376                 iGjLoc = exch2_mydNx(tN)
377                 jGjLoc = 0
378               ELSE
379    C-         default (face fit into global-IO-array)
380                 iGjLoc = 0
381                 jGjLoc = 1
382               ENDIF
383  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
384             DO k=1,nNz             DO k=1,nNz
385              DO j=1,tNy              DO j=1,tNy
386               IF (globalFile) THEN               IF (globalFile) THEN
387  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
388                irec = 1 + (tGx-1)/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
389       &                 + ( j-1 + tGy-1 )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt
390       &                 + ( k-1 + (irecord-1)*nNz       &                 + ( k-1 + (irecord-1)*nNz
391       &                   )*tNy*exch2_domain_nyt*exch2_domain_nxt       &                   )*y_size*exch2_domain_nxt
392  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
393                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
394                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
# Line 359  C If we are writing to a tiled MDS file Line 397  C If we are writing to a tiled MDS file
397       &                + nSx*nPx*Ny*nNz*(irecord-1)       &                + nSx*nPx*Ny*nNz*(irecord-1)
398  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
399               ELSE               ELSE
               iG = 0  
               jG = 0  
400                irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)                irec=j + sNy*(k-1) + sNy*nNz*(irecord-1)
401               ENDIF               ENDIF
402               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
# Line 422  C Create meta-file for each tile if we a Line 458  C Create meta-file for each tile if we a
458             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')             WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
459       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'       &              pfName(1:pIL),'.',iG,'.',jG,'.meta'
460  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
461             tn = W2_myTileList(bi)             tN = W2_myTileList(bi)
462             dimList(1,1)=x_size             dimList(1,1)=x_size
463             dimList(2,1)=exch2_txGlobalo(tn)             dimList(2,1)=exch2_txGlobalo(tN)
464             dimList(3,1)=exch2_txGlobalo(tn)+sNx-1             dimList(3,1)=exch2_txGlobalo(tN)+sNx-1
465             dimList(1,2)=y_size             dimList(1,2)=y_size
466             dimList(2,2)=exch2_tyGlobalo(tn)             dimList(2,2)=exch2_tyGlobalo(tN)
467             dimList(3,2)=exch2_tyGlobalo(tn)+sNy-1             dimList(3,2)=exch2_tyGlobalo(tN)+sNy-1
468  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
469  C- jmc: if MISSING_TILE_IO, keep meta files unchanged  C- jmc: if MISSING_TILE_IO, keep meta files unchanged
470  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 480  C       to stay consistent with global f
480             dimList(3,3)=nNz             dimList(3,3)=nNz
481             nDims=3             nDims=3
482             IF ( nNz.EQ.1 ) nDims=2             IF ( nNz.EQ.1 ) nDims=2
483               map2gl(1) = iGjLoc
484               map2gl(2) = jGjLoc
485             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
486       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
487       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
488       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
489            ENDIF            ENDIF
490  C End of bi,bj loops  C End of bi,bj loops
# Line 478  C Create meta-file for the global-file ( Line 516  C Create meta-file for the global-file (
516           dimList(1,3)=nNz           dimList(1,3)=nNz
517           dimList(2,3)=1           dimList(2,3)=1
518           dimList(3,3)=nNz           dimList(3,3)=nNz
519           ndims=3           nDims=3
520           IF ( nNz.EQ.1 ) ndims=2           IF ( nNz.EQ.1 ) nDims=2
521             map2gl(1) = iGjLoc
522             map2gl(2) = jGjLoc
523           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
524       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
525       I              filePrec, nDims, dimList, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
526       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
527  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
528  c    I              filePrec, nDims, dimList, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
529  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
530        ENDIF        ENDIF
531    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22