/[MITgcm]/MITgcm/model/src/read_write.F
ViewVC logotype

Diff of /MITgcm/model/src/read_write.F

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

revision 1.1 by cnh, Thu May 21 18:25:49 1998 UTC revision 1.10 by cnh, Tue Jun 30 17:21:11 1998 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  #include "CPP_EEOPTIONS.h"  #include "CPP_OPTIONS.h"
3    
4  C--  File read_write.F: Routines to handle mid-level I/O interface.  C--  File read_write.F: Routines to handle mid-level I/O interface.
5  C--   Contents  C--   Contents
# Line 14  C--                   Uses MITgcmUV envi Line 14  C--                   Uses MITgcmUV envi
14  C--   o WRITE_FLD_XY_RL  - Write two-dimensional model _RL field.  C--   o WRITE_FLD_XY_RL  - Write two-dimensional model _RL field.
15  C--   o WRITE_FLD_XYZ_RL - Write three-dimensional model _RL field.  C--   o WRITE_FLD_XYZ_RL - Write three-dimensional model _RL field.
16  C--   o WRITE_STATE - Write out model state.  C--   o WRITE_STATE - Write out model state.
17  C--   o WRITE_CHKPT - Write out checkpoint files for restarting.  C--   o WRITE_CHECKPOINT - Write out checkpoint files for restarting.
18    
19  CStartofinterface  CStartofinterface
20        SUBROUTINE READ_CHECKPOINT ( myIter, myThid )        SUBROUTINE READ_CHECKPOINT ( myIter, myThid )
# Line 52  C     msgBuf - Error message buffer Line 52  C     msgBuf - Error message buffer
52        INTEGER endIOErrCount        INTEGER endIOErrCount
53        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
54        LOGICAL permCheckPoint          LOGICAL permCheckPoint  
55          INTEGER oldPrec
56    
57  C--    Going to really do some IO. Make everyone except master thread wait.  C--    Going to really do some IO. Make everyone except master thread wait.
58         _BARRIER         _BARRIER
# Line 60  C--    Going to really do some IO. Make Line 61  C--    Going to really do some IO. Make
61  C--     Set suffix for this set of data files.  C--     Set suffix for this set of data files.
62          WRITE(suff,'(I10.10)') myIter          WRITE(suff,'(I10.10)') myIter
63    
64  C--     Set IO "context" for writing state  C--     Set IO "context" for reading state
65          CALL DFILE_SET_RO          CALL DFILE_SET_RO
66          CALL DFILE_SET_CONT_ON_ERROR          CALL DFILE_SET_CONT_ON_ERROR
67  C       Force 64-bit IO  C       Force 64-bit IO
68            oldPrec        = readBinaryPrec
69          readBinaryPrec = precFloat64          readBinaryPrec = precFloat64
70    
71    
# Line 85  C       Raw fields Line 87  C       Raw fields
87          CALL READ_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)          CALL READ_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)
88          CALL READ_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)
89          CALL READ_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)          CALL READ_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)
90    #ifdef ALLOW_CD
91            CALL READ_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
92            CALL READ_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
93            CALL READ_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
94            CALL READ_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
95            CALL READ_FLD_XYZ_RL(  'vNM1.', suff,     vNM1, myIter, myThid)
96            CALL READ_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)
97            CALL READ_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)
98    #endif
99    
100  C--     Reread IO error counter  C--     Reread IO error counter
101          endIOErrCount = IO_ERRCOUNT(myThid)          endIOErrCount = IO_ERRCOUNT(myThid)
# Line 105  C--     Check for IO errors Line 116  C--     Check for IO errors
116           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
117          ENDIF          ENDIF
118    
119    C       Resotre default IO precision
120            readBinaryPrec = oldPrec
121    
122         _END_MASTER( myThid )         _END_MASTER( myThid )
123         _BARRIER         _BARRIER
124    
# Line 122  C--    Fill in edge regions Line 136  C--    Fill in edge regions
136        _EXCH_XYZ_R8(gs    , myThid )        _EXCH_XYZ_R8(gs    , myThid )
137        _EXCH_XYZ_R8(gsNM1 , myThid )        _EXCH_XYZ_R8(gsNM1 , myThid )
138        _EXCH_XY_R8 (cg2d_x, myThid )        _EXCH_XY_R8 (cg2d_x, myThid )
139    #ifdef ALLOW_CD
140          _EXCH_XY_R8( cg2d_xNM1, myThid )
141          _EXCH_XYZ_R8( uVelD,    myThid )
142          _EXCH_XYZ_R8( vVelD,    myThid )
143          _EXCH_XYZ_R8( uNM1,     myThid )
144          _EXCH_XYZ_R8( vNM1,     myThid )
145          _EXCH_XYZ_R8( guCD,     myThid )
146          _EXCH_XYZ_R8( gvCD,     myThid )
147    #endif
148    
149        RETURN        RETURN
150        END        END
# Line 138  C     \================================= Line 161  C     \=================================
161    
162  C     == Global variables ==  C     == Global variables ==
163  #include "SIZE.h"  #include "SIZE.h"
 #include "PARAMS.h"  
