C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_check_pickup.F,v 1.4 2014/08/18 14:34:27 jmc Exp $
C $Name: $
#include "PTRACERS_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: PTRACERS_CHECK_PICKUP
C !INTERFACE:
SUBROUTINE PTRACERS_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 "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "PTRACERS_START.h"
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 i, iTracer
INTEGER j
INTEGER ioUnit
INTEGER warnCnts
LOGICAL stopFlag
CHARACTER*(8) fldName
CHARACTER*(2) ioLabel
CHARACTER*(MAX_LEN_MBUF) msgBuf
ioUnit = errorMessageUnit
_BEGIN_MASTER( myThid )
IF ( nMissing.GE.1 ) THEN
stopFlag = .FALSE.
warnCnts = nMissing
DO j=1,nMissing
fldName = missFldList(j)
C find the corresponding pTracer:
IF ( fldName(1:3).EQ.'pTr' ) THEN
ioLabel = fldName(4:5)
ELSEIF ( fldName(1:4).EQ.'gPtr' ) THEN
ioLabel = fldName(5:6)
ELSE
ioLabel = ' '
ENDIF
iTracer = 0
DO i=1,PTRACERS_numInUse
IF ( iTracer.EQ.0 .AND.
& ioLabel.EQ.PTRACERS_ioLabel(i) ) iTracer = i
ENDDO
C- passive tracer field is always needed:
IF ( iTracer.GT.0 .AND.
& fldName(1:3).EQ.'pTr' .AND. fldName(6:8).EQ.' ' ) THEN
stopFlag = .TRUE.
WRITE(msgBuf,'(2A,I4,3A)') 'PTRACERS_CHECK_PICKUP: ',
& 'cannot restart without tracer ',iTracer,
& ' field "',fldName,'"'
CALL PRINT_ERROR( msgBuf, myThid )
C- fields with alternative in place to restart without:
C- (but get a non-perfect restart)
ELSEIF ( iTracer.GT.0 .AND. (
& ( fldName(1:4).EQ.'gPtr' .AND. fldName(7:8).EQ.'m1' ) .OR.
& ( fldName(1:3).EQ.'pTr' .AND. fldName(6:8).EQ.'Nm1' )
& ) ) THEN
PTRACERS_startAB(iTracer) = 0
IF ( fldName(1:4).EQ.'gPtr' ) WRITE(msgBuf,'(2A,I4)')
& '** WARNING ** PTRACERS_CHECK_PICKUP: ',
& 'tracer Tendency is missing for pTr# :',iTracer
IF ( fldName(1:3).EQ.'pTr' ) WRITE(msgBuf,'(2A,I4)')
& '** WARNING ** PTRACERS_CHECK_PICKUP: ',
& 'tracer @ iter-1 is missing for pTr# :',iTracer
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
IF ( .NOT.pickupStrictlyMatch .AND. .NOT.stopFlag ) THEN
WRITE(msgBuf,'(3A,I4)') '** WARNING ** ',
& '1rst time-step will use simple Euler time-stepping',
& ' for pTr# ',iTracer
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ELSE
C- unrecognized field:
iTracer = 0
ENDIF
C- unrecognized field or tracer:
IF ( iTracer.EQ.0 ) THEN
stopFlag = .TRUE.
WRITE(msgBuf,'(4A)') 'PTRACERS_CHECK_PICKUP: ',
& 'missing field "',missFldList(j),'" not recognized'
CALL PRINT_ERROR( msgBuf, myThid )
ENDIF
ENDDO
IF ( stopFlag ) THEN
STOP 'ABNORMAL END: S/R PTRACERS_CHECK_PICKUP'
ELSEIF ( pickupStrictlyMatch ) THEN
WRITE(msgBuf,'(4A)') 'PTRACERS_CHECK_PICKUP: ',
& 'try "pickupStrictlyMatch=.FALSE.,"',
& ' in file: "data" (NameList PARM03)'
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R PTRACERS_CHECK_PICKUP'
ELSEIF ( warnCnts .GT. 0 ) THEN
WRITE(msgBuf,'(4A)') '** WARNING ** PTRACERS_CHECK_PICKUP: ',
& 'Will get only an approximated Restart'
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ENDIF
ENDIF
_END_MASTER( myThid )
RETURN
END