/[MITgcm]/MITgcm/pkg/mdsio/mdsio_read_field.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_read_field.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by jahn, Tue Dec 30 00:13:35 2008 UTC revision 1.5 by jmc, Wed May 6 02:42:49 2009 UTC
# Line 58  C Global variables / common blocks Line 58  C Global variables / common blocks
58  #include "SIZE.h"  #include "SIZE.h"
59  #include "EEPARAMS.h"  #include "EEPARAMS.h"
60  #include "PARAMS.h"  #include "PARAMS.h"
 #include "EESUPPORT.h"  
61  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
62  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
63  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
# Line 90  C !LOCAL VARIABLES: Line 89  C !LOCAL VARIABLES:
89        LOGICAL exst        LOGICAL exst
90        LOGICAL globalFile, fileIsOpen        LOGICAL globalFile, fileIsOpen
91        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
92          INTEGER xSize, ySize
93        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj,i,j,k,nNz
94        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
95        INTEGER length_of_rec        INTEGER length_of_rec
 #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  
       INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo  
 #endif  
96        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
97        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
98  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
99        INTEGER iGjLoc, jGjLoc        INTEGER iGjLoc, jGjLoc
100  c     INTEGER tGy,tGx,tNy,tNx,tN  c     INTEGER tGy,tGx,tNy,tNx,tN
101        INTEGER tGy,tGx,    tNx,tN        INTEGER tGy,tGx,    tNx,tN
102          INTEGER global_nTx
103  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
104        INTEGER tNy        INTEGER tNy
105    
   
