/[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.11 by jmc, Mon Jun 8 03:32:33 2009 UTC revision 1.15 by jmc, Sun Aug 2 20:42:43 2009 UTC
# Line 71  C Global variables / common blocks Line 71  C Global variables / common blocks
71  #include "EEPARAMS.h"  #include "EEPARAMS.h"
72  #include "PARAMS.h"  #include "PARAMS.h"
73  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
74  #include "W2_EXCH2_SIZE.h"  # include "W2_EXCH2_SIZE.h"
75  #include "W2_EXCH2_TOPOLOGY.h"  # include "W2_EXCH2_TOPOLOGY.h"
76  #include "W2_EXCH2_PARAMS.h"  # include "W2_EXCH2_PARAMS.h"
77  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
78  #include "EEBUFF_SCPU.h"  #include "EEBUFF_SCPU.h"
79    #ifdef ALLOW_FIZHI
80    # include "fizhi_SIZE.h"
81    #endif /* ALLOW_FIZHI */
82  #include "MDSIO_BUFF_3D.h"  #include "MDSIO_BUFF_3D.h"
83    
84  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
# Line 124  C     bBij  :: base shift in Buffer inde Line 127  C     bBij  :: base shift in Buffer inde
127  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
128        INTEGER tN        INTEGER tN
129  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
130          _RL dummyRL(1)
131          CHARACTER*8 blank8c
132    
133          DATA dummyRL(1) / 0. _d 0 /
134          DATA blank8c / '        ' /
135    
136  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137  C Set dimensions:  C Set dimensions:
# Line 155  C Only do I/O if I am the master thread Line 163  C Only do I/O if I am the master thread
163    
164  C Record number must be >= 1  C Record number must be >= 1
165        IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
166            WRITE(msgBuf,'(3A,I10)')
167         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
168            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
169         &                      SQUEEZE_RIGHT , myThid )
170          WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(A,I9.8)')
171       &    ' MDS_WRITE_FIELD: argument irecord = ',irecord       &    ' MDS_WRITE_FIELD: argument irecord = ',irecord
172          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
173       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
174           WRITE(msgBuf,'(A)')           WRITE(msgBuf,'(A)')
175       &    ' MDS_WRITE_FIELD: invalid value for irecord'       &    ' MDS_WRITE_FIELD: invalid value for irecord'
176          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 167  C Record number must be >= 1 Line 179  C Record number must be >= 1
179        ENDIF        ENDIF
180  C check for valid sub-set of levels:  C check for valid sub-set of levels:
181        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
182            WRITE(msgBuf,'(3A,I10)')
183         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
184            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
185         &                      SQUEEZE_RIGHT , myThid )
186          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
187       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,
188       &    ' , kLo=', kLo, ' , kHi=', kHi       &    ' , kLo=', kLo, ' , kHi=', kHi
189          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
190       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
191          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
192       &    ' MDS_WRITE_FIELD: invalid sub-set of levels'       &    ' MDS_WRITE_FIELD: invalid sub-set of levels'
193          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 180  C check for valid sub-set of levels: Line 196  C check for valid sub-set of levels:
196        ENDIF        ENDIF
197  C check for 3-D Buffer size:  C check for 3-D Buffer size:
198        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
199            WRITE(msgBuf,'(3A,I10)')
200         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
201            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
202         &                      SQUEEZE_RIGHT , myThid )
203          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
204       &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,       &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
205       &    ' >', size3dBuf, ' = buffer 3rd Dim'       &    ' >', size3dBuf, ' = buffer 3rd Dim'
206          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
207       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
208          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
209       &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'       &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
210          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 242  C-      copy from arr(level=k) to 2-D "l Line 262  C-      copy from arr(level=k) to 2-D "l
262              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
263       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
264            ELSE            ELSE
265              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
266       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
267              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
268              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
269              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
# Line 264  C Wait for all threads to finish filling Line 284  C Wait for all threads to finish filling
284              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
285       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
286            ELSE            ELSE
287              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
288       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
289              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
290              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
291              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
# Line 278  C Wait for all threads to finish filling Line 298  C Wait for all threads to finish filling
298       I                       xSize, ySize,       I                       xSize, ySize,
299       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
300          ELSE          ELSE
301             WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
302       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
303             CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
304             CALL ALL_PROC_DIE( myThid )            CALL ALL_PROC_DIE( myThid )
305             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
306          ENDIF          ENDIF
307  C Make other threads wait for "gather" completion so that after this,  C Make other threads wait for "gather" completion so that after this,
308  C  shared buffer can again be modified by any thread  C  shared buffer can again be modified by any thread
# Line 324  C---    Copy from arr to 3-D buffer (mul Line 344  C---    Copy from arr to 3-D buffer (mul
344              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
345       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
346            ELSE            ELSE
347              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
348       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
349              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
350              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
351              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
# Line 338  C---    Copy from arr to 3-D buffer (mul Line 358  C---    Copy from arr to 3-D buffer (mul
358              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
359       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
360            ELSE            ELSE
361              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
362       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
363              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
364              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
365              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
366            ENDIF            ENDIF
367          ELSE          ELSE
368            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
369       &         ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
370            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
371            CALL ALL_PROC_DIE( myThid )            CALL ALL_PROC_DIE( myThid )
372            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
# Line 392  C Loop over all tiles Line 412  C Loop over all tiles
412            tBy = myYGlobalLo-1 + (bj-1)*sNy            tBy = myYGlobalLo-1 + (bj-1)*sNy
413  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
414            IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
415              tN = W2_myTileList(bi)              tN = W2_myTileList(bi,bj)
416  c           tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
417  c           tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
418  c           global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
# Line 493  c          dimList(3,3) = kHi Line 513  c          dimList(3,3) = kHi
513             map2gl(2) = jGjLoc             map2gl(2) = jGjLoc
514             CALL MDS_WRITE_META(             CALL MDS_WRITE_META(
515       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
516       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
517       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
518            ENDIF            ENDIF
519    
520  C End of bi,bj loops  C End of bi,bj loops
# Line 539  c        dimList(3,3) = kHi Line 559  c        dimList(3,3) = kHi
559           map2gl(2) = 1           map2gl(2) = 1
560           CALL MDS_WRITE_META(           CALL MDS_WRITE_META(
561       I              metaFName, dataFName, the_run_name, ' ',       I              metaFName, dataFName, the_run_name, ' ',
562       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims, dimList, map2gl, 0, blank8c,
563       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, dummyRL, irecord, myIter, myThid )
564  c    I              metaFName, dataFName, the_run_name, titleLine,  c    I              metaFName, dataFName, the_run_name, titleLine,
565  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,  c    I              filePrec, nDims, dimList, map2gl, nFlds,  fldList,
566  c    I              nTimRec, timList, irecord, myIter, myThid )  c    I              nTimRec, timList, irecord, myIter, myThid )
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22