model/src/write_state.F

6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
ab42872a05 Alis*0002 #include "CPP_OPTIONS.h"
                0003
7b42436b38 Alis*0004 #undef  MULTIPLE_RECORD_STATE_FILES
                0005
a30418b6b9 Ed H*0006 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9366854e02 Chri*0007 CBOP
3365bdc872 Jean*0008 C     !ROUTINE: WRITE_STATE
a30418b6b9 Ed H*0009
9366854e02 Chri*0010 C     !INTERFACE:
5c43c390b6 Alis*0011       SUBROUTINE WRITE_STATE ( myTime, myIter, myThid )
a30418b6b9 Ed H*0012
                0013 C     !DESCRIPTION:
                0014 C     This is the controlling routine for writing mid-level IO.  It
                0015 C     includes code for diagnosing W and RHO for output.
                0016
                0017 C     The CPP flag (MULTIPLE_RECORD_STATE_FILES) is #define/#undefed
                0018 C     here since it is specific to this routine and very user-preference
                0019 C     specific. If #undefed (default) the state files are written as in
                0020 C     all versions prior to checkpoint32, where a file is created per
                0021 C     variable, per time and per tile. This *has* to be the default
                0022 C     because most users use this mode and all utilities and scripts
                0023 C     (diagnostic) assume this form.  It is also robust, as explained
                0024 C     below.
3365bdc872 Jean*0025 C
a30418b6b9 Ed H*0026 C     If #defined, subsequent snap-shots are written as records in the
                0027 C     same file (no iteration number in filenames). The main advantage
                0028 C     is fewer files.  The disadvantages are that:
                0029 C       (1) it breaks a lot of diagnostic scripts,
                0030 C       (2) for large or long problems this creates huge files,
3365bdc872 Jean*0031 C       (3) its an unexpected, unsolicited change in behaviour which
                0032 C           came as a surprise (in c32) and is an inconvenience to
a30418b6b9 Ed H*0033 C           several users
                0034 C       (4) it can not accomodate changing the frequency of output
3365bdc872 Jean*0035 C           after a pickup (this is trivial in previous method but
a30418b6b9 Ed H*0036 C           needs new code and parameters in this new method)
                0037 C
3365bdc872 Jean*0038 C      Known Bugs include:
a30418b6b9 Ed H*0039 C       (1) if the length of integration is not exactly an integer
                0040 C           times the output frequency then the last record written
                0041 C           (at end of integration) overwrites a previously written
                0042 C           record corresponding to an earier time. *BE WARNED*
ab42872a05 Alis*0043
9366854e02 Chri*0044 C     !USES:
                0045       IMPLICIT NONE
ab42872a05 Alis*0046 #include "SIZE.h"
                0047 #include "EEPARAMS.h"
                0048 #include "PARAMS.h"
3365bdc872 Jean*0049 #include "GRID.h"
d1b81ea0bc Jean*0050 #include "DYNVARS.h"
                0051 #ifdef ALLOW_NONHYDROSTATIC
                0052 #include "NH_VARS.h"
                0053 #endif
f31930e56f Ed H*0054 #ifdef ALLOW_MNC
                0055 #include "MNC_PARAMS.h"
                0056 #endif
8a28092f34 Patr*0057
0fa2023ba5 Jean*0058       LOGICAL  DIFFERENT_MULTIPLE
                0059       EXTERNAL DIFFERENT_MULTIPLE
ab42872a05 Alis*0060       INTEGER  IO_ERRCOUNT
                0061       EXTERNAL IO_ERRCOUNT
                0062
9366854e02 Chri*0063 C     !INPUT/OUTPUT PARAMETERS:
ab42872a05 Alis*0064 C     myThid - Thread number for this instance of the routine.
                0065 C     myIter - Iteration number
5c43c390b6 Alis*0066 C     myTime - Current time of simulation ( s )
                0067       _RL     myTime
ab42872a05 Alis*0068       INTEGER myThid
                0069       INTEGER myIter
                0070
