/[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.12 by jmc, Mon Jun 8 14:38:54 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 155  C Only do I/O if I am the master thread Line 158  C Only do I/O if I am the master thread
158    
159  C Record number must be >= 1  C Record number must be >= 1
160        IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
161            WRITE(msgBuf,'(3A,I10))')
162         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
163            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
164         &                      SQUEEZE_RIGHT , myThid )
165          WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(A,I9.8)')
166       &    ' MDS_WRITE_FIELD: argument irecord = ',irecord       &    ' MDS_WRITE_FIELD: argument irecord = ',irecord
167          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
168       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
169           WRITE(msgBuf,'(A)')           WRITE(msgBuf,'(A)')
170       &    ' MDS_WRITE_FIELD: invalid value for irecord'       &    ' MDS_WRITE_FIELD: invalid value for irecord'
171          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 167  C Record number must be >= 1 Line 174  C Record number must be >= 1
174        ENDIF        ENDIF
175  C check for valid sub-set of levels:  C check for valid sub-set of levels:
176        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
177            WRITE(msgBuf,'(3A,I10))')
178         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
179            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
180         &                      SQUEEZE_RIGHT , myThid )
181          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
182       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,       &    ' MDS_WRITE_FIELD: arguments kSize=', kSize,
183       &    ' , kLo=', kLo, ' , kHi=', kHi       &    ' , kLo=', kLo, ' , kHi=', kHi
184          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
185       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
186          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
187       &    ' MDS_WRITE_FIELD: invalid sub-set of levels'       &    ' MDS_WRITE_FIELD: invalid sub-set of levels'
188          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 180  C check for valid sub-set of levels: Line 191  C check for valid sub-set of levels:
191        ENDIF        ENDIF
192  C check for 3-D Buffer size:  C check for 3-D Buffer size:
193        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN        IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
194            WRITE(msgBuf,'(3A,I10))')
195         &    ' MDS_WRITE_FIELD: file="', fName(1:IL), '" , iter=', myIter
196            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
197         &                      SQUEEZE_RIGHT , myThid )
198          WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3(A,I6))')
199       &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,       &    ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
200       &    ' >', size3dBuf, ' = buffer 3rd Dim'       &    ' >', size3dBuf, ' = buffer 3rd Dim'
201          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
202       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
203          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
204       &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'       &    ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
205          CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_ERROR( msgBuf, myThid )
# Line 242  C-      copy from arr(level=k) to 2-D "l Line 257  C-      copy from arr(level=k) to 2-D "l
257              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
258       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
259            ELSE            ELSE
260              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
261       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
262              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
263              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
264              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 279  C Wait for all threads to finish filling
279              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
280       I                       1, k, kSize, 0, 0, .FALSE., myThid )       I                       1, k, kSize, 0, 0, .FALSE., myThid )
281            ELSE            ELSE
282              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
283       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
284              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
285              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
286              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 293  C Wait for all threads to finish filling
293       I                       xSize, ySize,       I                       xSize, ySize,
294       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
295          ELSE          ELSE
296             WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
297       &       ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
298             CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
299             CALL ALL_PROC_DIE( myThid )            CALL ALL_PROC_DIE( myThid )
300             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
301          ENDIF          ENDIF
302  C Make other threads wait for "gather" completion so that after this,  C Make other threads wait for "gather" completion so that after this,
303  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 339  C---    Copy from arr to 3-D buffer (mul
339              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,              CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
340       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
341            ELSE            ELSE
342              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
343       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
344              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
345              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
346              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 353  C---    Copy from arr to 3-D buffer (mul
353              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,              CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
354       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )       I                    nNz, kLo, kSize, 0,0, .FALSE., myThid )
355            ELSE            ELSE
356              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(2A)')
357       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &      ' MDS_WRITE_FIELD: illegal value for arrType=', arrType
358              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
359              CALL ALL_PROC_DIE( myThid )              CALL ALL_PROC_DIE( myThid )
360              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'              STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
361            ENDIF            ENDIF
362          ELSE          ELSE
363            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A,I6)')
364       &         ' MDS_WRITE_FIELD: illegal value for filePrec'       &      ' MDS_WRITE_FIELD: illegal value for filePrec=',filePrec
365            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
366            CALL ALL_PROC_DIE( myThid )            CALL ALL_PROC_DIE( myThid )
367            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'            STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22