Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:43:24 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
ae125ba74b Jean*0001 #include "SEAICE_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: SEAICE_CHECK_PICKUP
                0005 C     !INTERFACE:
                0006       SUBROUTINE SEAICE_CHECK_PICKUP(
                0007      I                        missFldList,
                0008      I                        nMissing, nbFields,
                0009      I                        myIter, myThid )
                0010 
                0011 C     !DESCRIPTION:
                0012 C     Check that fields that are needed to restart have been read.
                0013 C     In case some fields are missing, stop if pickupStrictlyMatch=T
                0014 C     or try, if possible, to restart without the missing field.
                0015 
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 
                0019 C     == Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
ccaa3c61f4 Patr*0023 #include "SEAICE_SIZE.h"
ae125ba74b Jean*0024 #include "SEAICE_PARAMS.h"
                0025 #include "SEAICE.h"
ccaa3c61f4 Patr*0026 #include "SEAICE_TRACER.h"
ae125ba74b Jean*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 C     == Local variables ==
                0047 C     nj          :: record & field number
                0048 C     ioUnit      :: temp for writing msg unit
                0049 C     msgBuf      :: Informational/error message buffer
                0050 C     i,j,k       :: loop indices
                0051 C     bi,bj       :: tile indices
bd632d6a0a Jean*0052       INTEGER nj, ioUnit
ae125ba74b Jean*0053       INTEGER tIceFlag, warnCnts
                0054       LOGICAL stopFlag
bd632d6a0a Jean*0055 c     LOGICAL oldIceAge
86b84a92fc Patr*0056 #ifdef SEAICE_ITD
                0057 C     Flag indicating absence of ITD fields such as AREAITD
                0058 C      in this case try to use average fields such as AREA
                0059 C      (program will stop if fields liek AREA are missing)
                0060       LOGICAL useAvgFldsForITD
                0061 #endif
ae125ba74b Jean*0062       CHARACTER*(MAX_LEN_MBUF) msgBuf
ccaa3c61f4 Patr*0063       CHARACTER*(8) fldName
ed6012c5a0 Jean*0064 c     INTEGER i,j,k,bi,bj
e54fe3e1f9 Gael*0065 #ifdef ALLOW_SITRACER
                0066       INTEGER iTracer
ccaa3c61f4 Patr*0067       CHARACTER*(2) fldNum
bd632d6a0a Jean*0068 #endif
ae125ba74b Jean*0069 CEOP
                0070 
                0071 c     IF ( seaice_pickup_read_mdsio ) THEN
                0072 
                0073        IF ( nMissing.GE.1 ) THEN
                0074         ioUnit = errorMessageUnit
                0075         tIceFlag = 0
bd632d6a0a Jean*0076 c       oldIceAge = .TRUE.
ae125ba74b Jean*0077         DO nj=1,nMissing
                0078          IF ( missFldList(nj).EQ.'siTICES ' ) tIceFlag = tIceFlag + 2
                0079          IF ( missFldList(nj).EQ.'siTICE  ' ) tIceFlag = tIceFlag + 1
bd632d6a0a Jean*0080 c        IF ( missFldList(nj).EQ.'siAGE   ' ) oldIceAge = .FALSE.
ae125ba74b Jean*0081         ENDDO
                0082         stopFlag = .FALSE.
86b84a92fc Patr*0083 #ifdef SEAICE_ITD
                0084         useAvgFldsForITD = .FALSE.
                0085 #endif
ae125ba74b Jean*0086         warnCnts = nMissing
ccaa3c61f4 Patr*0087 
ae125ba74b Jean*0088         DO nj=1,nMissing
ccaa3c61f4 Patr*0089          fldName = missFldList(nj)
38af4b423b Jean*0090          IF     ( fldName.EQ.'siTICE  ' .AND. tIceFlag.LE.1 ) THEN
ae125ba74b Jean*0091           IF ( .NOT.pickupStrictlyMatch ) THEN
38af4b423b Jean*0092            _BEGIN_MASTER( myThid )
e2d4045aec Jean*0093            WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
bd632d6a0a Jean*0094      &      ' restart with Tice from 1rst category'
ae125ba74b Jean*0095            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
38af4b423b Jean*0096            _END_MASTER( myThid )
ae125ba74b Jean*0097           ENDIF
38af4b423b Jean*0098          ELSEIF ( fldName.EQ.'siTICES ' .AND. tIceFlag.LE.2 ) THEN
                0099           IF ( .NOT.pickupStrictlyMatch .AND. SEAICE_multDim.GT.1 ) THEN
                0100            _BEGIN_MASTER( myThid )
