/[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.7 by adcroft, Mon Jun 22 15:26:26 1998 UTC revision 1.13 by cnh, Fri Nov 6 22:44:48 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 13  C--   o WRITE_1D_R8 - Write list of real Line 13  C--   o WRITE_1D_R8 - Write list of real
13  C--                   Uses MITgcmUV environment file format.  C--                   Uses MITgcmUV environment file format.
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.
 C--   o WRITE_CHECKPOINT - Write out checkpoint files for restarting.  
16  C--   o WRITE_STATE - Write out model state.  C--   o WRITE_STATE - Write out model state.
17    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  #ifdef INCLUDE_CD_CODE
91          CALL READ_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)          CALL READ_FLD_XY_RL
92         &   ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
93          CALL READ_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
94          CALL READ_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
95          CALL READ_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
# Line 108  C--     Check for IO errors Line 111  C--     Check for IO errors
111           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
112           STOP 'ABNORMAL END: S/R READ_CHECKPOINT'           STOP 'ABNORMAL END: S/R READ_CHECKPOINT'
113          ELSE          ELSE
114           WRITE(msgBuf,'(A,I10)')  '// Model checkpoint read, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
115           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model checkpoint read, timestep', myIter
116             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
117         &    SQUEEZE_RIGHT, 1 )
118           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
119           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120         &    SQUEEZE_RIGHT, 1 )
121          ENDIF          ENDIF
122    
123    C       Resotre default IO precision
124            readBinaryPrec = oldPrec
125    
126         _END_MASTER( myThid )         _END_MASTER( myThid )
127         _BARRIER         _BARRIER
128    
# Line 131  C--    Fill in edge regions Line 140  C--    Fill in edge regions
140        _EXCH_XYZ_R8(gs    , myThid )        _EXCH_XYZ_R8(gs    , myThid )
141        _EXCH_XYZ_R8(gsNM1 , myThid )        _EXCH_XYZ_R8(gsNM1 , myThid )
142        _EXCH_XY_R8 (cg2d_x, myThid )        _EXCH_XY_R8 (cg2d_x, myThid )
143    #ifdef INCLUDE_CD_CODE
144          _EXCH_XY_R8( cg2d_xNM1, myThid )
145          _EXCH_XYZ_R8( uVelD,    myThid )
146          _EXCH_XYZ_R8( vVelD,    myThid )
147          _EXCH_XYZ_R8( uNM1,     myThid )
148          _EXCH_XYZ_R8( vNM1,     myThid )
149          _EXCH_XYZ_R8( guCD,     myThid )
150          _EXCH_XYZ_R8( gvCD,     myThid )
151    #endif
152    
153        RETURN        RETURN
154        END        END
# Line 213  C          U.0000000100 Line 231  C          U.0000000100
231       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
232         WRITE( fNamMeta, '(A)' )         WRITE( fNamMeta, '(A)' )
233       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
234           s2Lo = 1
235           s2Hi = 1
236        ELSE        ELSE
237         WRITE( fNamData, '(A,A)' )         WRITE( fNamData, '(A,A)' )
238       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
# Line 223  C          U.0000000100 Line 243  C          U.0000000100
243        ENDIF        ENDIF
244    
245  C--   Open file  C--   Open file
246          CALL DFILE_SET_RO
247        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
248       O                 fileHandle )       O                 fileHandle )
249        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 289  C--   Check errors Line 310  C--   Check errors
310        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
311         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
312       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
313         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
314         &    SQUEEZE_RIGHT, 1 )
315        ELSE        ELSE
316         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
317         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
318         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
319        ENDIF        ENDIF
320    
# Line 378  C          U.0000000100 Line 401  C          U.0000000100
401       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
402         WRITE( fNamMeta, '(A)' )         WRITE( fNamMeta, '(A)' )
403       & suff(s2Lo:s2Hi)       & suff(s2Lo:s2Hi)
404           s1Lo = 1
405           s1Hi = 1
406        ELSEIF ( suff .EQ. ' ' ) THEN        ELSEIF ( suff .EQ. ' ' ) THEN
407         WRITE( fNamData, '(A)' )         WRITE( fNamData, '(A)' )
408       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
409         WRITE( fNamMeta, '(A)' )         WRITE( fNamMeta, '(A)' )
410       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
411         s2Lo=1         s2Lo = 1
412         s2Hi=1         s2Hi = 1
413        ELSE        ELSE
414         WRITE( fNamData, '(A,A)' )         WRITE( fNamData, '(A,A)' )
415       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
# Line 395  C          U.0000000100 Line 420  C          U.0000000100
420        ENDIF        ENDIF
421    
422  C--   Open file  C--   Open file
423          CALL DFILE_SET_RO
424        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
425       O                 fileHandle )       O                 fileHandle )
426        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 461  C--   Check errors Line 487  C--   Check errors
487        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
488         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
489       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
490         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
491         &    SQUEEZE_RIGHT, 1 )
492        ELSE        ELSE
493         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
494         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
495         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
496        ENDIF        ENDIF
497    
# Line 504  C     myIter - Timestep number Line 532  C     myIter - Timestep number
532  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
533        CHARACTER*(*) pref        CHARACTER*(*) pref
534        CHARACTER*(*) suff        CHARACTER*(*) suff
535        _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)        _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
536        INTEGER myIter        INTEGER myIter
537        INTEGER myThid        INTEGER myThid
538    
# Line 550  C          U.0000000100 Line 578  C          U.0000000100
578       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
579         WRITE( fNamMeta, '(A)' )         WRITE( fNamMeta, '(A)' )
580       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
581           s2Lo = 1
582           s2Hi = 1
583        ELSE        ELSE
584         WRITE( fNamData, '(A,A)' )         WRITE( fNamData, '(A,A)' )
585       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
# Line 560  C          U.0000000100 Line 590  C          U.0000000100
590        ENDIF        ENDIF
591    
592  C--   Open file  C--   Open file
593          CALL DFILE_SET_RO
594        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
595       O                 fileHandle )       O                 fileHandle )
596        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 567  C--   Open file Line 598  C--   Open file
598  C--   Set local and global data extents  C--   Set local and global data extents
599        nXP=sNx*nSx        nXP=sNx*nSx
600        nYP=sNy*nSy        nYP=sNy*nSy
601        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * Nr
602        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
603        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
604        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
605        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
606        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
607        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
608        dimList(7) = nZ        dimList(7) = Nr
609        dimList(8) = 1        dimList(8) = 1
610        dimList(9) = nZ        dimList(9) = Nr
611    
612  C--   Read data  C--   Read data
613        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
# Line 592  C     Also regrid it to i,j,k indexing. Line 623  C     Also regrid it to i,j,k indexing.
623        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
624         DO bj=1,nSy         DO bj=1,nSy
625          DO bi=1,nSx          DO bi=1,nSx
626           DO K=1,nZ           DO K=1,Nr
627            DO j=1,sNy            DO j=1,sNy
628             DO i=1,sNx             DO i=1,sNx
629              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 610  C     Also regrid it to i,j,k indexing. Line 641  C     Also regrid it to i,j,k indexing.
641        ELSE        ELSE
642         DO bj=1,nSy         DO bj=1,nSy
643          DO bi=1,nSx          DO bi=1,nSx
644           DO K=1,nZ           DO K=1,Nr
645            DO j=1,sNy            DO j=1,sNy
646             DO i=1,sNx             DO i=1,sNx
647              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 635  C--   Check errors Line 666  C--   Check errors
666        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
667         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
668       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
669         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
670         &    SQUEEZE_RIGHT, 1 )
671        ELSE        ELSE
672         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
673         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
674         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
675        ENDIF        ENDIF
676    
# Line 678  C     myIter - Timestep number Line 711  C     myIter - Timestep number
711  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
712        CHARACTER*(*) pref        CHARACTER*(*) pref
713        CHARACTER*(*) suff        CHARACTER*(*) suff
714        _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)        _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
715        INTEGER myIter        INTEGER myIter
716        INTEGER myThid        INTEGER myThid
717    
# Line 724  C          U.0000000100 Line 757  C          U.0000000100
757       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
758         WRITE( fNamMeta, '(A)' )         WRITE( fNamMeta, '(A)' )
759       & pref(s1Lo:s1Hi)       & pref(s1Lo:s1Hi)
760           s2Lo = 1
761           s2Hi = 1
762        ELSE        ELSE
763         WRITE( fNamData, '(A,A)' )         WRITE( fNamData, '(A,A)' )
764       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),
# Line 734  C          U.0000000100 Line 769  C          U.0000000100
769        ENDIF        ENDIF
770                
771  C--   Open file  C--   Open file
772          CALL DFILE_SET_RO
773        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
774       O                 fileHandle )       O                 fileHandle )
775        IF ( fileHandle .LE. 0 ) GOTO 1000        IF ( fileHandle .LE. 0 ) GOTO 1000
# Line 741  C--   Open file Line 777  C--   Open file
777  C--   Set local and global data extents  C--   Set local and global data extents
778        nXP=sNx*nSx        nXP=sNx*nSx
779        nYP=sNy*nSy        nYP=sNy*nSy
780        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * Nr
781        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
782        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
783        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
784        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
785        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
786        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
787        dimList(7) = nZ        dimList(7) = Nr
788        dimList(8) = 1        dimList(8) = 1
789        dimList(9) = nZ        dimList(9) = Nr
790    
791  C--   Read data  C--   Read data
792        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
# Line 766  C     Also regrid it to i,j,k indexing. Line 802  C     Also regrid it to i,j,k indexing.
802        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
803         DO bj=1,nSy         DO bj=1,nSy
804          DO bi=1,nSx          DO bi=1,nSx
805           DO K=1,nZ           DO K=1,Nr
806            DO j=1,sNy            DO j=1,sNy
807             DO i=1,sNx             DO i=1,sNx
808              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 784  C     Also regrid it to i,j,k indexing. Line 820  C     Also regrid it to i,j,k indexing.
820        ELSE        ELSE
821         DO bj=1,nSy         DO bj=1,nSy
822          DO bi=1,nSx          DO bi=1,nSx
823           DO K=1,nZ           DO K=1,Nr
824            DO j=1,sNy            DO j=1,sNy
825             DO i=1,sNx             DO i=1,sNx
826              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 809  C--   Check errors Line 845  C--   Check errors
845        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
846         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
847       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
848         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
849         &    SQUEEZE_RIGHT, 1 )
850        ELSE        ELSE
851         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
852         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
853         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
854        ENDIF        ENDIF
855    
# Line 854  C     == Local variables == Line 892  C     == Local variables ==
892        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
893    
894        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
895        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
896        CALL PRINT_LIST_I( fld, lFld, index_type, standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
897          CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE.,
898         &    .TRUE., standardMessageUnit )
899        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
900        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
901         &    SQUEEZE_RIGHT , 1)
902  C  C
903        RETURN        RETURN
904        END        END
# Line 896  C     == Local variables == Line 937  C     == Local variables ==
937        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
938    
939        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
940        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
941        CALL PRINT_LIST_L( fld, lFld, index_type, standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
942          CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE.,
943         &    .TRUE., standardMessageUnit )
944        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
945        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
946         &    SQUEEZE_RIGHT , 1)
947  C  C
948        RETURN        RETURN
949        END        END
# Line 938  C     == Local variables == Line 982  C     == Local variables ==
982        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
983    
984        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
985        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
986        CALL PRINT_LIST_R8( fld, lFld, index_type, standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
987          CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE.,
988         &    .TRUE., standardMessageUnit )
989        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
990        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
991         &    SQUEEZE_RIGHT , 1)
992  C  C
993        RETURN        RETURN
994        END        END
# Line 1019  C          U.p0001.t0001.meta.0000000100 Line 1066  C          U.p0001.t0001.meta.0000000100
1066        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
1067        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
1068        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
1069        WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )        WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A)' )
1070       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1071       & 'p',myProcId,'.t',myThid, '.data.',       & '.p',myProcId,'.t',myThid, '.data'
1072       & suff(s2Lo:s2Hi)        WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A)' )
1073        WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1074       & pref(s1Lo:s1Hi),       & '.p',myProcId,'.t',myThid, '.meta'
      & 'p',myProcId,'.t',myThid, '.meta.',  
      & suff(s2Lo:s2Hi)  
