/[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.9 by cnh, Mon Jun 29 14:04:32 1998 UTC revision 1.16 by adcroft, Mon Mar 22 15:54:04 1999 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 24  C     | o Controlling routine for IO to Line 24  C     | o Controlling routine for IO to
24  C     |==========================================================|  C     |==========================================================|
25  C     | Read model checkpoint files for use in restart.          |  C     | Read model checkpoint files for use in restart.          |
26  C     \==========================================================/  C     \==========================================================/
27          IMPLICIT NONE
28    
29  C     == Global variables ===  C     == Global variables ===
30  #include "SIZE.h"  #include "SIZE.h"
# Line 31  C     == Global variables === Line 32  C     == Global variables ===
32  #include "PARAMS.h"  #include "PARAMS.h"
33  #include "DYNVARS.h"  #include "DYNVARS.h"
34  #include "CG2D.h"  #include "CG2D.h"
35    #ifdef ALLOW_NONHYDROSTATIC
36    #include "GW.h"
37    #endif
38    
39        INTEGER  IO_ERRCOUNT        INTEGER  IO_ERRCOUNT
40        EXTERNAL IO_ERRCOUNT        EXTERNAL IO_ERRCOUNT
# Line 52  C     msgBuf - Error message buffer Line 56  C     msgBuf - Error message buffer
56        INTEGER endIOErrCount        INTEGER endIOErrCount
57        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
58        LOGICAL permCheckPoint          LOGICAL permCheckPoint  
59          INTEGER oldPrec
60    
61  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.
62         _BARRIER         _BARRIER
# Line 64  C--     Set IO "context" for reading sta Line 69  C--     Set IO "context" for reading sta
69          CALL DFILE_SET_RO          CALL DFILE_SET_RO
70          CALL DFILE_SET_CONT_ON_ERROR          CALL DFILE_SET_CONT_ON_ERROR
71  C       Force 64-bit IO  C       Force 64-bit IO
72            oldPrec        = readBinaryPrec
73          readBinaryPrec = precFloat64          readBinaryPrec = precFloat64
74    
75    
# Line 85  C       Raw fields Line 91  C       Raw fields
91          CALL READ_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)          CALL READ_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)
92          CALL READ_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)
93          CALL READ_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)          CALL READ_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)
94  #ifdef ALLOW_CD  #ifdef INCLUDE_CD_CODE
95          CALL READ_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)          CALL READ_FLD_XY_RL
96         &   ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
97          CALL READ_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
98          CALL READ_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
99          CALL READ_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
# Line 94  C       Raw fields Line 101  C       Raw fields
101          CALL READ_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)
102          CALL READ_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)          CALL READ_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)
103  #endif  #endif
104    #ifdef ALLOW_NONHYDROSTATIC
105            IF ( nonHydrostatic ) THEN
106             CALL READ_FLD_XYZ_RL(   'wVel.',suff,      wVel, myIter, myThid)
107             CALL READ_FLD_XYZ_RL(     'gW.',suff,        gW, myIter, myThid)
108             CALL READ_FLD_XYZ_RL(  'gWNm1.',suff,     gWNm1, myIter, myThid)
109            ENDIF
110    #endif
111  C--     Reread IO error counter  C--     Reread IO error counter
112          endIOErrCount = IO_ERRCOUNT(myThid)          endIOErrCount = IO_ERRCOUNT(myThid)
113    
# Line 108  C--     Check for IO errors Line 121  C--     Check for IO errors
121           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
122           STOP 'ABNORMAL END: S/R READ_CHECKPOINT'           STOP 'ABNORMAL END: S/R READ_CHECKPOINT'
123          ELSE          ELSE
124           WRITE(msgBuf,'(A,I10)')  '// Model checkpoint read, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
125           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model checkpoint read, timestep', myIter
126             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
127         &    SQUEEZE_RIGHT, 1 )
128           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
129           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
130         &    SQUEEZE_RIGHT, 1 )
131          ENDIF          ENDIF
132    
133    C       Reset default IO precision
134            readBinaryPrec = oldPrec
135    
136         _END_MASTER( myThid )         _END_MASTER( myThid )
137         _BARRIER         _BARRIER
138    
# Line 131  C--    Fill in edge regions Line 150  C--    Fill in edge regions
150        _EXCH_XYZ_R8(gs    , myThid )        _EXCH_XYZ_R8(gs    , myThid )
151        _EXCH_XYZ_R8(gsNM1 , myThid )        _EXCH_XYZ_R8(gsNM1 , myThid )
152        _EXCH_XY_R8 (cg2d_x, myThid )        _EXCH_XY_R8 (cg2d_x, myThid )
153    #ifdef INCLUDE_CD_CODE
154          _EXCH_XY_R8( cg2d_xNM1, myThid )
155          _EXCH_XYZ_R8( uVelD,    myThid )
156          _EXCH_XYZ_R8( vVelD,    myThid )
157          _EXCH_XYZ_R8( uNM1,     myThid )
158          _EXCH_XYZ_R8( vNM1,     myThid )
159          _EXCH_XYZ_R8( guCD,     myThid )
160          _EXCH_XYZ_R8( gvCD,     myThid )
161    #endif
162    #ifdef ALLOW_NONHYDROSTATIC
163            IF ( nonHydrostatic ) THEN
164             _EXCH_XYZ_R8(wVel  , myThid )
165             _EXCH_XYZ_R8(gW    , myThid )
166             _EXCH_XYZ_R8(gWNM1 , myThid )
167            ENDIF
168    #endif
169    
170        RETURN        RETURN
171        END        END
# Line 144  C     |================================= Line 179  C     |=================================
179  C     | Call low-level routines to read a 2d model field.        |  C     | Call low-level routines to read a 2d model field.        |
180  C     | Handles _RL type data ( generally _RL == REAL*8 )        |  C     | Handles _RL type data ( generally _RL == REAL*8 )        |
181  C     \==========================================================/  C     \==========================================================/
182          IMPLICIT NONE
183    
184  C     == Global variables ==  C     == Global variables ==
185  #include "SIZE.h"  #include "SIZE.h"
# Line 245  C--   Read data Line 281  C--   Read data
281        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
282         CALL DFILE_READ_R4( lFilled,         CALL DFILE_READ_R4( lFilled,
283       I                      fileHandle, myThid )       I                      fileHandle, myThid )
284        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
285         CALL DFILE_READ_R8( lFilled,         CALL DFILE_READ_R8( lFilled,
286       I                      fileHandle, myThid )       I                      fileHandle, myThid )
287          ELSE
288           STOP 'READ_FLD_XY_RL: Bad value for readBinaryPrec'
289        ENDIF        ENDIF
290    
291  C--   Copy data from IO buffer.  C--   Copy data from IO buffer.
# Line 267  C     Also regrid it to i,j,k indexing. Line 305  C     Also regrid it to i,j,k indexing.
305           ENDDO           ENDDO
306          ENDDO          ENDDO
307         ENDDO         ENDDO
308        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
309         DO bj=1,nSy         DO bj=1,nSy
310          DO bi=1,nSx          DO bi=1,nSx
311           DO j=1,sNy           DO j=1,sNy
# Line 292  C--   Check errors Line 330  C--   Check errors
330        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
331         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
332       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
333         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
334         &    SQUEEZE_RIGHT, 1 )
335        ELSE        ELSE
336         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
337         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
338         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
339        ENDIF        ENDIF
340    
# Line 312  C     |================================= Line 352  C     |=================================
352  C     | Call low-level routines to read a 2d model field.        |  C     | Call low-level routines to read a 2d model field.        |
353  C     | Handles _RS type data ( generally _RS == REAL*4 )        |  C     | Handles _RS type data ( generally _RS == REAL*4 )        |
354  C     \==========================================================/  C     \==========================================================/
355          IMPLICIT NONE
356    
357  C     == Global variables ==  C     == Global variables ==
358  #include "SIZE.h"  #include "SIZE.h"
# Line 420  C--   Read data Line 461  C--   Read data
461        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
462         CALL DFILE_READ_R4( lFilled,         CALL DFILE_READ_R4( lFilled,
463       I                      fileHandle, myThid )       I                      fileHandle, myThid )
464        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
465         CALL DFILE_READ_R8( lFilled,         CALL DFILE_READ_R8( lFilled,
466       I                      fileHandle, myThid )       I                      fileHandle, myThid )
467          ELSE
468           STOP 'READ_FLD_XY_RS: Bad value for readBinaryPrec'
469        ENDIF        ENDIF
470    
471  C--   Copy data from IO buffer.  C--   Copy data from IO buffer.
# Line 442  C     Also regrid it to i,j,k indexing. Line 485  C     Also regrid it to i,j,k indexing.
485           ENDDO           ENDDO
486          ENDDO          ENDDO
487         ENDDO         ENDDO
488        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
489         DO bj=1,nSy         DO bj=1,nSy
490          DO bi=1,nSx          DO bi=1,nSx
491           DO j=1,sNy           DO j=1,sNy
# Line 467  C--   Check errors Line 510  C--   Check errors
510        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
511         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
512       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
513         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
514         &    SQUEEZE_RIGHT, 1 )
515        ELSE        ELSE
516         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
517         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
518         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
519        ENDIF        ENDIF
520    
# Line 487  C     |================================= Line 532  C     |=================================
532  C     | Call low-level routines to read a 3d model field.        |  C     | Call low-level routines to read a 3d model field.        |
533  C     | Handles _RL type data ( generally _RL == REAL*8 )        |  C     | Handles _RL type data ( generally _RL == REAL*8 )        |
534  C     \==========================================================/  C     \==========================================================/
535          IMPLICIT NONE
536    
537  C     == Global variables ==  C     == Global variables ==
538  #include "SIZE.h"  #include "SIZE.h"
# Line 510  C     myIter - Timestep number Line 556  C     myIter - Timestep number
556  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
557        CHARACTER*(*) pref        CHARACTER*(*) pref
558        CHARACTER*(*) suff        CHARACTER*(*) suff
559        _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)
560        INTEGER myIter        INTEGER myIter
561        INTEGER myThid        INTEGER myThid
562    
# Line 576  C--   Open file Line 622  C--   Open file
622  C--   Set local and global data extents  C--   Set local and global data extents
623        nXP=sNx*nSx        nXP=sNx*nSx
624        nYP=sNy*nSy        nYP=sNy*nSy
625        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * Nr
626        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
627        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
628        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
629        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
630        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
631        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
632        dimList(7) = nZ        dimList(7) = Nr
633        dimList(8) = 1        dimList(8) = 1
634        dimList(9) = nZ        dimList(9) = Nr
635    
636  C--   Read data  C--   Read data
637        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
638         CALL DFILE_READ_R4( lFilled,         CALL DFILE_READ_R4( lFilled,
639       I                      fileHandle, myThid )       I                      fileHandle, myThid )
640        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
641         CALL DFILE_READ_R8( lFilled,         CALL DFILE_READ_R8( lFilled,
642       I                      fileHandle, myThid )       I                      fileHandle, myThid )
643          ELSE
644           STOP 'READ_FLD_XYZ_RL: Bad value for readBinaryPrec'
645        ENDIF        ENDIF
646    
647  C--   Copy data from IO buffer.  C--   Copy data from IO buffer.
# Line 601  C     Also regrid it to i,j,k indexing. Line 649  C     Also regrid it to i,j,k indexing.
649        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
650         DO bj=1,nSy         DO bj=1,nSy
651          DO bi=1,nSx          DO bi=1,nSx
652           DO K=1,nZ           DO K=1,Nr
653            DO j=1,sNy            DO j=1,sNy
654             DO i=1,sNx             DO i=1,sNx
655              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 616  C     Also regrid it to i,j,k indexing. Line 664  C     Also regrid it to i,j,k indexing.
664           ENDDO           ENDDO
665          ENDDO          ENDDO
666         ENDDO         ENDDO
667        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
668         DO bj=1,nSy         DO bj=1,nSy
669          DO bi=1,nSx          DO bi=1,nSx
670           DO K=1,nZ           DO K=1,Nr
671            DO j=1,sNy            DO j=1,sNy
672             DO i=1,sNx             DO i=1,sNx
673              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 644  C--   Check errors Line 692  C--   Check errors
692        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
693         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
694       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
695         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
696         &    SQUEEZE_RIGHT, 1 )
697        ELSE        ELSE
698         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
699         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
700         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
701        ENDIF        ENDIF
702    
# Line 664  C     |================================= Line 714  C     |=================================
714  C     | Call low-level routines to read a 3d model field.        |  C     | Call low-level routines to read a 3d model field.        |
715  C     | Handles _RS type data ( generally _RS == REAL*4 )        |  C     | Handles _RS type data ( generally _RS == REAL*4 )        |
716  C     \==========================================================/  C     \==========================================================/
717          IMPLICIT NONE
718    
719  C     == Global variables ==  C     == Global variables ==
720  #include "SIZE.h"  #include "SIZE.h"
# Line 687  C     myIter - Timestep number Line 738  C     myIter - Timestep number
738  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
739        CHARACTER*(*) pref        CHARACTER*(*) pref
740        CHARACTER*(*) suff        CHARACTER*(*) suff
741        _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)
742        INTEGER myIter        INTEGER myIter
743        INTEGER myThid        INTEGER myThid
744    
# Line 753  C--   Open file Line 804  C--   Open file
804  C--   Set local and global data extents  C--   Set local and global data extents
805        nXP=sNx*nSx        nXP=sNx*nSx
806        nYP=sNy*nSy        nYP=sNy*nSy
807        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ        lFilled = sNx*nSx*nPx * sNy*nSy*nPy * Nr
808        dimList(1) = nXP*nPx        dimList(1) = nXP*nPx
809        dimList(2) = myXGlobalLo        dimList(2) = myXGlobalLo
810        dimList(3) = myXGlobalLo+nXP-1        dimList(3) = myXGlobalLo+nXP-1
811        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
812        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
813        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
814        dimList(7) = nZ        dimList(7) = Nr
815        dimList(8) = 1        dimList(8) = 1
816        dimList(9) = nZ        dimList(9) = Nr
817    
818  C--   Read data  C--   Read data
819        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
820         CALL DFILE_READ_R4( lFilled,         CALL DFILE_READ_R4( lFilled,
821       I                      fileHandle, myThid )       I                      fileHandle, myThid )
822        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
823         CALL DFILE_READ_R8( lFilled,         CALL DFILE_READ_R8( lFilled,
824       I                      fileHandle, myThid )       I                      fileHandle, myThid )
825          ELSE
826           STOP 'READ_FLD_XYZ_RS: Bad value for readBinaryPrec'
827        ENDIF        ENDIF
828    
829  C--   Copy data from IO buffer.  C--   Copy data from IO buffer.
# Line 778  C     Also regrid it to i,j,k indexing. Line 831  C     Also regrid it to i,j,k indexing.
831        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN        IF   ( readBinaryPrec .EQ. precFloat32 ) THEN
832         DO bj=1,nSy         DO bj=1,nSy
833          DO bi=1,nSx          DO bi=1,nSx
834           DO K=1,nZ           DO K=1,Nr
835            DO j=1,sNy            DO j=1,sNy
836             DO i=1,sNx             DO i=1,sNx
837              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 793  C     Also regrid it to i,j,k indexing. Line 846  C     Also regrid it to i,j,k indexing.
846           ENDDO           ENDDO
847          ENDDO          ENDDO
848         ENDDO         ENDDO
849        ELSE        ELSEIF   ( readBinaryPrec .EQ. precFloat64 ) THEN
850         DO bj=1,nSy         DO bj=1,nSy
851          DO bi=1,nSx          DO bi=1,nSx
852           DO K=1,nZ           DO K=1,Nr
853            DO j=1,sNy            DO j=1,sNy
854             DO i=1,sNx             DO i=1,sNx
855              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 821  C--   Check errors Line 874  C--   Check errors
874        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
875         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Read file(s) ',
876       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
877         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
878         &    SQUEEZE_RIGHT, 1 )
879        ELSE        ELSE
880         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error reading file ',
881         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
882         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
883        ENDIF        ENDIF
884    
# Line 844  C     | one-dimensional INTEGER data in Line 899  C     | one-dimensional INTEGER data in
899  C     | is designed to be readily parsed by a post-processing    |  C     | is designed to be readily parsed by a post-processing    |
900  C     | utility.                                                 |  C     | utility.                                                 |
901  C     \==========================================================/  C     \==========================================================/
902          IMPLICIT NONE
903    
904  C     == Global data ==  C     == Global data ==
905  #include "SIZE.h"  #include "SIZE.h"
# Line 866  C     == Local variables == Line 922  C     == Local variables ==
922        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
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,
926        CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
927          CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE.,
928         &    .TRUE., standardMessageUnit )
929        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
930        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
931         &    SQUEEZE_RIGHT , 1)
932  C  C
933        RETURN        RETURN
934        END        END
# Line 886  C     | one-dimensional LOGICAL data in Line 945  C     | one-dimensional LOGICAL data in
945  C     | is designed to be readily parsed by a post-processing    |  C     | is designed to be readily parsed by a post-processing    |
946  C     | utility.                                                 |  C     | utility.                                                 |
947  C     \==========================================================/  C     \==========================================================/
948          IMPLICIT NONE
949    
950  C     == Global data ==  C     == Global data ==
951  #include "SIZE.h"  #include "SIZE.h"
# Line 908  C     == Local variables == Line 968  C     == Local variables ==
968        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
969    
970        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
971        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
972        CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
973          CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE.,
974         &    .TRUE., standardMessageUnit )
975        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
976        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
977         &    SQUEEZE_RIGHT , 1)
978  C  C
979        RETURN        RETURN
980        END        END
# Line 928  C     | one-dimensional real*8 data in t Line 991  C     | one-dimensional real*8 data in t
991  C     | is designed to be readilya parsed by a post-processing   |  C     | is designed to be readilya parsed by a post-processing   |
992  C     | utility.                                                 |  C     | utility.                                                 |
993  C     \==========================================================/  C     \==========================================================/
994          IMPLICIT NONE
995    
996  C     == Global data ==  C     == Global data ==
997  #include "SIZE.h"  #include "SIZE.h"
# Line 950  C     == Local variables == Line 1014  C     == Local variables ==
1014        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1015    
1016        WRITE(msgBuf,'(A,A)') head, comment        WRITE(msgBuf,'(A,A)') head, comment
1017        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1018        CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )       &    SQUEEZE_RIGHT , 1)
1019          CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE.,
1020         &    .TRUE., standardMessageUnit )
1021        WRITE(msgBuf,'(A)')   '    ;     '        WRITE(msgBuf,'(A)')   '    ;     '
1022        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1023         &    SQUEEZE_RIGHT , 1)
1024  C  C
1025        RETURN        RETURN
1026        END        END
# Line 967  C     |================================= Line 1034  C     |=================================
1034  C     | Call low-level routines to write a model 2d model field. |  C     | Call low-level routines to write a model 2d model field. |
1035  C     | Handles _RL type data ( generally _RL == REAL*8 )        |  C     | Handles _RL type data ( generally _RL == REAL*8 )        |
1036  C     \==========================================================/  C     \==========================================================/
1037          IMPLICIT NONE
1038    
1039  C     == Global variables ==  C     == Global variables ==
1040  #include "SIZE.h"  #include "SIZE.h"
# Line 1103  C--   Check errors Line 1171  C--   Check errors
1171        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1172         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',
1173       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1174         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1175         &    SQUEEZE_RIGHT, 1 )
1176        ELSE        ELSE
1177         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',
1178         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1179         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
1180        ENDIF        ENDIF
1181    
# Line 1123  C     |================================= Line 1193  C     |=================================
1193  C     | Call low-level routines to write a model 3d model field. |  C     | Call low-level routines to write a model 3d model field. |
1194  C     | Handles _RL type data ( generally _RL == REAL*8 )        |  C     | Handles _RL type data ( generally _RL == REAL*8 )        |
1195  C     \==========================================================/  C     \==========================================================/
1196          IMPLICIT NONE
1197    
1198  C     == Global variables ==  C     == Global variables ==
1199  #include "SIZE.h"  #include "SIZE.h"
# Line 1146  C     myIter - Timestep number Line 1217  C     myIter - Timestep number
1217  C     myThid - Thread number calling this routine  C     myThid - Thread number calling this routine
1218        CHARACTER*(*) pref        CHARACTER*(*) pref
1219        CHARACTER*(*) suff        CHARACTER*(*) suff
1220        _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)
1221        INTEGER myThid        INTEGER myThid
1222        INTEGER myIter        INTEGER myIter
1223    
# Line 1203  C--   Copy data to IO buffer. Line 1274  C--   Copy data to IO buffer.
1274  C     Also regrid it to i,j,k indexing.  C     Also regrid it to i,j,k indexing.
1275        nXP=sNx*nSx        nXP=sNx*nSx
1276        nYP=sNy*nSy        nYP=sNy*nSy
1277        lFilled = sNx*nSx * sNy*nSy * Nz        lFilled = sNx*nSx * sNy*nSy * Nr
1278        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN
1279         DO bj=1,nSy         DO bj=1,nSy
1280          DO bi=1,nSx          DO bi=1,nSx
1281           DO k=1,Nz           DO k=1,Nr
1282            DO j=1,sNy            DO j=1,sNy
1283             DO i=1,sNx             DO i=1,sNx
1284              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 1223  C     Also regrid it to i,j,k indexing. Line 1294  C     Also regrid it to i,j,k indexing.
1294        ELSE        ELSE
1295         DO bj=1,nSy         DO bj=1,nSy
1296          DO bi=1,nSx          DO bi=1,nSx
1297           DO k=1,Nz           DO k=1,Nr
1298            DO j=1,sNy            DO j=1,sNy
1299             DO i=1,sNx             DO i=1,sNx
1300              iP = (bi-1)*sNx+i              iP = (bi-1)*sNx+i
# Line 1245  C--   Set local and global data extents Line 1316  C--   Set local and global data extents
1316        dimList(4) = nYP*nPy        dimList(4) = nYP*nPy
1317        dimList(5) = myYGlobalLo        dimList(5) = myYGlobalLo
1318        dimList(6) = myYGlobalLo+nYP-1        dimList(6) = myYGlobalLo+nYP-1
1319        dimList(7) = nZ        dimList(7) = Nr
1320        dimList(8) = 1        dimList(8) = 1
1321        dimList(9) = nZ        dimList(9) = Nr
1322    
1323  C--   Write data  C--   Write data
1324        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN        IF   ( writeBinaryPrec .EQ. precFloat32 ) THEN
# Line 1268  C--   Check errors Line 1339  C--   Check errors
1339        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN        IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1340         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',         WRITE(msgBuf,'(A,A,A,A)')  '// Wrote file(s) ',
1341       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)       &  pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1342         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1343         &    SQUEEZE_RIGHT, 1 )
1344        ELSE        ELSE
1345         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)         WRITE(msgBuf,'(A,A,A)') 'Error writing file ',
1346         &    pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1347         CALL PRINT_ERROR( msgBuf, 1 )         CALL PRINT_ERROR( msgBuf, 1 )
1348        ENDIF        ENDIF
1349    
# Line 1280  C--   Check errors Line 1353  C--   Check errors
1353        END        END
1354    
1355  CStartofinterface  CStartofinterface
1356        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime,
1357         &                              myIter, myThid )
1358  C     /==========================================================\  C     /==========================================================\
1359  C     | SUBROUTINE WRITE_CHECKPOINT                              |  C     | SUBROUTINE WRITE_CHECKPOINT                              |
1360  C     | o Controlling routine for IO to write restart file.      |  C     | o Controlling routine for IO to write restart file.      |
# Line 1298  C     | the current timestep number. Thi Line 1372  C     | the current timestep number. Thi
1372  C     | be used to provided a snap-shot from which the model     |  C     | be used to provided a snap-shot from which the model     |
1373  C     | can be rerun.                                            |  C     | can be rerun.                                            |
1374  C     \==========================================================/  C     \==========================================================/
1375          IMPLICIT NONE
1376    
1377  C     == Global variables ===  C     == Global variables ===
1378  #include "SIZE.h"  #include "SIZE.h"
# Line 1305  C     == Global variables === Line 1380  C     == Global variables ===
1380  #include "PARAMS.h"  #include "PARAMS.h"
1381  #include "DYNVARS.h"  #include "DYNVARS.h"
1382  #include "CG2D.h"  #include "CG2D.h"
1383    #ifdef ALLOW_NONHYDROSTATIC
1384    #include "GW.h"
1385    #endif
1386    
1387        LOGICAL  DIFFERENT_MULTIPLE        LOGICAL  DIFFERENT_MULTIPLE
1388        EXTERNAL DIFFERENT_MULTIPLE        EXTERNAL DIFFERENT_MULTIPLE
# Line 1334  C                      be written. Line 1412  C                      be written.
1412        INTEGER endIOErrCount        INTEGER endIOErrCount
1413        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1414        LOGICAL permCheckPoint          LOGICAL permCheckPoint  
1415          INTEGER oldPrec
1416    
1417        permCheckPoint = .FALSE.        permCheckPoint = .FALSE.
1418        permCheckPoint=        permCheckPoint=
1419       & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,
1420         &                    myCurrentTime-deltaTClock)
1421    
1422        IF (        IF (
1423       &    (.NOT. modelEnd .AND. (       &    (.NOT. modelEnd .AND. (
1424       &     permCheckPoint       &     permCheckPoint
1425       &     .OR.       &     .OR.
1426       &     DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       &     DIFFERENT_MULTIPLE(chkptFreq,
1427         &    myCurrentTime,myCurrentTime-deltaTClock)
1428       &     )       &     )
1429       &    )       &    )
1430       &     .OR.       &     .OR.
# Line 1352  C                      be written. Line 1433  C                      be written.
1433       &     .AND. .NOT.       &     .AND. .NOT.
1434       &     permCheckPoint       &     permCheckPoint
1435       &     .AND. .NOT.       &     .AND. .NOT.
1436       &     DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)       &     DIFFERENT_MULTIPLE(chkptFreq,
1437         &    myCurrentTime,myCurrentTime-deltaTClock)
1438       &    )       &    )
1439       & ) THEN       & ) THEN
1440    
# Line 1370  C--     Set IO "context" for writing sta Line 1452  C--     Set IO "context" for writing sta
1452          CALL DFILE_SET_RW          CALL DFILE_SET_RW
1453          CALL DFILE_SET_CONT_ON_ERROR          CALL DFILE_SET_CONT_ON_ERROR
1454  C       Force 64-bit IO  C       Force 64-bit IO
1455            oldPrec = writeBinaryPrec
1456          writeBinaryPrec = precFloat64          writeBinaryPrec = precFloat64
1457    
   