164  #include "EEPARAMS.h"  #include "EEPARAMS.h"
165    #include "PARAMS.h"
166  #include "DFILE.h"  #include "DFILE.h"
167            
168        INTEGER  IFNBLNK        INTEGER  IFNBLNK
# Line 180  C     nDims, dimList - Local and global Line 203  C     nDims, dimList - Local and global
203        INTEGER lFilled          INTEGER lFilled  
204        INTEGER nXP, nYP        INTEGER nXP, nYP
205        INTEGER iP, jP, kP, ib        INTEGER iP, jP, kP, ib
206        INTEGER i,j, k, bi, bj        INTEGER i,j, k, bi, bj, iG, jG
207        INTEGER s1Lo, s1Hi, s2Lo, s2Hi        INTEGER s1Lo, s1Hi, s2Lo, s2Hi
208        INTEGER nDims        INTEGER nDims
209        PARAMETER ( nDims = 2 )        PARAMETER ( nDims = 2 )
# Line 199  C          U.0000000100 Line 222  C          U.0000000100
222        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
223        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
224        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
225        WRITE( fNamData, '(A,A)' )        IF ( suff .EQ. ' ' ) THEN
226           WRITE( fNamData, '(A)' )
227         & pref(s1Lo:s1Hi)
228           WRITE( fNamMeta, '(A)' )
229         & pref(s1Lo:s1Hi)
230           s2Lo = 1
231           s2Hi = 1
232          ELSE
233           WRITE( fNamData, '(A,A)' )
234       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
235       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
236        WRITE( fNamMeta, '(A,A)' )         WRITE( fNamMeta, '(A,A)' )
237       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
238       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
239          ENDIF
240    
241  C--   Open file  C--   Open file
242          CALL DFILE_SET_RO
243        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
244       O                 fileHandle )       O                 fileHandle )
245        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 214  C--   Open file Line 247  C--   Open file
247  C--   Set local and global data extents  C--   Set local and global data extents
248        nXP=sNx*nSx        nXP=sNx*nSx
249        nYP=sNy*nSy        nYP=sNy*nSy
250        lFilled = sNx*nSx * sNy*nSy        lFilled = sNx*nSx*nPx * sNy*nSy*nPy
251        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
252        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
253        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
# Line 240  C     Also regrid it to i,j,k indexing. Line 273  C     Also regrid it to i,j,k indexing.
273            DO i=1,sNx            DO i=1,sNx
274             iP = (bi-1)*sNx+i             iP = (bi-1)*sNx+i
275             jP = (bj-1)*sNy+j             jP = (bj-1)*sNy+j
276             ib = (jP-1)*nXP + iP             iG = myXGlobalLo-1+(bi-1)*sNx+I
277               jG = myYGlobalLo-1+(bj-1)*sNy+J
278               ib = (jG-1)*nXp*nPx+iG
279             fld(i,j,bi,bj) = ioBuf_R4(ib)             fld(i,j,bi,bj) = ioBuf_R4(ib)
280            ENDDO            ENDDO
281           ENDDO           ENDDO
# Line 253  C     Also regrid it to i,j,k indexing. Line 288  C     Also regrid it to i,j,k indexing.
288            DO i=1,sNx            DO i=1,sNx
289             iP = (bi-1)*sNx+i             iP = (bi-1)*sNx+i
290             jP = (bj-1)*sNy+j             jP = (bj-1)*sNy+j
291             ib = (jP-1)*nXP + iP             iG = myXGlobalLo-1+(bi-1)*sNx+I
292               jG = myYGlobalLo-1+(bj-1)*sNy+J
293               ib = (jG-1)*nXp*nPx+iG
294               fld(i,j,bi,bj) = ioBuf_R8(ib)
295              ENDDO
296             ENDDO
297            ENDDO
298           ENDDO
299          ENDIF
300    
301    C--   Close file
302          CALL DFILE_CLOSE( fileHandle, myThid )
303    
304    C--   Check errors
305          endIOerrCount = IO_ERRCOUNT(myThid)
306          IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
307           WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
308         &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
309           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
310          ELSE
311           WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
312           CALL PRINT_ERROR( msgBuf, 1 )
313          ENDIF
314    
315     1000 CONTINUE
316    
317          RETURN
318          END
319    
320    CStartofinterface
321          SUBROUTINE READ_FLD_XY_RS(  pref ,suff, fld, myIter, myThid)
322    C     /==========================================================\
323    C     | SUBROUTINE READ_FLD_XY_RS                                |
324    C     | o Generic two-dimensional field IO routine.              |
325    C     |==========================================================|
326    C     | Call low-level routines to read a 2d model field.        |
327    C     | Handles _RS type data ( generally _RS == REAL*4 )        |
328    C     \==========================================================/
329    
330    C     == Global variables ==
331    #include "SIZE.h"
332    #include "EEPARAMS.h"
333    #include "PARAMS.h"
334    #include "DFILE.h"
335        
336          INTEGER  IFNBLNK
337          EXTERNAL IFNBLNK
338          INTEGER  ILNBLNK
339          EXTERNAL ILNBLNK
340          INTEGER  IO_ERRCOUNT
341          EXTERNAL IO_ERRCOUNT
342    CEndofinterface
343    
344    C     == Routine arguments ==
345    C     pref   - File name prefix
346    C     suff   - File name suffix
347    C     fld    - Array to be filled
348    C     myIter - Timestep number
349    C     myThid - Thread number calling this routine
350          CHARACTER*(*) pref
351          CHARACTER*(*) suff
352          _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
353          INTEGER myIter
354          INTEGER myThid
355    
356    C     == Local variables ==
357    C     fNamData   - Filename building strings
358    C     fNamMeta  
359    C     fileHandle - Handle used to refer to an open DFILE file.
360    C     lFilled    - Used to indicate the number of elements in the
361    C                  IO buffer that have been filled.
362    C     nXP, nYp   - Processes domain extents in X and Y.
363    C     iP, jP, kP - Index in processes coordinates.
364    C     ib         - Index in IO buffer
365    C     i, j, k, bi, bj - Loop counters
366    C     s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
367    C     nDims, dimList - Local and global dataset dimensions
368          CHARACTER*(MAX_LEN_FNAM) fNamData
369          CHARACTER*(MAX_LEN_FNAM) fNamMeta
370          INTEGER fileHandle
371          INTEGER lFilled  
372          INTEGER nXP, nYP
373          INTEGER iP, jP, kP, ib
374          INTEGER i,j, k, bi, bj, iG, jG
375          INTEGER s1Lo, s1Hi, s2Lo, s2Hi
376          INTEGER nDims
377          PARAMETER ( nDims = 2 )
378          INTEGER dimList(nDims*3)
379          INTEGER beginIOErrCount, endIOErrCount
380          CHARACTER*(MAX_LEN_MBUF) msgBuf
381    
382    C--   Track IO errors
383          beginIOErrCount = IO_ERRCOUNT(myThid)
384    
385    C--   Build file name
386    C     Name has form 'prefix.suffix'
387    C     e.g. U.0000000100
388    C          U.0000000100
389          s1Lo = IFNBLNK(pref)
390          s1Hi = ILNBLNK(pref)
391          s2Lo = IFNBLNK(suff)
392          s2Hi = ILNBLNK(suff)
393          IF     ( pref .EQ. ' ' ) THEN
394           WRITE( fNamData, '(A)' )
395         & suff(s2Lo:s2Hi)
396           WRITE( fNamMeta, '(A)' )
397         & suff(s2Lo:s2Hi)
398           s1Lo = 1
399           s1Hi = 1
400          ELSEIF ( suff .EQ. ' ' ) THEN
401           WRITE( fNamData, '(A)' )
402         & pref(s1Lo:s1Hi)
403           WRITE( fNamMeta, '(A)' )
404         & pref(s1Lo:s1Hi)
405           s2Lo = 1
406           s2Hi = 1
407          ELSE
408           WRITE( fNamData, '(A,A)' )
409         & pref(s1Lo:s1Hi),
410         & suff(s2Lo:s2Hi)
411           WRITE( fNamMeta, '(A,A)' )
412         & pref(s1Lo:s1Hi),
413         & suff(s2Lo:s2Hi)
414          ENDIF
415    
416    C--   Open file
417          CALL DFILE_SET_RO
418          CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
419         O                 fileHandle )
420          IF ( fileHandle .LE. 0 ) GOTO 1000
421    
422    C--   Set local and global data extents
423          nXP=sNx*nSx
424          nYP=sNy*nSy
425          lFilled = sNx*nSx*nPx * sNy*nSy*nPy
426          dimList(1) = nXP*nPx
427          dimList(2) = myXGlobalLo
428          dimList(3) = myXGlobalLo+nXP-1
429          dimList(4) = nYP*nPy
430          dimList(5) = myYGlobalLo
431          dimList(6) = myYGlobalLo+nYP-1
432    
433    C--   Read data
434          IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
435           CALL DFILE_READ_R4( lFilled,
436         I                      fileHandle, myThid )
437          ELSE
438           CALL DFILE_READ_R8( lFilled,
439         I                      fileHandle, myThid )
440          ENDIF
441    
442    C--   Copy data from IO buffer.
443    C     Also regrid it to i,j,k indexing.
444          IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
445           DO bj=1,nSy
446            DO bi=1,nSx
447             DO j=1,sNy
448              DO i=1,sNx
449               iP = (bi-1)*sNx+i
450               jP = (bj-1)*sNy+j
451               iG = myXGlobalLo-1+(bi-1)*sNx+I
452               jG = myYGlobalLo-1+(bj-1)*sNy+J
453               ib = (jG-1)*nXp*nPx+iG
454               fld(i,j,bi,bj) = ioBuf_R4(ib)
455              ENDDO
456             ENDDO
457            ENDDO
458           ENDDO
459          ELSE
460           DO bj=1,nSy
461            DO bi=1,nSx
462             DO j=1,sNy
463              DO i=1,sNx
464               iP = (bi-1)*sNx+i
465               jP = (bj-1)*sNy+j
466               iG = myXGlobalLo-1+(bi-1)*sNx+I
467               jG = myYGlobalLo-1+(bj-1)*sNy+J
468               ib = (jG-1)*nXp*nPx+iG
469             fld(i,j,bi,bj) = ioBuf_R8(ib)             fld(i,j,bi,bj) = ioBuf_R8(ib)
470            ENDDO            ENDDO
471           ENDDO           ENDDO
# Line 292  C     \================================= Line 504  C     \=================================
504    
505  C     == Global variables ==  C     == Global variables ==
506  #include "SIZE.h"  #include "SIZE.h"
 #include "PARAMS.h"  
