C $Header: /u/gcmpack/MITgcm/model/src/check_pickup.F,v 1.6 2015/01/20 20:46:55 jmc Exp $
C $Name: $
c#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: CHECK_PICKUP
C !INTERFACE:
SUBROUTINE CHECK_PICKUP(
I missFldList,
I nMissing, nbFields,
I myIter, myThid )
C !DESCRIPTION:
C Check that fields that are needed to restart have been read.
C In case some fields are missing, stop if pickupStrictlyMatch=T
C or try, if possible, to restart without the missing field.
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "RESTART.h"
c#ifdef ALLOW_GENERIC_ADVDIFF
c# include "GAD.h"
c#endif
C !INPUT/OUTPUT PARAMETERS:
C missFldList :: List of missing fields (attempted to read but not found)
C nMissing :: Number of missing fields (attempted to read but not found)
C nbFields :: number of fields in pickup file (read from meta file)
C myIter :: Iteration number
C myThid :: my Thread Id. number
CHARACTER*(8) missFldList(*)
INTEGER nMissing
INTEGER nbFields
INTEGER myIter
INTEGER myThid
CEOP
C !FUNCTIONS
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
INTEGER j
INTEGER ioUnit
INTEGER warnCnts
LOGICAL stopFlag
CHARACTER*(MAX_LEN_MBUF) msgBuf
ioUnit = errorMessageUnit
c IF (pickup_read_mdsio) THEN
_BEGIN_MASTER( myThid )
IF ( nbFields.GE.1 ) THEN
C- flag startFromPickupAB2 is becoming obsolete with new way to read
C pickup file: cancel its effect (from initialisation) by resetting
C start-AB parameters:
tempStartAB = nIter0
saltStartAB = nIter0
mom_StartAB = nIter0
nHydStartAB = nIter0
ENDIF
IF ( selectNHfreeSurf.GE.1 ) THEN
IF ( nbFields.EQ.0 ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart like hydrostatic free-surf (dPhiNH missing)'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ELSE
C- assume reading dPhiNH was OK (otherwise expected in missing field list)
dPhiNHstatus = 1
ENDIF
ENDIF
IF ( nMissing.GE.1 ) THEN
stopFlag = .FALSE.
warnCnts = nMissing
DO j=1,nMissing
C- Case where missing field is not essential or can be recomputed
IF ( missFldList(j).EQ.'dEtaHdt '
& .AND. .NOT.useRealFreshWaterFlux ) THEN
warnCnts = warnCnts - 1
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') ' CHECK_PICKUP: ',
& 'no RealFreshWaterFlux => can restart without "dEtaHdt "'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSEIF ( missFldList(j).EQ.'dPhiNH '
& .AND. implicitNHPress.EQ.1. _d 0 ) THEN
warnCnts = warnCnts - 1
dPhiNHstatus = 0
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') ' CHECK_PICKUP: ',
& 'fully Implic.NH-Press => can restart without "dPhiNH "'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
C- Old pickup for which special code takes care of missing fields
ELSEIF ( missFldList(j).EQ.'dEtaHdt '
& .AND.usePickupBeforeC54 ) THEN
C- with RealFreshWaterFlux, needs dEtaHdt to restart when:
C * synchronousTimeStep & usingPCoords => needs PmEpR for surf-forcing
C <- present code might be wrong if usePickupBeforeC54 and LinFS
C * synchronousTimeStep & nonlinFreeSurf > 0 => needs PmEpR for surf-forcing
C * select_rStar <> 0 => needs dEtaHdt for 1rst Integr_continuity
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart as before C54 without "dEtaHdt "'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
C- fields used only to speed-up solver(s) convergence:
C (no serious problems expected if missing, but get a non-perfect restart)
ELSEIF ( missFldList(j).EQ.'EtaN '
& .AND. rigidLid ) THEN
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart with 1rst guess == 0 for CG2D solver'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSEIF ( missFldList(j).EQ.'Phi_NHyd' ) THEN
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart with 1rst guess == 0 for CG3D solver'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSEIF ( missFldList(j).EQ.'dPhiNH ' ) THEN
dPhiNHstatus = 0
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart like hydrostatic free-surf (dPhiNH missing)'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSEIF ( missFldList(j).EQ.'AddMass '
& .AND. selectAddFluid.EQ.2 ) THEN
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart with AddMass == 0'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSEIF ( missFldList(j).EQ.'FricHeat' ) THEN
IF ( .NOT.pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'restart with Frictional Dissipation Heating == 0'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
C- Absolutely needed fields:
ELSEIF ( missFldList(j).EQ.'Uvel ' .OR.
& missFldList(j).EQ.'Vvel ' .OR.
& missFldList(j).EQ.'Theta ' .OR.
& missFldList(j).EQ.'Salt ' .OR.
& missFldList(j).EQ.'EtaN ' ) THEN
stopFlag = .TRUE.
WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
& 'cannot restart without field "',missFldList(j),'"'
CALL PRINT_ERROR( msgBuf, myThid )
C- fields needed for restart (alternative not presently implemented)
ELSEIF ( missFldList(j).EQ.'PhiHyd ' .OR.
& missFldList(j).EQ.'AddMass ' .OR.
& missFldList(j).EQ.'dEtaHdt ' .OR.
& missFldList(j).EQ.'EtaH ' ) THEN
stopFlag = .TRUE.
WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
& 'cannot currently restart without field "',missFldList(j),'"'
CALL PRINT_ERROR( msgBuf, myThid )
C- fields with alternative in place to restart without:
C- (but get a non-perfect restart)
ELSEIF ( missFldList(j).EQ.'GuNm1 ' .OR.
& missFldList(j).EQ.'GvNm1 ' ) THEN
mom_StartAB = 0
ELSEIF ( missFldList(j).EQ.'GuNm2 ' .OR.
& missFldList(j).EQ.'GvNm2 ' ) THEN
mom_StartAB = MIN( mom_startAB, 1 )
ELSEIF ( missFldList(j).EQ.'GtNm1 ' .OR.
& missFldList(j).EQ.'TempNm1 ' ) THEN
tempStartAB = 0
ELSEIF ( missFldList(j).EQ.'GtNm2 ' .OR.
& missFldList(j).EQ.'TempNm2 ' ) THEN
tempStartAB = MIN( tempStartAB, 1 )
ELSEIF ( missFldList(j).EQ.'GsNm1 ' .OR.
& missFldList(j).EQ.'SaltNm1 ' ) THEN
saltStartAB = 0
ELSEIF ( missFldList(j).EQ.'GsNm2 ' .OR.
& missFldList(j).EQ.'SaltNm2 ' ) THEN
saltStartAB = MIN( saltStartAB, 1 )
ELSEIF ( missFldList(j).EQ.'GwNm1 ' ) THEN
nHydStartAB = 0
ELSEIF ( missFldList(j).EQ.'GwNm2 ' ) THEN
nHydStartAB = MIN( nHydStartAB, 1 )
ELSE
C- not recognized fields:
stopFlag = .TRUE.
WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
& 'missing field "',missFldList(j),'" not recognized'
CALL PRINT_ERROR( msgBuf, myThid )
ENDIF
ENDDO
IF ( stopFlag ) THEN
STOP 'ABNORMAL END: S/R CHECK_PICKUP'
ELSEIF ( pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') 'CHECK_PICKUP: ',
& 'try with " pickupStrictlyMatch=.FALSE.,"',
& ' in file: "data", NameList: "PARM03"'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R CHECK_PICKUP'
ELSEIF ( warnCnts .GT. 0 ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** CHECK_PICKUP: ',
& 'Will get only an approximated Restart'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
IF ( mom_StartAB.LT.nIter0 .OR.
& nHydStartAB.LT.nIter0 .OR.
& tempStartAB.LT.nIter0 .OR.
& saltStartAB.LT.nIter0 ) THEN
WRITE(msgBuf,'(2(A,I10))')
& ' Continue with mom_StartAB =', mom_StartAB,
& ' ; nHydStartAB =', nHydStartAB
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2(A,I10))')
& ' with tempStartAB =', tempStartAB,
& ' ; saltStartAB =', saltStartAB
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ENDIF
ENDIF
_END_MASTER( myThid )
c ENDIF
RETURN
END