Back to home page

MITgcm
 
 

    

File indexing completed on 2021-08-12 05:10:53 UTC

view on githubraw file Latest commit 0320e252 on 2021-08-11 16:08:52 UTC
d6ed4854d6 Jean*0001 c#include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003 
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C     !ROUTINE: CHECK_PICKUP
                0007 C     !INTERFACE:
                0008       SUBROUTINE CHECK_PICKUP(
                0009      I                 missFldList,
                0010      I                 nMissing, nbFields,
                0011      I                 myIter, myThid )
                0012 
                0013 C     !DESCRIPTION:
                0014 C     Check that fields that are needed to restart have been read.
                0015 C     In case some fields are missing, stop if pickupStrictlyMatch=T
                0016 C     or try, if possible, to restart without the missing field.
                0017 
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "RESTART.h"
                0024 c#ifdef ALLOW_GENERIC_ADVDIFF
                0025 c# include "GAD.h"
                0026 c#endif
                0027 
                0028 C     !INPUT/OUTPUT PARAMETERS:
                0029 C     missFldList :: List of missing fields   (attempted to read but not found)
                0030 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0031 C     nbFields    :: number of fields in pickup file (read from meta file)
                0032 C     myIter      :: Iteration number
                0033 C     myThid      :: my Thread Id. number
                0034       CHARACTER*(8) missFldList(*)
                0035       INTEGER nMissing
                0036       INTEGER nbFields
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039 CEOP
                0040 
                0041 C     !FUNCTIONS
                0042       INTEGER  ILNBLNK
                0043       EXTERNAL ILNBLNK
                0044 
                0045 C     !LOCAL VARIABLES:
                0046       INTEGER j
af24f21bb7 Jean*0047       INTEGER ioUnit
                0048       INTEGER warnCnts
d6ed4854d6 Jean*0049       LOGICAL stopFlag
                0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0051 
af24f21bb7 Jean*0052       ioUnit = errorMessageUnit
                0053 
d6ed4854d6 Jean*0054 c     IF (pickup_read_mdsio) THEN
                0055       _BEGIN_MASTER( myThid )
                0056 
                0057        IF ( nbFields.GE.1 ) THEN
                0058 C-     flag startFromPickupAB2 is becoming obsolete with new way to read
                0059 C      pickup file: cancel its effect (from initialisation) by resetting
                0060 C      start-AB parameters:
                0061          tempStartAB = nIter0
                0062          saltStartAB = nIter0
                0063          mom_StartAB = nIter0
                0064          nHydStartAB = nIter0
                0065        ENDIF
cba4501825 Jean*0066        IF ( selectNHfreeSurf.GE.1 ) THEN
                0067          IF ( nbFields.EQ.0 ) THEN
4f747a7822 Jean*0068            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
cba4501825 Jean*0069      &      'restart like hydrostatic free-surf (dPhiNH missing)'
                0070            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0071          ELSE
                0072 C-     assume reading dPhiNH was OK (otherwise expected in missing field list)
                0073            dPhiNHstatus = 1
                0074          ENDIF
                0075        ENDIF
d6ed4854d6 Jean*0076 
                0077        IF ( nMissing.GE.1 ) THEN
                0078         stopFlag = .FALSE.
af24f21bb7 Jean*0079         warnCnts = nMissing
d6ed4854d6 Jean*0080         DO j=1,nMissing
af24f21bb7 Jean*0081 C-    Case where missing field is not essential or can be recomputed
d6ed4854d6 Jean*0082          IF     ( missFldList(j).EQ.'dEtaHdt '
af24f21bb7 Jean*0083      &        .AND. .NOT.useRealFreshWaterFlux ) THEN
                0084           warnCnts = warnCnts - 1
                0085           IF ( .NOT.pickupStrictlyMatch ) THEN
                0086            WRITE(msgBuf,'(4A)') ' CHECK_PICKUP: ',
                0087      &      'no RealFreshWaterFlux => can restart without "dEtaHdt "'
                0088            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0089           ENDIF
cba4501825 Jean*0090          ELSEIF ( missFldList(j).EQ.'dPhiNH  '
                0091      &        .AND. implicitNHPress.EQ.1. _d 0 ) THEN
                0092           warnCnts = warnCnts - 1
                0093           dPhiNHstatus = 0
                0094           IF ( .NOT.pickupStrictlyMatch ) THEN
                0095            WRITE(msgBuf,'(4A)') ' CHECK_PICKUP: ',
                0096      &      'fully Implic.NH-Press => can restart without "dPhiNH  "'
                0097            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0098           ENDIF