9366854e02 Chri*0071 C     !LOCAL VARIABLES:
7b42436b38 Alis*0072       CHARACTER*(MAX_LEN_MBUF) suff
e508fdf6c2 Patr*0073       INTEGER iRec
7418e6b1e6 Jean*0074 #ifdef ALLOW_MNC
                0075       CHARACTER*(1) pf
                0076 #endif
9366854e02 Chri*0077 CEOP
ab42872a05 Alis*0078
3365bdc872 Jean*0079       IF (
0fa2023ba5 Jean*0080      &     DIFFERENT_MULTIPLE(dumpFreq,myTime,deltaTClock)
82d0948361 Jean*0081      &  .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
                0082      &                             myTime.EQ.startTime  )
                0083      &   ) THEN
a30418b6b9 Ed H*0084         IF ( dumpFreq .EQ. 0.0 ) THEN
                0085           iRec = 1
                0086         ELSE
8f6bf732a8 Jean*0087           iRec = 1 + NINT( (myTime-startTime) / dumpFreq )
a30418b6b9 Ed H*0088         ENDIF
3365bdc872 Jean*0089
a30418b6b9 Ed H*0090 C       Going to really do some IO. Make everyone except master thread wait.
3365bdc872 Jean*0091 C       this is done within IO routines => no longer needed
                0092 c       _BARRIER
ab42872a05 Alis*0093
a30418b6b9 Ed H*0094 C       Write model fields
                0095         IF (snapshot_mdsio) THEN
ad3a31a87b Jean*0096
7b42436b38 Alis*0097 #ifdef MULTIPLE_RECORD_STATE_FILES
ad3a31a87b Jean*0098
a30418b6b9 Ed H*0099 C         Write each snap-shot as a new record in one file per variable
                0100 C         - creates relatively few files but these files can become huge
                0101           CALL WRITE_REC_XYZ_RL( 'U',  uVel,iRec,myIter,myThid)
                0102           CALL WRITE_REC_XYZ_RL( 'V',  vVel,iRec,myIter,myThid)
                0103           CALL WRITE_REC_XYZ_RL( 'T', theta,iRec,myIter,myThid)
                0104           CALL WRITE_REC_XYZ_RL( 'S',  salt,iRec,myIter,myThid)
                0105           CALL WRITE_REC_XY_RL('Eta',etaN,iRec,myIter,myThid)
                0106           CALL WRITE_REC_XYZ_RL( 'W',wVel,iRec,myIter,myThid)
ab42872a05 Alis*0107 #ifdef ALLOW_NONHYDROSTATIC
a30418b6b9 Ed H*0108           IF (nonHydroStatic) THEN
                0109             CALL WRITE_REC_XYZ_RL( 'PNH',phi_nh,iRec,myIter,myThid)
                0110           ENDIF
7b42436b38 Alis*0111 #endif /* ALLOW_NONHYDROSTATIC */
ad3a31a87b Jean*0112 #ifdef NONLIN_FRSURF
a30418b6b9 Ed H*0113 c         CALL WRITE_REC_XYZ_RS('hFacC.',hFacC,iRec,myIter,myThid)
                0114 c         CALL WRITE_REC_XYZ_RS('hFacW.',hFacW,iRec,myIter,myThid)
                0115 c         CALL WRITE_REC_XYZ_RS('hFacS.',hFacS,iRec,myIter,myThid)
ad3a31a87b Jean*0116 #endif /* NONLIN_FRSURF */
                0117
                0118 #else /* MULTIPLE_RECORD_STATE_FILES */
                0119
a30418b6b9 Ed H*0120 C         Write each snap-shot as a new file (original and default
                0121 C         method) -- creates many files but for large configurations is
                0122 C         easier to transfer analyse a particular snap-shots
8f6bf732a8 Jean*0123           IF ( rwSuffixType.EQ.0 ) THEN
                0124             WRITE(suff,'(I10.10)') myIter
                0125           ELSE
                0126             CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0127           ENDIF