507  #include "EEPARAMS.h"  #include "EEPARAMS.h"
508    #include "PARAMS.h"
509  #include "DFILE.h"  #include "DFILE.h"
510            
511        INTEGER  IFNBLNK        INTEGER  IFNBLNK
# Line 334  C     nDims, dimList - Local and global Line 546  C     nDims, dimList - Local and global
546        INTEGER lFilled          INTEGER lFilled  
547        INTEGER nXP, nYP        INTEGER nXP, nYP
548        INTEGER iP, jP, kP, ib        INTEGER iP, jP, kP, ib
549        INTEGER i,j, k, bi, bj        INTEGER i,j, k, bi, bj, iG, jG
550        INTEGER s1Lo, s1Hi, s2Lo, s2Hi        INTEGER s1Lo, s1Hi, s2Lo, s2Hi
551        INTEGER nDims        INTEGER nDims
552        PARAMETER ( nDims = 3 )        PARAMETER ( nDims = 3 )
# Line 353  C          U.0000000100 Line 565  C          U.0000000100
565        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
566        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
567        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
568        WRITE( fNamData, '(A,A)' )        IF ( suff .EQ. ' ' ) THEN
569           WRITE( fNamData, '(A)' )
570         & pref(s1Lo:s1Hi)
571           WRITE( fNamMeta, '(A)' )
572         & pref(s1Lo:s1Hi)
573           s2Lo = 1
574           s2Hi = 1
575          ELSE
576           WRITE( fNamData, '(A,A)' )
577       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
578       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
579        WRITE( fNamMeta, '(A,A)' )         WRITE( fNamMeta, '(A,A)' )
580       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
581       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
582          ENDIF
583    
584  C--   Open file  C--   Open file
585          CALL DFILE_SET_RO
586        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
587       O                 fileHandle )       O                 fileHandle )
588        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 368  C--   Open file Line 590  C--   Open file
590  C--   Set local and global data extents  C--   Set local and global data extents
591        nXP=sNx*nSx        nXP=sNx*nSx
592        nYP=sNy*nSy        nYP=sNy*nSy
593        lFilled = sNx*nSx * sNy*nSy * nZ        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ
594        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
595        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
596        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
# Line 399  C     Also regrid it to i,j,k indexing. Line 621  C     Also regrid it to i,j,k indexing.
621              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
622              jP = (bj-1)*sNy+j              jP = (bj-1)*sNy+j
623              kP = K              kP = K
624              ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP              iG = myXGlobalLo-1+(bi-1)*sNx+I
625                jG = myYGlobalLo-1+(bj-1)*sNy+J
626                ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
627              fld(i,j,k,bi,bj) = ioBuf_R4(ib)              fld(i,j,k,bi,bj) = ioBuf_R4(ib)
628             ENDDO             ENDDO
629            ENDDO            ENDDO
# Line 414  C     Also regrid it to i,j,k indexing. Line 638  C     Also regrid it to i,j,k indexing.
638             DO i=1,sNx             DO i=1,sNx
639              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
640              jP = (bj-1)*sNy+j              jP = (bj-1)*sNy+j
641               kP = K              kP = K
642              ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP              iG = myXGlobalLo-1+(bi-1)*sNx+I
643                jG = myYGlobalLo-1+(bj-1)*sNy+J
644                ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
645                fld(i,j,k,bi,bj) = ioBuf_R8(ib)
646               ENDDO
647              ENDDO
648             ENDDO
649            ENDDO
650           ENDDO
651          ENDIF
652    
653    C--   Close file
654          CALL DFILE_CLOSE( fileHandle, myThid )
655    
656    C--   Check errors
657          endIOerrCount = IO_ERRCOUNT(myThid)
658          IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
659           WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
660         &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
661           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
662          ELSE
663           WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
664           CALL PRINT_ERROR( msgBuf, 1 )
665          ENDIF
666    
667     1000 CONTINUE
668    
669          RETURN
670          END
671    
672    CStartofinterface
673          SUBROUTINE READ_FLD_XYZ_RS(  pref ,suff, fld, myIter, myThid)
674    C     /==========================================================\
675    C     | SUBROUTINE READ_FLD_XYZ_RS                               |
676    C     | o Generic three-dimensional field IO routine.            |
677    C     |==========================================================|
678    C     | Call low-level routines to read a 3d model field.        |
679    C     | Handles _RS type data ( generally _RS == REAL*4 )        |
680    C     \==========================================================/
681    
682    C     == Global variables ==
683    #include "SIZE.h"
684    #include "EEPARAMS.h"
685    #include "PARAMS.h"
686    #include "DFILE.h"
687        
688          INTEGER  IFNBLNK
689          EXTERNAL IFNBLNK
690          INTEGER  ILNBLNK
691          EXTERNAL ILNBLNK
692          INTEGER  IO_ERRCOUNT
693          EXTERNAL IO_ERRCOUNT
694    CEndofinterface
695    
696    C     == Routine arguments ==
697    C     pref   - File name prefix
698    C     suff   - File name suffix
699    C     fld    - Array to be filled
700    C     myIter - Timestep number
701    C     myThid - Thread number calling this routine
702          CHARACTER*(*) pref
703          CHARACTER*(*) suff
704          _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)
705          INTEGER myIter
706          INTEGER myThid
707    
708    C     == Local variables ==
709    C     fNamData   - Filename building strings
710    C     fNamMeta  
711    C     fileHandle - Handle used to refer to an open DFILE file.
712    C     lFilled    - Used to indicate the number of elements in the
713    C                  IO buffer that have been filled.
714    C     nXP, nYp   - Processes domain extents in X and Y.
715    C     iP, jP, kP - Index in processes coordinates.
716    C     ib         - Index in IO buffer
717    C     i, j, k, bi, bj - Loop counters
718    C     s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
719    C     nDims, dimList - Local and global dataset dimensions
720          CHARACTER*(MAX_LEN_FNAM) fNamData
721          CHARACTER*(MAX_LEN_FNAM) fNamMeta
722          INTEGER fileHandle
723          INTEGER lFilled  
724          INTEGER nXP, nYP
725          INTEGER iP, jP, kP, ib
726          INTEGER i,j, k, bi, bj, iG , jG
727          INTEGER s1Lo, s1Hi, s2Lo, s2Hi
728          INTEGER nDims
729          PARAMETER ( nDims = 3 )
730          INTEGER dimList(nDims*3)
731          INTEGER beginIOErrCount, endIOErrCount
732          CHARACTER*(MAX_LEN_MBUF) msgBuf
733    
734    C--   Track IO errors
735          beginIOErrCount = IO_ERRCOUNT(myThid)
736    
737    C--   Build file name
738    C     Name has form 'prefix.suffix'
739    C     e.g. U.0000000100
740    C          U.0000000100
741          s1Lo = IFNBLNK(pref)
742          s1Hi = ILNBLNK(pref)
743          s2Lo = IFNBLNK(suff)
744          s2Hi = ILNBLNK(suff)
745          IF ( suff .EQ. ' ' ) THEN
746           WRITE( fNamData, '(A)' )
747         & pref(s1Lo:s1Hi)
748           WRITE( fNamMeta, '(A)' )
749         & pref(s1Lo:s1Hi)
750           s2Lo = 1
751           s2Hi = 1
752          ELSE
753           WRITE( fNamData, '(A,A)' )
754         & pref(s1Lo:s1Hi),
755         & suff(s2Lo:s2Hi)
756           WRITE( fNamMeta, '(A,A)' )
757         & pref(s1Lo:s1Hi),
758         & suff(s2Lo:s2Hi)
759          ENDIF
760          
761    C--   Open file
762          CALL DFILE_SET_RO
763          CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
764         O                 fileHandle )
765          IF ( fileHandle .LE. 0 ) GOTO 1000
766    
767    C--   Set local and global data extents
768          nXP=sNx*nSx
769          nYP=sNy*nSy
770          lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ
771          dimList(1) = nXP*nPx
772          dimList(2) = myXGlobalLo
773          dimList(3) = myXGlobalLo+nXP-1
774          dimList(4) = nYP*nPy
775          dimList(5) = myYGlobalLo
776          dimList(6) = myYGlobalLo+nYP-1
777          dimList(7) = nZ
778          dimList(8) = 1
779          dimList(9) = nZ
780    
781    C--   Read data
782          IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
783           CALL DFILE_READ_R4( lFilled,
784         I                      fileHandle, myThid )
785          ELSE
786           CALL DFILE_READ_R8( lFilled,
787         I                      fileHandle, myThid )
788          ENDIF
789    
790    C--   Copy data from IO buffer.
791    C     Also regrid it to i,j,k indexing.
792          IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
793           DO bj=1,nSy
794            DO bi=1,nSx
795             DO K=1,nZ
796              DO j=1,sNy
797               DO i=1,sNx
798                iP = (bi-1)*sNx+i
799                jP = (bj-1)*sNy+j
800                kP = K
801                iG = myXGlobalLo-1+(bi-1)*sNx+I
802                jG = myYGlobalLo-1+(bj-1)*sNy+J
803                ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
804                fld(i,j,k,bi,bj) = ioBuf_R4(ib)
805               ENDDO
806              ENDDO
807             ENDDO
808            ENDDO
809           ENDDO
810          ELSE
811           DO bj=1,nSy
812            DO bi=1,nSx
813             DO K=1,nZ
814              DO j=1,sNy
815               DO i=1,sNx
816                iP = (bi-1)*sNx+i
817                jP = (bj-1)*sNy+j
818                kP = K
819                iG = myXGlobalLo-1+(bi-1)*sNx+I
820                jG = myYGlobalLo-1+(bj-1)*sNy+J
821                ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
822              fld(i,j,k,bi,bj) = ioBuf_R8(ib)              fld(i,j,k,bi,bj) = ioBuf_R8(ib)
823             ENDDO             ENDDO
824            ENDDO            ENDDO
# Line 478  C     == Local variables == Line 881  C     == Local variables ==
881    
882        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
883        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
884        CALL PRINT_LIST_I( fld, lFld, index_type, standardMessageUnit )        CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
885        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
886        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
887  C  C
# Line 520  C     == Local variables == Line 923  C     == Local variables ==
923    
924        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
925        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
926        CALL PRINT_LIST_L( fld, lFld, index_type, standardMessageUnit )        CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
927        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
928        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
929  C  C
# Line 562  C     == Local variables == Line 965  C     == Local variables ==
965    
966        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
967        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
968        CALL PRINT_LIST_R8( fld, lFld, index_type, standardMessageUnit )        CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
969        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
970        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
971  C  C
# Line 581  C     \================================= Line 984  C     \=================================
984    
985  C     == Global variables ==  C     == Global variables ==
986  #include "SIZE.h"  #include "SIZE.h"
 #include "PARAMS.h"  