e2d4045aec Jean*0101            WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
bd632d6a0a Jean*0102      &      ' restart from single category Tice (copied to TICES)'
ae125ba74b Jean*0103            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
38af4b423b Jean*0104            _END_MASTER( myThid )
0bc24de323 Mart*0105 C     copy TICE -> TICES, already done in s/r seaice_read_pickup
ae125ba74b Jean*0106           ENDIF
ccaa3c61f4 Patr*0107          ELSEIF ( fldName(1:6).EQ.'siSigm' ) THEN
ae125ba74b Jean*0108 C- Note: try to restart without Sigma1,2,12 (as if SEAICEuseEVPpickup=F)
                0109 C        An alternative would be to restart only if SEAICEuseEVPpickup=F:
                0110 C        if SEAICEuseEVPpickup then stop / else warning / endif
                0111           IF ( .NOT.pickupStrictlyMatch ) THEN
38af4b423b Jean*0112            _BEGIN_MASTER( myThid )
e2d4045aec Jean*0113            WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
bd632d6a0a Jean*0114      &      ' restart without "',fldName,'" (set to zero)'
ae125ba74b Jean*0115            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
38af4b423b Jean*0116            _END_MASTER( myThid )
ae125ba74b Jean*0117           ENDIF
6cbc659de0 Mart*0118          ELSEIF ( fldName(1:8).EQ.'siUicNm1' .OR.
                0119      &            fldName(1:8).EQ.'siVicNm1' ) THEN
                0120           IF ( .NOT.pickupStrictlyMatch ) THEN
                0121 C     print a warning and restart anyway
e501eee760 Mart*0122            SEAICEmomStartBDF = 0
6cbc659de0 Mart*0123            _BEGIN_MASTER( myThid )
                0124            WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
                0125      &      ' restart without "',fldName,'" (set to zero)'
                0126            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0127            _END_MASTER( myThid )
                0128           ENDIF
ccaa3c61f4 Patr*0129          ELSEIF ( fldName.EQ.'siTICES ' .OR.
                0130      &            fldName.EQ.'siTICE  ' .OR.
                0131      &            fldName.EQ.'siUICE  ' .OR.
                0132      &            fldName.EQ.'siVICE  ' .OR.
                0133      &            fldName.EQ.'siAREA  ' .OR.
                0134      &            fldName.EQ.'siHEFF  ' .OR.
                0135      &            fldName.EQ.'siHSNOW ' .OR.
                0136      &            fldName.EQ.'siHSALT ' ) THEN
ae125ba74b Jean*0137            stopFlag = .TRUE.
38af4b423b Jean*0138            _BEGIN_MASTER( myThid )
ae125ba74b Jean*0139            WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
ccaa3c61f4 Patr*0140      &       'cannot restart without field "',fldName,'"'
ae125ba74b Jean*0141            CALL PRINT_ERROR( msgBuf, myThid )
38af4b423b Jean*0142            _END_MASTER( myThid )
86b84a92fc Patr*0143 #ifdef SEAICE_ITD
                0144          ELSEIF ( fldName.EQ.'siAREAn ' .OR.
                0145      &            fldName.EQ.'siHEFFn ' .OR.
346a7f9e71 Jean*0146      &            fldName.EQ.'siHSNOWn' ) THEN
86b84a92fc Patr*0147           IF ( .NOT.pickupStrictlyMatch ) THEN
                0148 C          generate ITD from mean ice thickness
                0149            useAvgFldsForITD = .TRUE.
