pkg/ptracers/ptracers_check_pickup.F

804ee8c862 Jean*0001 #include "PTRACERS_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: PTRACERS_CHECK_PICKUP
                0006 C     !INTERFACE:
                0007       SUBROUTINE PTRACERS_CHECK_PICKUP(
                0008      I                 missFldList,
                0009      I                 nMissing, nbFields,
                0010      I                 myIter, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     Check that fields that are needed to restart have been read.
                0014 C     In case some fields are missing, stop if pickupStrictlyMatch=T
                0015 C     or try, if possible, to restart without the missing field.
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "PTRACERS_SIZE.h"
                0023 #include "PTRACERS_PARAMS.h"
9b39915e34 Jean*0024 #include "PTRACERS_START.h"
804ee8c862 Jean*0025
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     missFldList :: List of missing fields   (attempted to read but not found)
                0028 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0029 C     nbFields    :: number of fields in pickup file (read from meta file)
                0030 C     myIter      :: Iteration number
                0031 C     myThid      :: my Thread Id. number
                0032       CHARACTER*(8) missFldList(*)
                0033       INTEGER nMissing
                0034       INTEGER nbFields
                0035       INTEGER myIter
                0036       INTEGER myThid
                0037 CEOP
                0038
                0039 C     !FUNCTIONS
                0040       INTEGER  ILNBLNK
                0041       EXTERNAL ILNBLNK
                0042
                0043 C     !LOCAL VARIABLES:
                0044       INTEGER i, iTracer
                0045       INTEGER j
                0046       INTEGER ioUnit
                0047       INTEGER warnCnts
                0048       LOGICAL stopFlag
                0049       CHARACTER*(8) fldName
fc10d43a89 Jean*0050       CHARACTER*(2) ioLabel
804ee8c862 Jean*0051       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0052
                0053       ioUnit = errorMessageUnit
                0054
                0055       _BEGIN_MASTER( myThid )
                0056
                0057        IF ( nMissing.GE.1 ) THEN
                0058         stopFlag = .FALSE.
                0059         warnCnts = nMissing
                0060         DO j=1,nMissing
                0061          fldName = missFldList(j)
fc10d43a89 Jean*0062
804ee8c862 Jean*0063 C     find the corresponding pTracer:
fc10d43a89 Jean*0064          IF ( fldName(1:3).EQ.'pTr' ) THEN
                0065            ioLabel = fldName(4:5)
                0066          ELSEIF ( fldName(1:4).EQ.'gPtr' ) THEN
                0067            ioLabel = fldName(5:6)
                0068          ELSE
                0069            ioLabel = '  '
                0070          ENDIF
                0071          iTracer = 0
                0072          DO i=1,PTRACERS_numInUse
                0073            IF ( iTracer.EQ.0 .AND.
                0074      &          ioLabel.EQ.PTRACERS_ioLabel(i) ) iTracer = i
                0075          ENDDO
                0076
                0077 C-    passive tracer field is always needed:
                0078          IF ( iTracer.GT.0 .AND.
                0079      &        fldName(1:3).EQ.'pTr' .AND. fldName(6:8).EQ.'   ' ) THEN
                0080            stopFlag = .TRUE.
                0081            WRITE(msgBuf,'(2A,I4,3A)') 'PTRACERS_CHECK_PICKUP: ',
804ee8c862 Jean*0082      &       'cannot restart without tracer ',iTracer,
                0083      &       ' field "',fldName,'"'
fc10d43a89 Jean*0084            CALL PRINT_ERROR( msgBuf, myThid )
804ee8c862 Jean*0085
                0086 C-    fields with alternative in place to restart without:
                0087 C-    (but get a non-perfect restart)
fc10d43a89 Jean*0088          ELSEIF ( iTracer.GT.0 .AND. (
                0089      &      ( fldName(1:4).EQ.'gPtr' .AND. fldName(7:8).EQ.'m1' ) .OR.
                0090      &      ( fldName(1:3).EQ.'pTr' .AND. fldName(6:8).EQ.'Nm1' )
                0091      &                               ) ) THEN
                0092            PTRACERS_startAB(iTracer) = 0
                0093            IF ( fldName(1:4).EQ.'gPtr' ) WRITE(msgBuf,'(2A,I4)')
4f747a7822 Jean*0094      &        '** WARNING ** PTRACERS_CHECK_PICKUP: ',
804ee8c862 Jean*0095      &        'tracer Tendency is missing for pTr# :',iTracer
fc10d43a89 Jean*0096            IF ( fldName(1:3).EQ.'pTr' )  WRITE(msgBuf,'(2A,I4)')
4f747a7822 Jean*0097      &        '** WARNING ** PTRACERS_CHECK_PICKUP: ',
fc10d43a89 Jean*0098      &        'tracer @ iter-1 is missing for pTr# :',iTracer
                0099            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0100            IF ( .NOT.pickupStrictlyMatch .AND. .NOT.stopFlag ) THEN
                0101              WRITE(msgBuf,'(3A,I4)') '** WARNING ** ',
                0102      &        '1rst time-step will use simple Euler time-stepping',
                0103      &        ' for pTr# ',iTracer
804ee8c862 Jean*0104              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0105            ENDIF
                0106
                0107          ELSE
                0108 C-    unrecognized field:
                0109            iTracer = 0
                0110          ENDIF
                0111
                0112 C-    unrecognized field or tracer:
                0113          IF ( iTracer.EQ.0 ) THEN
                0114            stopFlag = .TRUE.
                0115            WRITE(msgBuf,'(4A)') 'PTRACERS_CHECK_PICKUP: ',
                0116      &       'missing field "',missFldList(j),'" not recognized'
                0117            CALL PRINT_ERROR( msgBuf, myThid )
                0118          ENDIF
                0119         ENDDO
                0120
                0121         IF ( stopFlag ) THEN
                0122          STOP 'ABNORMAL END: S/R PTRACERS_CHECK_PICKUP'
                0123         ELSEIF ( pickupStrictlyMatch ) THEN
                0124          WRITE(msgBuf,'(4A)') 'PTRACERS_CHECK_PICKUP: ',
fc10d43a89 Jean*0125      &      'try "pickupStrictlyMatch=.FALSE.,"',
                0126      &      ' in file: "data" (NameList PARM03)'
804ee8c862 Jean*0127          CALL PRINT_ERROR( msgBuf, myThid )
                0128          STOP 'ABNORMAL END: S/R PTRACERS_CHECK_PICKUP'
                0129         ELSEIF ( warnCnts .GT. 0 ) THEN
4f747a7822 Jean*0130          WRITE(msgBuf,'(4A)') '** WARNING ** PTRACERS_CHECK_PICKUP: ',
804ee8c862 Jean*0131      &     'Will get only an approximated Restart'
                0132          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0133         ENDIF
                0134
                0135        ENDIF
                0136
                0137       _END_MASTER( myThid )
                0138
                0139       RETURN
                0140       END