987  #include "EEPARAMS.h"  #include "EEPARAMS.h"
988    #include "PARAMS.h"
989  #include "DFILE.h"  #include "DFILE.h"
990            
991        INTEGER  IFNBLNK        INTEGER  IFNBLNK
# Line 642  C          U.p0001.t0001.meta.0000000100 Line 1045  C          U.p0001.t0001.meta.0000000100
1045        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
1046        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
1047        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
1048        WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )        WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A)' )
1049       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1050       & 'p',myProcId,'.t',myThid, '.data.',       & '.p',myProcId,'.t',myThid, '.data'
1051       & suff(s2Lo:s2Hi)        WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A)' )
1052        WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1053       & pref(s1Lo:s1Hi),       & '.p',myProcId,'.t',myThid, '.meta'
      & 'p',myProcId,'.t',myThid, '.meta.',  
      & suff(s2Lo:s2Hi)  
1054    
1055  C--   Open file  C--   Open file
1056        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
# Line 739  C     \================================= Line 1140  C     \=================================
1140    
1141  C     == Global variables ==  C     == Global variables ==
1142  #include "SIZE.h"  #include "SIZE.h"
 #include "PARAMS.h"  
1143  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1144    #include "PARAMS.h"
1145  #include "DFILE.h"  #include "DFILE.h"
1146            
1147        INTEGER  IFNBLNK        INTEGER  IFNBLNK
# Line 800  C          U.p0001.t0001.meta.0000000100 Line 1201  C          U.p0001.t0001.meta.0000000100
1201        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
1202        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
1203        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
1204        WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )        WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A,A)' )
1205       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1206       & 'p',myProcId,'.t',myThid, '.data.',       & '.p',myProcId,'.t',myThid, '.data'
1207       & suff(s2Lo:s2Hi)        WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A,A)' )
1208        WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1209       & pref(s1Lo:s1Hi),       & '.p',myProcId,'.t',myThid, '.meta'
      & 'p',myProcId,'.t',myThid, '.meta.',  
      & suff(s2Lo:s2Hi)  