af24f21bb7 Jean*0099 C-    Old pickup for which special code takes care of missing fields
                0100          ELSEIF ( missFldList(j).EQ.'dEtaHdt '
d6ed4854d6 Jean*0101      &                 .AND.usePickupBeforeC54 ) THEN
af24f21bb7 Jean*0102 C-    with RealFreshWaterFlux, needs dEtaHdt to restart when:
                0103 C     * synchronousTimeStep & usingPCoords => needs PmEpR for surf-forcing
                0104 C         <- present code might be wrong if usePickupBeforeC54 and LinFS
                0105 C     * synchronousTimeStep & nonlinFreeSurf > 0 => needs PmEpR for surf-forcing
                0106 C     * select_rStar <> 0 => needs dEtaHdt for 1rst Integr_continuity
                0107           IF ( .NOT.pickupStrictlyMatch ) THEN
4f747a7822 Jean*0108            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
af24f21bb7 Jean*0109      &      'restart as before C54 without "dEtaHdt "'
                0110            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0111           ENDIF
                0112 
                0113 C-    fields used only to speed-up solver(s) convergence:
                0114 C     (no serious problems expected if missing, but get a non-perfect restart)
                0115          ELSEIF ( missFldList(j).EQ.'EtaN    '
                0116      &                          .AND. rigidLid ) THEN
                0117           IF ( .NOT.pickupStrictlyMatch ) THEN
4f747a7822 Jean*0118            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
af24f21bb7 Jean*0119      &      'restart with 1rst guess == 0 for CG2D solver'
                0120            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0121           ENDIF
                0122          ELSEIF ( missFldList(j).EQ.'Phi_NHyd' ) THEN
                0123           IF ( .NOT.pickupStrictlyMatch ) THEN
4f747a7822 Jean*0124            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
af24f21bb7 Jean*0125      &      'restart with 1rst guess == 0 for CG3D solver'
                0126            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0127           ENDIF
cba4501825 Jean*0128          ELSEIF ( missFldList(j).EQ.'dPhiNH  ' ) THEN
                0129           dPhiNHstatus = 0
                0130           IF ( .NOT.pickupStrictlyMatch ) THEN
4f747a7822 Jean*0131            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
cba4501825 Jean*0132      &      'restart like hydrostatic free-surf (dPhiNH missing)'
                0133            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0134           ENDIF
d2a11ab670 Jean*0135          ELSEIF ( missFldList(j).EQ.'AddMass '
cba4501825 Jean*0136      &               .AND. selectAddFluid.EQ.2 ) THEN
d2a11ab670 Jean*0137           IF ( .NOT.pickupStrictlyMatch ) THEN
4f747a7822 Jean*0138            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
d2a11ab670 Jean*0139      &      'restart with AddMass == 0'
                0140            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0141           ENDIF
2d5bb917cc Jean*0142          ELSEIF ( missFldList(j).EQ.'SmagDiff' ) THEN
                0143           IF ( .NOT.pickupStrictlyMatch ) THEN
                0144            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
                0145      &      'restart with zero Smag-3D Diffusivity for first time-step'
                0146            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0147           ENDIF
fd6656ef94 Jean*0148          ELSEIF ( missFldList(j).EQ.'FricHeat' ) THEN
                0149           IF ( .NOT.pickupStrictlyMatch ) THEN
                0150            WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
                0151      &      'restart with Frictional Dissipation Heating == 0'
                0152            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0153           ENDIF
d6ed4854d6 Jean*0154 
                0155 C-    Absolutely needed fields:
                0156          ELSEIF ( missFldList(j).EQ.'Uvel    ' .OR.
                0157      &            missFldList(j).EQ.'Vvel    ' .OR.
                0158      &            missFldList(j).EQ.'Theta   ' .OR.
                0159      &            missFldList(j).EQ.'Salt    ' .OR.
af24f21bb7 Jean*0160      &            missFldList(j).EQ.'EtaN    ' ) THEN
d6ed4854d6 Jean*0161            stopFlag = .TRUE.
                0162            WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
                0163      &       'cannot restart without field "',missFldList(j),'"'
                0164            CALL PRINT_ERROR( msgBuf, myThid )
                0165 
d2a11ab670 Jean*0166 C-    fields needed for restart (alternative not presently implemented)
af24f21bb7 Jean*0167          ELSEIF ( missFldList(j).EQ.'PhiHyd  ' .OR.
0320e25227 Mart*0168      &            missFldList(j).EQ.'Phi_rLow' .OR.
d2a11ab670 Jean*0169      &            missFldList(j).EQ.'AddMass ' .OR.
af24f21bb7 Jean*0170      &            missFldList(j).EQ.'dEtaHdt ' .OR.
                0171      &            missFldList(j).EQ.'EtaH    ' ) THEN
                0172            stopFlag = .TRUE.
                0173            WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
                0174      &     'cannot currently restart without field "',missFldList(j),'"'
                0175            CALL PRINT_ERROR( msgBuf, myThid )
                0176 
                0177 C-    fields with alternative in place to restart without:
                0178 C-    (but get a non-perfect restart)