1075    
1076  C--   Open file  C--   Open file
1077        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
# Line 1093  C--   Check errors Line 1138  C--   Check errors
1138        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1139         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',
1140       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1141         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1142         &    SQUEEZE_RIGHT, 1 )
1143        ELSE        ELSE
1144         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',
1145         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1146         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
1147        ENDIF        ENDIF
1148    
# Line 1136  C     myIter - Timestep number Line 1183  C     myIter - Timestep number
1183  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
1184        CHARACTER*(*) pref        CHARACTER*(*) pref
1185        CHARACTER*(*) suff        CHARACTER*(*) suff
1186        _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nz,nSx,nSy)        _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
1187        INTEGER myThid        INTEGER myThid
1188        INTEGER myIter        INTEGER myIter
1189    
# Line 1177  C          U.p0001.t0001.meta.0000000100 Line 1224  C          U.p0001.t0001.meta.0000000100
1224        s1Hi = ILNBLNK(pref)        s1Hi = ILNBLNK(pref)
1225        s2Lo = IFNBLNK(suff)        s2Lo = IFNBLNK(suff)
1226        s2Hi = ILNBLNK(suff)        s2Hi = ILNBLNK(suff)
1227        WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )        WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A,A)' )
1228       & pref(s1Lo:s1Hi),       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1229       & 'p',myProcId,'.t',myThid, '.data.',       & '.p',myProcId,'.t',myThid, '.data'
1230       & suff(s2Lo:s2Hi)        WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A,A)' )
1231        WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )       & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1232       & pref(s1Lo:s1Hi),       & '.p',myProcId,'.t',myThid, '.meta'
      & 'p',myProcId,'.t',myThid, '.meta.',  
      & suff(s2Lo:s2Hi)  