60e3924f90 Patr*0128
931afb889c Jean*0129 #ifdef ALLOW_OPENAD
68ffaf94fb Jean*0130 # ifndef ALLOW_STREAMICE
60e3924f90 Patr*0131           CALL WRITE_FLD_XYZ_RL( 'U.',suff,uVel%v,myIter,myThid)
                0132           CALL WRITE_FLD_XYZ_RL( 'V.',suff,vVel%v,myIter,myThid)
                0133           CALL WRITE_FLD_XYZ_RL( 'T.',suff,theta%v,myIter,myThid)
                0134           CALL WRITE_FLD_XYZ_RL( 'S.',suff,salt%v,myIter,myThid)
                0135           CALL WRITE_FLD_XY_RL('Eta.',suff,etaN%v,myIter,myThid)
                0136           CALL WRITE_FLD_XYZ_RL( 'W.',suff,wVel%v,myIter,myThid)
901f12b7bc Jean*0137           IF ( storePhiHyd4Phys .OR. myIter.NE.nIter0 ) THEN
60e3924f90 Patr*0138             CALL WRITE_FLD_XYZ_RL('PH.',suff,totPhiHyd%v,myIter,myThid)
                0139           ENDIF
68ffaf94fb Jean*0140 # endif
60e3924f90 Patr*0141 #else
a30418b6b9 Ed H*0142           CALL WRITE_FLD_XYZ_RL( 'U.',suff,uVel,myIter,myThid)
                0143           CALL WRITE_FLD_XYZ_RL( 'V.',suff,vVel,myIter,myThid)
                0144           CALL WRITE_FLD_XYZ_RL( 'T.',suff,theta,myIter,myThid)
                0145           CALL WRITE_FLD_XYZ_RL( 'S.',suff,salt,myIter,myThid)
                0146           CALL WRITE_FLD_XY_RL('Eta.',suff,etaN,myIter,myThid)
                0147           CALL WRITE_FLD_XYZ_RL( 'W.',suff,wVel,myIter,myThid)
901f12b7bc Jean*0148           IF ( storePhiHyd4Phys .OR. myIter.NE.nIter0 ) THEN
a30418b6b9 Ed H*0149             CALL WRITE_FLD_XYZ_RL('PH.',suff,totPhiHyd,myIter,myThid)
                0150           ENDIF
60e3924f90 Patr*0151 #endif
                0152
9669509dca Jean*0153           IF ( fluidIsWater .AND. (myIter.NE.nIter0) ) THEN
a30418b6b9 Ed H*0154             CALL WRITE_FLD_XY_RL('PHL.',suff,phiHydLow,myIter,myThid)
                0155           ENDIF
7b42436b38 Alis*0156 #ifdef ALLOW_NONHYDROSTATIC
a30418b6b9 Ed H*0157           IF (nonHydroStatic) THEN
982e105a17 Jean*0158             CALL WRITE_FLD_XYZ_RL( 'PNH.',suff,phi_nh,myIter,myThid )
                0159           ENDIF
                0160           IF ( selectNHfreeSurf.GE.1 ) THEN
                0161             CALL WRITE_FLD_XY_RL( 'dPnh.',suff,dPhiNH,myIter,myThid )
a30418b6b9 Ed H*0162           ENDIF
7b42436b38 Alis*0163 #endif /* ALLOW_NONHYDROSTATIC */
ad3a31a87b Jean*0164 #ifdef NONLIN_FRSURF
a30418b6b9 Ed H*0165 c         CALL WRITE_FLD_XYZ_RS('hFacC.',suff,hFacC,myIter,myThid)
                0166 c         CALL WRITE_FLD_XYZ_RS('hFacW.',suff,hFacW,myIter,myThid)
                0167 c         CALL WRITE_FLD_XYZ_RS('hFacS.',suff,hFacS,myIter,myThid)
ad3a31a87b Jean*0168 #endif /* NONLIN_FRSURF */
                0169