1210    
1211  C--   Open file  C--   Open file
1212        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
# Line 897  C--   Check errors Line 1296  C--   Check errors
1296  CStartofinterface  CStartofinterface
1297        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )
1298  C     /==========================================================\  C     /==========================================================\
1299  C     | SUBROUTINE WRITE_CHKPT                                   |  C     | SUBROUTINE WRITE_CHECKPOINT                              |
1300  C     | o Controlling routine for IO to write restart file.      |  C     | o Controlling routine for IO to write restart file.      |
1301  C     |==========================================================|  C     |==========================================================|
1302  C     | Write model checkpoint files for use in restart.         |  C     | Write model checkpoint files for use in restart.         |
# Line 1006  C       Raw fields Line 1405  C       Raw fields
1405          CALL WRITE_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)
1406          CALL WRITE_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)
1407          CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)          CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)
1408    #ifdef ALLOW_CD
1409            CALL WRITE_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
1410            CALL WRITE_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
1411            CALL WRITE_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
1412            CALL WRITE_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
1413            CALL WRITE_FLD_XYZ_RL(  'vNM1.', suff,     vNM1, myIter, myThid)
1414            CALL WRITE_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)
1415            CALL WRITE_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)
1416    #endif
1417    
1418    
1419  C--     Reread IO error counter  C--     Reread IO error counter
1420          endIOErrCount = IO_ERRCOUNT(myThid)          endIOErrCount = IO_ERRCOUNT(myThid)
# Line 1038  C        Wrote OK so step forward to use Line 1447  C        Wrote OK so step forward to use
1447        END        END
1448    
1449  CStartofinterface  CStartofinterface
1450        SUBROUTINE WRITE_STATE ( myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime, myIter, myThid )
1451  C     /==========================================================\  C     /==========================================================\
1452  C     | SUBROUTINE WRITE_STATE                                   |  C     | SUBROUTINE WRITE_STATE                                   |
1453  C     | o Controlling routine for IO to dump model state.        |  C     | o Controlling routine for IO to dump model state.        |
# Line 1063  C     == Routine arguments == Line 1472  C     == Routine arguments ==
1472  C     myThid - Thread number for this instance of the routine.  C     myThid - Thread number for this instance of the routine.
1473  C     myIter - Iteration number  C     myIter - Iteration number
1474  C     myCurrentTime - Current time of simulation ( s )  C     myCurrentTime - Current time of simulation ( s )
1475          LOGICAL forceOutput
1476          REAL    myCurrentTime
1477        INTEGER myThid        INTEGER myThid
1478        INTEGER myIter        INTEGER myIter
       REAL    myCurrentTime  
1479  CEndofinterface  CEndofinterface
1480    
1481  C     == Local variables ==  C     == Local variables ==
# Line 1078  C     msgBuf - Error message buffer Line 1488  C     msgBuf - Error message buffer
1488        INTEGER endIOErrCount        INTEGER endIOErrCount
1489        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1490    
1491        IF ( .NOT.        IF (
1492       &  DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)       &  DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)
1493       & ) RETURN       &  .OR. forceOutput
1494         & ) THEN
1495    
1496  C--    Going to really do some IO. Make everyone except master thread wait.  C--    Going to really do some IO. Make everyone except master thread wait.
1497         _BARRIER         _BARRIER
# Line 1135  C--     Check for IO errors Line 1546  C--     Check for IO errors
1546         _END_MASTER( myThid )         _END_MASTER( myThid )
1547         _BARRIER         _BARRIER
1548    
1549          ENDIF
1550    
1551        RETURN        RETURN
1552        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22