1233    
1234  C--   Open file  C--   Open file
1235        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,        CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
# Line 1195  C--   Copy data to IO buffer. Line 1240  C--   Copy data to IO buffer.
1240  C     Also regrid it to i,j,k indexing.  C     Also regrid it to i,j,k indexing.
1241        nXP=sNx*nSx        nXP=sNx*nSx
1242        nYP=sNy*nSy        nYP=sNy*nSy
1243        lFilled = sNx*nSx * sNy*nSy * Nz        lFilled = sNx*nSx * sNy*nSy * Nr
1244        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN
1245         DO bj=1,nSy         DO bj=1,nSy
1246          DO bi=1,nSx          DO bi=1,nSx
1247           DO k=1,Nz           DO k=1,Nr
1248            DO j=1,sNy            DO j=1,sNy
1249             DO i=1,sNx             DO i=1,sNx
1250              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 1215  C     Also regrid it to i,j,k indexing. Line 1260  C     Also regrid it to i,j,k indexing.
1260        ELSE        ELSE
1261         DO bj=1,nSy         DO bj=1,nSy
1262          DO bi=1,nSx          DO bi=1,nSx
1263           DO k=1,Nz           DO k=1,Nr
1264            DO j=1,sNy            DO j=1,sNy
1265             DO i=1,sNx             DO i=1,sNx
1266              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 1237  C--   Set local and global data extents Line 1282  C--   Set local and global data extents
1282        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
1283        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
1284        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
1285        dimList(7) = nZ        dimList(7) = Nr
1286        dimList(8) = 1        dimList(8) = 1
1287        dimList(9) = nZ        dimList(9) = Nr
1288    
1289  C--   Write data  C--   Write data
1290        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN
# Line 1260  C--   Check errors Line 1305  C--   Check errors
1305        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1306         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',
1307       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1308         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1309         &    SQUEEZE_RIGHT, 1 )
1310        ELSE        ELSE
1311         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',
1312         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1313         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
1314        ENDIF        ENDIF
1315    
# Line 1272  C--   Check errors Line 1319  C--   Check errors
1319        END        END
1320    
1321  CStartofinterface  CStartofinterface
1322        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime,
1323         &                              myIter, myThid )
1324  C     /==========================================================\  C     /==========================================================\
1325  C     | SUBROUTINE WRITE_CHECKPOINT                              |  C     | SUBROUTINE WRITE_CHECKPOINT                              |
1326  C     | o Controlling routine for IO to write restart file.      |  C     | o Controlling routine for IO to write restart file.      |
# Line 1329  C                      be written. Line 1377  C                      be written.
1377    
1378        permCheckPoint = .FALSE.        permCheckPoint = .FALSE.
1379        permCheckPoint=        permCheckPoint=
1380       & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,
1381         &                    myCurrentTime-deltaTClock)
1382    
1383        IF (        IF (
1384       &    (.NOT. modelEnd .AND. (       &    (.NOT. modelEnd .AND. (
1385       &     permCheckPoint       &     permCheckPoint
1386       &     .OR.       &     .OR.
1387       &     DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       &     DIFFERENT_MULTIPLE(chkptFreq,
1388         &    myCurrentTime,myCurrentTime-deltaTClock)
1389       &     )       &     )
1390       &    )       &    )
1391       &     .OR.       &     .OR.
# Line 1344  C                      be written. Line 1394  C                      be written.
1394       &     .AND. .NOT.       &     .AND. .NOT.
1395       &     permCheckPoint       &     permCheckPoint
1396       &     .AND. .NOT.       &     .AND. .NOT.
1397       &     DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       &     DIFFERENT_MULTIPLE(chkptFreq,
1398         &    myCurrentTime,myCurrentTime-deltaTClock)
1399       &    )       &    )
1400       & ) THEN       & ) THEN
1401    
# Line 1370  C--     Read IO error counter Line 1421  C--     Read IO error counter
1421    
1422  C--     Write model fields  C--     Write model fields
1423  C       Raw fields  C       Raw fields
1424          CALL WRITE_FLD_XYZ_RL(   'uVel.',suff,      uVel, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1425          CALL WRITE_FLD_XYZ_RL(     'gU.',suff,        gU, myIter, myThid)       &    (   'uVel.',suff,      uVel, myIter, myThid)
1426          CALL WRITE_FLD_XYZ_RL(  'gUNm1.',suff,     gUNm1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1427          CALL WRITE_FLD_XYZ_RL(   'vVel.',suff,      vVel, myIter, myThid)       &    (     'gU.',suff,        gU, myIter, myThid)
1428          CALL WRITE_FLD_XYZ_RL(     'gV.',suff,        gV, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1429          CALL WRITE_FLD_XYZ_RL(  'gVNm1.',suff,     gVNm1, myIter, myThid)       &    (  'gUNm1.',suff,     gUNm1, myIter, myThid)
1430          CALL WRITE_FLD_XYZ_RL(  'theta.',suff,     theta, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1431          CALL WRITE_FLD_XYZ_RL(     'gT.',suff,        gT, myIter, myThid)       &    (   'vVel.',suff,      vVel, myIter, myThid)
1432          CALL WRITE_FLD_XYZ_RL(  'gTNm1.',suff,     gTNm1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1433          CALL WRITE_FLD_XYZ_RL(   'salt.',suff,      salt, myIter, myThid)       &    (     'gV.',suff,        gV, myIter, myThid)
1434          CALL WRITE_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1435          CALL WRITE_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)       &    (  'gVNm1.',suff,     gVNm1, myIter, myThid)
1436          CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1437  #ifdef ALLOW_CD       &    (  'theta.',suff,     theta, myIter, myThid)
1438          CALL WRITE_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1439         &    (     'gT.',suff,        gT, myIter, myThid)
1440            CALL WRITE_FLD_XYZ_RL
1441         &    (  'gTNm1.',suff,     gTNm1, myIter, myThid)
1442            CALL WRITE_FLD_XYZ_RL
1443         &    (   'salt.',suff,      salt, myIter, myThid)
1444            CALL WRITE_FLD_XYZ_RL
1445         &    (     'gS.',suff,        gS, myIter, myThid)
1446            CALL WRITE_FLD_XYZ_RL
1447         &    (  'gSNm1.',suff,     gSNm1, myIter, myThid)
1448            CALL WRITE_FLD_XY_RL
1449         &    ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)
1450    #ifdef INCLUDE_CD_CODE
1451            CALL WRITE_FLD_XY_RL
1452         &    ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
1453          CALL WRITE_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
1454          CALL WRITE_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
1455          CALL WRITE_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
# Line 1406  C--     Check for IO errors Line 1471  C--     Check for IO errors
1471           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1472           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
1473          ELSE          ELSE
1474           WRITE(msgBuf,'(A,I10)')  '// Model checkpoint written, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
1475           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model checkpoint written, timestep', myIter
1476             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1477         &    SQUEEZE_RIGHT, 1 )
1478           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
1479           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1480         &    SQUEEZE_RIGHT, 1 )
1481  C        Wrote OK so step forward to use next checkpoint in loop.  C        Wrote OK so step forward to use next checkpoint in loop.
1482           IF ( .NOT. permCheckPoint ) THEN           IF ( .NOT. permCheckPoint ) THEN
1483            nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1            nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
# Line 1425  C        Wrote OK so step forward to use Line 1493  C        Wrote OK so step forward to use
1493        END        END
1494    
1495  CStartofinterface  CStartofinterface
1496        SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime,
1497         &    myIter, myThid )
1498  C     /==========================================================\  C     /==========================================================\
1499  C     | SUBROUTINE WRITE_STATE                                   |  C     | SUBROUTINE WRITE_STATE                                   |
1500  C     | o Controlling routine for IO to dump model state.        |  C     | o Controlling routine for IO to dump model state.        |
# Line 1451  C     myThid - Thread number for this in Line 1520  C     myThid - Thread number for this in
1520  C     myIter - Iteration number  C     myIter - Iteration number
1521  C     myCurrentTime - Current time of simulation ( s )  C     myCurrentTime - Current time of simulation ( s )
1522        LOGICAL forceOutput        LOGICAL forceOutput
1523          REAL    myCurrentTime
1524        INTEGER myThid        INTEGER myThid
1525        INTEGER myIter        INTEGER myIter
       REAL    myCurrentTime  
1526  CEndofinterface  CEndofinterface
1527    
1528  C     == Local variables ==  C     == Local variables ==
# Line 1467  C     msgBuf - Error message buffer Line 1536  C     msgBuf - Error message buffer
1536        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1537    
1538        IF (        IF (
1539       &  DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)       &  DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,
1540         &    myCurrentTime-deltaTClock)
1541       &  .OR. forceOutput       &  .OR. forceOutput
1542       & ) THEN       & ) THEN
1543    
# Line 1515  C--     Check for IO errors Line 1585  C--     Check for IO errors
1585           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1586           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
1587          ELSE          ELSE
1588           WRITE(msgBuf,'(A,I10)')  '// Model state written, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
1589           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model state written, timestep', myIter
1590             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1591         &    SQUEEZE_RIGHT, 1 )
1592           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
1593           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1594         &    SQUEEZE_RIGHT, 1 )
1595          ENDIF          ENDIF
1596    
1597         _END_MASTER( myThid )         _END_MASTER( myThid )
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22