106  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
107    C Set dimensions:
108          xSize = Nx
109          ySize = Ny
110    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
111          xSize = exch2_global_Nx
112          ySize = exch2_global_Ny
113    #endif
114    
115  C Assume nothing  C Assume nothing
116        globalFile = .FALSE.        globalFile = .FALSE.
# Line 200  C master thread of process 0, only, open Line 204  C master thread of process 0, only, open
204  C If global file is visible to process 0, then open it here.  C If global file is visible to process 0, then open it here.
205  C Otherwise stop program.  C Otherwise stop program.
206           IF ( globalFile) THEN           IF ( globalFile) THEN
207            length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, myThid )            length_of_rec=MDS_RECLEN( filePrec, xSize*ySize, myThid )
208            OPEN( dUnit, file=dataFName, status='old',            OPEN( dUnit, file=dataFName, status='old',
209       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
210           ELSE           ELSE
# Line 225  C master thread of process 0, only, read Line 229  C master thread of process 0, only, read
229          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
230            irec = k+1-kLo+nNz*(irecord-1)            irec = k+1-kLo+nNz*(irecord-1)
231            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
232             READ(dUnit,rec=irec) xy_buffer_r4             READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
233  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
234             CALL MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
235  #endif  #endif
236            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSEIF (filePrec .EQ. precFloat64) THEN
237             READ(dUnit,rec=irec) xy_buffer_r8             READ(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
238  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
239             CALL MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
240  #endif  #endif
241            ELSE            ELSE
242             WRITE(msgBuf,'(A)')             WRITE(msgBuf,'(A)')
# Line 240  C master thread of process 0, only, read Line 244  C master thread of process 0, only, read
244             CALL PRINT_ERROR( msgBuf, myThid )             CALL PRINT_ERROR( msgBuf, myThid )
245             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
246            ENDIF            ENDIF
247    C Map the appropriate global io-buffer to global model (real*8) array
248  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)            CALL MDS_MAP_GLOBAL(
249            bj=1       U                 xy_buffer_r4, xy_buffer_r8,
250            DO npe=1,nPx*nPy       U                 globalBuf,
251             DO bi=1,nSx       I                 xSize, ySize, filePrec,
252  #ifdef ALLOW_USE_MPI       I                 .TRUE., .FALSE. )
             loc_xGlobalLo = mpi_myXGlobalLo(npe)  
             loc_yGlobalLo = mpi_myYGlobalLo(npe)  
 #else  /* ALLOW_USE_MPI */  
             loc_xGlobalLo = myXGlobalLo  
             loc_yGlobalLo = myYGlobalLo  
 #endif /* ALLOW_USE_MPI */  
             tN = W2_mpi_myTileList(npe,bi)  
             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN  
 C-          face x-size larger than glob-size : fold it  
               iGjLoc = 0  
               jGjLoc = exch2_mydNx(tN) / x_size  
             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN  
 C-          tile y-size larger than glob-size : make a long line  
               iGjLoc = exch2_mydNx(tN)  
               jGjLoc = 0  
             ELSE  
 C-          default (face fit into global-IO-array)  
               iGjLoc = 0  
               jGjLoc = 1  
             ENDIF  
   
             IF (filePrec .EQ. precFloat32) THEN  
              DO J=1,sNy  
               DO I=1,sNx  
                iG = loc_xGlobalLo-1+(bi-1)*sNx+i  
                jG = loc_yGlobalLo-1+(bj-1)*sNy+j  
                iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1  
                jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)  
                globalBuf(iG,jG) = xy_buffer_r4(iG_IO,jG_IO)  
               ENDDO  
              ENDDO  
             ELSEIF (filePrec .EQ. precFloat64) THEN  
              DO J=1,sNy  
               DO I=1,sNx  
                iG = loc_xGlobalLo-1+(bi-1)*sNx+i  
                jG = loc_yGlobalLo-1+(bj-1)*sNy+j  
                iG_IO=exch2_txGlobalo(tN)+iGjLoc*(j-1)+i-1  
                jG_IO=exch2_tyGlobalo(tN)+jGjLoc*(j-1)  
                globalBuf(iG,jG) = xy_buffer_r8(iG_IO,jG_IO)  
               ENDDO  
              ENDDO  
             ENDIF  
   
 C--    end of npe & bi loops  
            ENDDO  
           ENDDO  
 #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
           IF (filePrec .EQ. precFloat32) THEN  
            DO J=1,Ny  
             DO I=1,Nx  
              globalBuf(I,J) = xy_buffer_r4(I,J)  
             ENDDO  
            ENDDO  
           ELSEIF (filePrec .EQ. precFloat64) THEN  
            DO J=1,Ny  
             DO I=1,Nx  
              globalBuf(I,J) = xy_buffer_r8(I,J)  
             ENDDO  
            ENDDO  
           ENDIF  
 #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  
253  C- endif iAmDoingIO  C- endif iAmDoingIO
254          ENDIF          ENDIF
255          CALL SCATTER_2D(globalBuf,sharedLocalBuf,myThid)          CALL SCATTER_2D(globalBuf,sharedLocalBuf,myThid)
# Line 390  C (This is a place-holder for the active Line 333  C (This is a place-holder for the active
333             tGx = exch2_txGlobalo(tN)             tGx = exch2_txGlobalo(tN)
334             tNy = exch2_tNy(tN)             tNy = exch2_tNy(tN)
335             tNx = exch2_tNx(tN)             tNx = exch2_tNx(tN)
336             IF   ( exch2_mydNx(tN) .GT. x_size ) THEN             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
337  C-         face x-size larger than glob-size : fold it  C-         face x-size larger than glob-size : fold it
338               iGjLoc = 0               iGjLoc = 0
339               jGjLoc = exch2_mydNx(tN) / x_size               jGjLoc = exch2_mydNx(tN) / xSize
340             ELSEIF ( exch2_tNy(tN) .GT. y_size ) THEN             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
341  C-         tile y-size larger than glob-size : make a long line  C-         tile y-size larger than glob-size : make a long line
342               iGjLoc = exch2_mydNx(tN)               iGjLoc = exch2_mydNx(tN)
343               jGjLoc = 0               jGjLoc = 0
# Line 403  C-         default (face fit into global Line 346  C-         default (face fit into global
346               iGjLoc = 0               iGjLoc = 0
347               jGjLoc = 1               jGjLoc = 1
348             ENDIF             ENDIF
349               global_nTx = exch2_global_Nx/tNx
350  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
351             DO k=kLo,kHi             DO k=kLo,kHi
352              DO j=1,tNy              DO j=1,tNy
353               IF (globalFile) THEN               IF (globalFile) THEN
354  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
355                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx
356       &                 + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx
357       &                 + ( k-kLo + (irecord-1)*nNz       &                 + ( k-kLo + (irecord-1)*nNz
358       &                   )*y_size*exch2_domain_nxt       &                   )*ySize*global_nTx
359  #else /* ALLOW_EXCH2 */  #else /* ALLOW_EXCH2 */
360                iG = myXGlobalLo-1 + (bi-1)*sNx                iG = myXGlobalLo-1 + (bi-1)*sNx
361                jG = myYGlobalLo-1 + (bj-1)*sNy                jG = myYGlobalLo-1 + (bj-1)*sNy
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22