/[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.6 by jmc, Wed May 6 02:42:49 2009 UTC revision 1.7 by jmc, Mon May 11 02:20:48 2009 UTC
# Line 106  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        LOGICAL zeroBuff
111        INTEGER xSize, ySize        INTEGER xSize, ySize
112        INTEGER irecord        INTEGER irecord
# Line 127  C---+----1----+----2----+----3----+----4 Line 128  C---+----1----+----2----+----3----+----4
128  C Set dimensions:  C Set dimensions:
129        xSize = Nx        xSize = Nx
130        ySize = Ny        ySize = Ny
131          keepBlankTileIO = .FALSE.
132  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
133        xSize = exch2_global_Nx        xSize = exch2_global_Nx
134        ySize = exch2_global_Ny        ySize = exch2_global_Ny
135          keepBlankTileIO = .TRUE.
136  #endif  #endif
137    
138  C-    default:  C-    default:
# Line 207  C Master thread of process 0, only, open Line 210  C Master thread of process 0, only, open
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=kLo,kHi         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,kSize,.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,kSize,.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
 C Map  global model (real*8) array to the appropriate global io-buffer  
           zeroBuff = k.EQ.kLo  
           CALL MDS_MAP_GLOBAL(  
      U                 xy_buffer_r4, xy_buffer_r8,  
      U                 globalBuf,  
      I                 xSize, ySize, filePrec,  
      I                 .FALSE., zeroBuff )  
   
259            irec=k+1-kLo+nNz*(irecord-1)            irec=k+1-kLo+nNz*(irecord-1)
260            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
261  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22