346a7f9e71 Jean*0150           ELSE
                0151 C          if strict match is requested
86b84a92fc Patr*0152 C          run will bestopped in case of missing ITD fields
                0153            stopFlag = .TRUE.
                0154            WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
                0155      &       'cannot restart without ITD field "',fldName,'"'
                0156            CALL PRINT_ERROR( msgBuf, myThid )
346a7f9e71 Jean*0157           ENDIF
86b84a92fc Patr*0158 #endif
e54fe3e1f9 Gael*0159 #ifdef ALLOW_SITRACER
                0160          ELSEIF ( fldName(1:6).EQ.'siTrac' ) THEN
38af4b423b Jean*0161            IF ( .NOT.pickupStrictlyMatch ) THEN
                0162             _BEGIN_MASTER( myThid )
                0163             DO iTracer = 1, SItrMaxNum
                0164              WRITE(fldNum,'(I2.2)') iTracer
                0165              IF ( fldName(7:8).EQ.fldNum ) THEN
                0166               WRITE(msgBuf,'(4A)')
                0167      &         '** WARNING ** SEAICE_CHECK_PICKUP: ',
e54fe3e1f9 Gael*0168      &         'restart without "',fldName,'" (set to zero)'
38af4b423b Jean*0169               CALL PRINT_MESSAGE(
e54fe3e1f9 Gael*0170      &         msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0171              ENDIF
38af4b423b Jean*0172             ENDDO
                0173             _END_MASTER( myThid )
                0174            ENDIF
e54fe3e1f9 Gael*0175 #endif /* ALLOW_SITRACER */
ae125ba74b Jean*0176          ELSE
                0177 C-    not recognized fields:
                0178            stopFlag = .TRUE.
38af4b423b Jean*0179            _BEGIN_MASTER( myThid )
ae125ba74b Jean*0180            WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
ccaa3c61f4 Patr*0181      &       'missing field "',fldName,'" not recognized'
ae125ba74b Jean*0182            CALL PRINT_ERROR( msgBuf, myThid )
38af4b423b Jean*0183            _END_MASTER( myThid )
ae125ba74b Jean*0184          ENDIF
                0185 C-    end nj loop
                0186         ENDDO
                0187 
                0188         IF ( stopFlag ) THEN
                0189          STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
                0190         ELSEIF ( pickupStrictlyMatch ) THEN
38af4b423b Jean*0191          _BEGIN_MASTER( myThid )
ae125ba74b Jean*0192          WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
                0193      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0194      &      ' in file: "data", NameList: "PARM03"'
                0195          CALL PRINT_ERROR( msgBuf, myThid )
38af4b423b Jean*0196          _END_MASTER( myThid )
ae125ba74b Jean*0197          STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
                0198         ELSEIF ( warnCnts .GT. 0 ) THEN
38af4b423b Jean*0199          _BEGIN_MASTER( myThid )
86b84a92fc Patr*0200 #ifdef SEAICE_ITD
346a7f9e71 Jean*0201          IF ( useAvgFldsForITD ) THEN
86b84a92fc Patr*0202           WRITE(msgBuf,'(3A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
                0203      &     ' no ITD fields available, restart from single category',
32cea6ae05 Mart*0204      &     ' fields,'
                0205           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0206           WRITE(msgBuf,'(2A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
                0207      &     ' i.e. AREA -> AREAITD, HEFF -> HEFFITD, etc.'
86b84a92fc Patr*0208           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
346a7f9e71 Jean*0209           CALL SEAICE_ITD_PICKUP( myIter, myThid )
                0210          ENDIF
86b84a92fc Patr*0211 #endif
e2d4045aec Jean*0212          WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP: ',
ae125ba74b Jean*0213      &     'Will get only an approximated Restart'
                0214          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
38af4b423b Jean*0215          _END_MASTER( myThid )
ae125ba74b Jean*0216         ENDIF
                0217 
                0218        ENDIF
                0219 
                0220 C--   end: seaice_pickup_read_mdsio
                0221 c     ENDIF
                0222 
                0223 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0224 
                0225       RETURN
                0226       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!