7b42436b38 Alis*0170 #endif /* MULTIPLE_RECORD_STATE_FILES */
ab42872a05 Alis*0171
a30418b6b9 Ed H*0172         ENDIF
ab42872a05 Alis*0173
3bd1ac0e4a Ed H*0174 #ifdef ALLOW_MNC
a30418b6b9 Ed H*0175         IF (useMNC .AND. snapshot_mnc) THEN
60111aef93 Ed H*0176
                0177           IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
                0178             pf(1:1) = 'D'
                0179           ELSE
                0180             pf(1:1) = 'R'
                0181           ENDIF
                0182
a30418b6b9 Ed H*0183 C         Write dynvars using the MNC package
                0184           CALL MNC_CW_SET_UDIM('state', -1, myThid)
987ff12cb6 Ed H*0185           CALL MNC_CW_RL_W_S('D','state',0,0,'T', myTime, myThid)
a30418b6b9 Ed H*0186           CALL MNC_CW_SET_UDIM('state', 0, myThid)
987ff12cb6 Ed H*0187           CALL MNC_CW_I_W_S('I','state',0,0,'iter', myIter, myThid)
                0188 C         CALL MNC_CW_RL_W_S('D','state',0,0,'model_time',myTime,myThid)
60111aef93 Ed H*0189           CALL MNC_CW_RL_W(pf,'state',0,0,'U', uVel, myThid)
                0190           CALL MNC_CW_RL_W(pf,'state',0,0,'V', vVel, myThid)
                0191           CALL MNC_CW_RL_W(pf,'state',0,0,'Temp', theta, myThid)
                0192           CALL MNC_CW_RL_W(pf,'state',0,0,'S', salt, myThid)
                0193           CALL MNC_CW_RL_W(pf,'state',0,0,'Eta', etaN, myThid)
                0194           CALL MNC_CW_RL_W(pf,'state',0,0,'W', wVel, myThid)
901f12b7bc Jean*0195           IF ( storePhiHyd4Phys .OR. myIter.NE.nIter0 ) THEN
a30418b6b9 Ed H*0196             CALL MNC_CW_SET_UDIM('phiHyd', -1, myThid)
987ff12cb6 Ed H*0197             CALL MNC_CW_RL_W_S('D','phiHyd',0,0,'T',myTime,myThid)
a30418b6b9 Ed H*0198             CALL MNC_CW_SET_UDIM('phiHyd', 0, myThid)
987ff12cb6 Ed H*0199             CALL MNC_CW_I_W_S('I','phiHyd',0,0,'iter',myIter,myThid)
60111aef93 Ed H*0200             CALL MNC_CW_RL_W(pf,'phiHyd',0,0,'phiHyd',
a30418b6b9 Ed H*0201      &           totPhiHyd, myThid)
                0202           ENDIF
9669509dca Jean*0203           IF ( fluidIsWater .AND. (myIter .NE. nIter0) ) THEN
a30418b6b9 Ed H*0204             CALL MNC_CW_SET_UDIM('phiHydLow', -1, myThid)
987ff12cb6 Ed H*0205             CALL MNC_CW_RL_W_S('D','phiHydLow',0,0,'T', myTime, myThid)
                0206             CALL MNC_CW_SET_UDIM('phiHydLow', 0, myThid)
                0207             CALL MNC_CW_I_W_S('I','phiHydLow',0,0,'iter',myIter,myThid)
60111aef93 Ed H*0208             CALL MNC_CW_RL_W(pf,'phiHydLow',0,0,'phiHydLow',
a30418b6b9 Ed H*0209      &           phiHydLow, myThid)
                0210           ENDIF
353773d087 Ed H*0211 #ifdef ALLOW_NONHYDROSTATIC
a30418b6b9 Ed H*0212           IF (nonHydroStatic) THEN
60111aef93 Ed H*0213             CALL MNC_CW_RL_W(pf,'state',0,0,'phi_nh',phi_nh,myThid)
a30418b6b9 Ed H*0214           ENDIF
353773d087 Ed H*0215 #endif /* ALLOW_NONHYDROSTATIC */
a30418b6b9 Ed H*0216         ENDIF
353773d087 Ed H*0217 #endif /*  ALLOW_MNC  */
3365bdc872 Jean*0218
ab42872a05 Alis*0219       ENDIF
                0220
                0221       RETURN
                0222       END