1458  C--     Read IO error counter  C--     Read IO error counter
1459          beginIOErrCount = IO_ERRCOUNT(myThid)          beginIOErrCount = IO_ERRCOUNT(myThid)
1460    
1461  C--     Write model fields  C--     Write model fields
1462  C       Raw fields  C       Raw fields
1463          CALL WRITE_FLD_XYZ_RL(   'uVel.',suff,      uVel, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1464          CALL WRITE_FLD_XYZ_RL(     'gU.',suff,        gU, myIter, myThid)       &    (   'uVel.',suff,      uVel, myIter, myThid)
1465          CALL WRITE_FLD_XYZ_RL(  'gUNm1.',suff,     gUNm1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1466          CALL WRITE_FLD_XYZ_RL(   'vVel.',suff,      vVel, myIter, myThid)       &    (     'gU.',suff,        gU, myIter, myThid)
1467          CALL WRITE_FLD_XYZ_RL(     'gV.',suff,        gV, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1468          CALL WRITE_FLD_XYZ_RL(  'gVNm1.',suff,     gVNm1, myIter, myThid)       &    (  'gUNm1.',suff,     gUNm1, myIter, myThid)
1469          CALL WRITE_FLD_XYZ_RL(  'theta.',suff,     theta, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1470          CALL WRITE_FLD_XYZ_RL(     'gT.',suff,        gT, myIter, myThid)       &    (   'vVel.',suff,      vVel, myIter, myThid)
1471          CALL WRITE_FLD_XYZ_RL(  'gTNm1.',suff,     gTNm1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1472          CALL WRITE_FLD_XYZ_RL(   'salt.',suff,      salt, myIter, myThid)       &    (     'gV.',suff,        gV, myIter, myThid)
1473          CALL WRITE_FLD_XYZ_RL(     'gS.',suff,        gS, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1474          CALL WRITE_FLD_XYZ_RL(  'gSNm1.',suff,     gSNm1, myIter, myThid)       &    (  'gVNm1.',suff,     gVNm1, myIter, myThid)
1475          CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1476  #ifdef ALLOW_CD       &    (  'theta.',suff,     theta, myIter, myThid)
1477          CALL WRITE_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL
1478         &    (     'gT.',suff,        gT, myIter, myThid)
1479            CALL WRITE_FLD_XYZ_RL
1480         &    (  'gTNm1.',suff,     gTNm1, myIter, myThid)
1481            CALL WRITE_FLD_XYZ_RL
1482         &    (   'salt.',suff,      salt, myIter, myThid)
1483            CALL WRITE_FLD_XYZ_RL
1484         &    (     'gS.',suff,        gS, myIter, myThid)
1485            CALL WRITE_FLD_XYZ_RL
1486         &    (  'gSNm1.',suff,     gSNm1, myIter, myThid)
1487            CALL WRITE_FLD_XY_RL
1488         &    ( 'cg2d_x.',suff,    cg2d_x, myIter, myThid)
1489    #ifdef INCLUDE_CD_CODE
1490            CALL WRITE_FLD_XY_RL
1491         &    ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
1492          CALL WRITE_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'uVelD.',suff,    uVelD, myIter, myThid)
1493          CALL WRITE_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'vVelD.',suff,    vVelD, myIter, myThid)
1494          CALL WRITE_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'uNM1.', suff,     uNM1, myIter, myThid)
# Line 1400  C       Raw fields Line 1496  C       Raw fields
1496          CALL WRITE_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'guCD.', suff,     guCD, myIter, myThid)
1497          CALL WRITE_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'gvCD.', suff,     gvCD, myIter, myThid)
1498  #endif  #endif
1499    #ifdef ALLOW_NONHYDROSTATIC
1500            IF ( nonHydrostatic ) THEN
1501             CALL WRITE_FLD_XYZ_RL
1502         &    (   'wVel.',suff,      wVel, myIter, myThid)
1503             CALL WRITE_FLD_XYZ_RL
1504         &    (     'gW.',suff,        gW, myIter, myThid)
1505             CALL WRITE_FLD_XYZ_RL
1506         &    (  'gWNm1.',suff,     gWNm1, myIter, myThid)
1507            ENDIF
1508    #endif
1509    
1510    C--     Reset binary precision
1511            writeBinaryPrec = oldPrec
1512    
1513  C--     Reread IO error counter  C--     Reread IO error counter
1514          endIOErrCount = IO_ERRCOUNT(myThid)          endIOErrCount = IO_ERRCOUNT(myThid)
# Line 1414  C--     Check for IO errors Line 1522  C--     Check for IO errors
1522           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1523           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
1524          ELSE          ELSE
1525           WRITE(msgBuf,'(A,I10)')  '// Model checkpoint written, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
1526           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model checkpoint written, timestep', myIter
1527             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1528         &    SQUEEZE_RIGHT, 1 )
1529           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
1530           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1531         &    SQUEEZE_RIGHT, 1 )
1532  C        Wrote OK so step forward to use next checkpoint in loop.  C        Wrote OK so step forward to use next checkpoint in loop.
1533           IF ( .NOT. permCheckPoint ) THEN           IF ( .NOT. permCheckPoint ) THEN
1534            nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1            nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
# Line 1433  C        Wrote OK so step forward to use Line 1544  C        Wrote OK so step forward to use
1544        END        END
1545    
1546  CStartofinterface  CStartofinterface
1547        SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime, myIter, myThid )        SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime,
1548         &    myIter, myThid )
1549  C     /==========================================================\  C     /==========================================================\
1550  C     | SUBROUTINE WRITE_STATE                                   |  C     | SUBROUTINE WRITE_STATE                                   |
1551  C     | o Controlling routine for IO to dump model state.        |  C     | o Controlling routine for IO to dump model state.        |
# Line 1441  C     |================================= Line 1553  C     |=================================
1553  C     | Write model state files for post-processing. This file   |  C     | Write model state files for post-processing. This file   |
1554  C     | includes code for diagnosing W and RHO for output.       |  C     | includes code for diagnosing W and RHO for output.       |
1555  C     \==========================================================/  C     \==========================================================/
1556          IMPLICIT NONE
1557    
1558  C     == Global variables ===  C     == Global variables ===
1559  #include "SIZE.h"  #include "SIZE.h"
# Line 1448  C     == Global variables === Line 1561  C     == Global variables ===
1561  #include "PARAMS.h"  #include "PARAMS.h"
1562  #include "DYNVARS.h"  #include "DYNVARS.h"
1563  #include "CG2D.h"  #include "CG2D.h"
1564    #ifdef ALLOW_NONHYDROSTATIC
1565    #include "CG3D.h"
1566    #include "GW.h"
1567    #endif
1568    
1569        LOGICAL  DIFFERENT_MULTIPLE        LOGICAL  DIFFERENT_MULTIPLE
1570        EXTERNAL DIFFERENT_MULTIPLE        EXTERNAL DIFFERENT_MULTIPLE
# Line 1475  C     msgBuf - Error message buffer Line 1592  C     msgBuf - Error message buffer
1592        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1593    
1594        IF (        IF (
1595       &  DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)       &  ( DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,
1596         &    myCurrentTime-deltaTClock) .AND. myCurrentTime.NE.startTime )
1597       &  .OR. forceOutput       &  .OR. forceOutput
1598       & ) THEN       & ) THEN
1599    
# Line 1500  C       Raw fields Line 1618  C       Raw fields
1618          CALL WRITE_FLD_XYZ_RL(  'V.',suff,      vVel, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'V.',suff,      vVel, myIter, myThid)
1619          CALL WRITE_FLD_XYZ_RL(  'T.',suff,      theta, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'T.',suff,      theta, myIter, myThid)
1620          CALL WRITE_FLD_XYZ_RL(  'S.',suff,      salt, myIter, myThid)          CALL WRITE_FLD_XYZ_RL(  'S.',suff,      salt, myIter, myThid)
1621          CALL WRITE_FLD_XY_RL (  'H.',suff,    cg2d_x, myIter, myThid)          CALL WRITE_FLD_XY_RL ( 'PS.',suff,    cg2d_x, myIter, myThid)
1622  C       Hmmm.... what to do atbout these huh  C       Hmmm.... what to do atbout these huh
1623  C       need to calculate them but remember we are already within a  C       need to calculate them but remember we are already within a
1624  C       _MASTER section. So we can not use multithreaded code.  C       _MASTER section. So we can not use multithreaded code.
# Line 1510  C       CALL WRITE_FLD_XYZ_RL(   'W.',su Line 1628  C       CALL WRITE_FLD_XYZ_RL(   'W.',su
1628  C       CALL WRITE_FLD_XYZ_RL( 'RHO.',suff,   arr3d  , myIter, myThid)  C       CALL WRITE_FLD_XYZ_RL( 'RHO.',suff,   arr3d  , myIter, myThid)
1629  C       CALL WRITE_FLD_XYZ_RL('RHOP.',suff,   arr3d  , myIter, myThid)  C       CALL WRITE_FLD_XYZ_RL('RHOP.',suff,   arr3d  , myIter, myThid)
1630  C       CALL WRITE_FLD_XYZ_RL(  'PH.',suff,   arr3d  , myIter, myThid)  C       CALL WRITE_FLD_XYZ_RL(  'PH.',suff,   arr3d  , myIter, myThid)
1631    #ifdef ALLOW_NONHYDROSTATIC
1632            IF (nonHydroStatic) THEN
1633             CALL WRITE_FLD_XYZ_RL('PNH.',suff,    cg3d_x, myIter, myThid)
1634            ENDIF
1635            CALL WRITE_FLD_XYZ_RL(  'W.',suff,      wVel, myIter, myThid)
1636    #endif
1637    
1638  C--     Reread IO error counter  C--     Reread IO error counter
1639          endIOErrCount = IO_ERRCOUNT(myThid)          endIOErrCount = IO_ERRCOUNT(myThid)
# Line 1523  C--     Check for IO errors Line 1647  C--     Check for IO errors
1647           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1648           CALL PRINT_ERROR( msgBuf, 1 )           CALL PRINT_ERROR( msgBuf, 1 )
1649          ELSE          ELSE
1650           WRITE(msgBuf,'(A,I10)')  '// Model state written, timestep', myIter           WRITE(msgBuf,'(A,I10)')  
1651           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )       &    '// Model state written, timestep', myIter
1652             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1653         &    SQUEEZE_RIGHT, 1 )
1654           WRITE(msgBuf,'(A)')  ' '           WRITE(msgBuf,'(A)')  ' '
1655           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1656         &    SQUEEZE_RIGHT, 1 )
1657          ENDIF          ENDIF
1658    
1659         _END_MASTER( myThid )         _END_MASTER( myThid )
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22