d6ed4854d6 Jean*0179          ELSEIF ( missFldList(j).EQ.'GuNm1   ' .OR.
                0180      &            missFldList(j).EQ.'GvNm1   ' ) THEN
                0181            mom_StartAB = 0
                0182          ELSEIF ( missFldList(j).EQ.'GuNm2   ' .OR.
                0183      &            missFldList(j).EQ.'GvNm2   ' ) THEN
                0184            mom_StartAB = MIN( mom_startAB, 1 )
                0185          ELSEIF ( missFldList(j).EQ.'GtNm1   ' .OR.
                0186      &            missFldList(j).EQ.'TempNm1 ' ) THEN
                0187            tempStartAB = 0
                0188          ELSEIF ( missFldList(j).EQ.'GtNm2   ' .OR.
                0189      &            missFldList(j).EQ.'TempNm2 ' ) THEN
                0190            tempStartAB = MIN( tempStartAB, 1 )
                0191          ELSEIF ( missFldList(j).EQ.'GsNm1   ' .OR.
                0192      &            missFldList(j).EQ.'SaltNm1 ' ) THEN
                0193            saltStartAB = 0
                0194          ELSEIF ( missFldList(j).EQ.'GsNm2   ' .OR.
                0195      &            missFldList(j).EQ.'SaltNm2 ' ) THEN
                0196            saltStartAB = MIN( saltStartAB, 1 )
                0197          ELSEIF ( missFldList(j).EQ.'GwNm1   ' ) THEN
                0198            nHydStartAB = 0
cba4501825 Jean*0199          ELSEIF ( missFldList(j).EQ.'GwNm2   ' ) THEN
                0200            nHydStartAB = MIN( nHydStartAB, 1 )
fdf5fb6af0 Jean*0201          ELSEIF ( missFldList(j).EQ.'QH_GwNm1' ) THEN
                0202            qHydStartAB = 0
                0203          ELSEIF ( missFldList(j).EQ.'QH_GwNm2' ) THEN
                0204            qHydStartAB = MIN( qHydStartAB, 1 )
d6ed4854d6 Jean*0205 
                0206          ELSE
                0207 C-    not recognized fields:
                0208            stopFlag = .TRUE.
                0209            WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
                0210      &       'missing field "',missFldList(j),'" not recognized'
                0211            CALL PRINT_ERROR( msgBuf, myThid )
                0212          ENDIF
                0213         ENDDO
                0214 
                0215         IF ( stopFlag ) THEN
                0216          STOP 'ABNORMAL END: S/R CHECK_PICKUP'
                0217         ELSEIF ( pickupStrictlyMatch ) THEN
                0218          WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
                0219      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0220      &      ' in file: "data", NameList: "PARM03"'
                0221          CALL PRINT_ERROR( msgBuf, myThid )
                0222          STOP 'ABNORMAL END: S/R CHECK_PICKUP'
af24f21bb7 Jean*0223         ELSEIF ( warnCnts .GT. 0 ) THEN
4f747a7822 Jean*0224          WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
d6ed4854d6 Jean*0225      &     'Will get only an approximated Restart'
af24f21bb7 Jean*0226          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0227          IF ( mom_StartAB.LT.nIter0 .OR.
                0228      &        nHydStartAB.LT.nIter0 .OR.
                0229      &        tempStartAB.LT.nIter0 .OR.
                0230      &        saltStartAB.LT.nIter0 ) THEN
                0231           WRITE(msgBuf,'(2(A,I10))')
d6ed4854d6 Jean*0232      &     ' Continue with mom_StartAB =', mom_StartAB,
                0233      &                 ' ; nHydStartAB =', nHydStartAB
af24f21bb7 Jean*0234           CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0235           WRITE(msgBuf,'(2(A,I10))')
d6ed4854d6 Jean*0236      &     '          with tempStartAB =', tempStartAB,
                0237      &                 ' ; saltStartAB =', saltStartAB
af24f21bb7 Jean*0238           CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0239          ENDIF
fdf5fb6af0 Jean*0240          IF ( qHydStartAB.LT.nIter0 ) THEN
                0241           WRITE(msgBuf,'(2(A,I10))')
                0242      &     ' Continue with qHydStartAB =', qHydStartAB
                0243           CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0244          ENDIF
d6ed4854d6 Jean*0245         ENDIF
                0246 
                0247        ENDIF
                0248 
                0249       _END_MASTER( myThid )
                0250 c     ENDIF
                0251 
                0252       RETURN
                0253       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!