C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_check_pickup.F,v 1.15 2016/04/28 15:42:03 mlosch Exp $ C $Name: $ #include "SEAICE_OPTIONS.h" CBOP C !ROUTINE: SEAICE_CHECK_PICKUP C !INTERFACE: SUBROUTINE SEAICE_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 C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" #include "SEAICE_TRACER.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: C == Local variables == C nj :: record & field number C ioUnit :: temp for writing msg unit C msgBuf :: Informational/error message buffer C i,j,k :: loop indices C bi,bj :: tile indices INTEGER nj, ioUnit INTEGER tIceFlag, warnCnts LOGICAL stopFlag c LOGICAL oldIceAge #ifdef SEAICE_ITD C Flag indicating absence of ITD fields such as AREAITD C in this case try to use average fields such as AREA C (program will stop if fields liek AREA are missing) LOGICAL useAvgFldsForITD #endif CHARACTER*(MAX_LEN_MBUF) msgBuf CHARACTER*(8) fldName c INTEGER i,j,k,bi,bj #ifdef ALLOW_SITRACER INTEGER iTracer CHARACTER*(2) fldNum #endif CEOP c IF ( seaice_pickup_read_mdsio ) THEN IF ( nMissing.GE.1 ) THEN ioUnit = errorMessageUnit tIceFlag = 0 c oldIceAge = .TRUE. DO nj=1,nMissing IF ( missFldList(nj).EQ.'siTICES ' ) tIceFlag = tIceFlag + 2 IF ( missFldList(nj).EQ.'siTICE ' ) tIceFlag = tIceFlag + 1 c IF ( missFldList(nj).EQ.'siAGE ' ) oldIceAge = .FALSE. ENDDO stopFlag = .FALSE. #ifdef SEAICE_ITD useAvgFldsForITD = .FALSE. #endif warnCnts = nMissing DO nj=1,nMissing fldName = missFldList(nj) IF ( fldName.EQ.'siTICE ' .AND. tIceFlag.LE.1 ) THEN IF ( .NOT.pickupStrictlyMatch ) THEN _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' restart with Tice from 1rst category' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) ENDIF ELSEIF ( fldName.EQ.'siTICES ' .AND. tIceFlag.LE.2 ) THEN IF ( .NOT.pickupStrictlyMatch .AND. SEAICE_multDim.GT.1 ) THEN _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' restart from single category Tice (copied to TICES)' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) C copy TICE -> TICES, already done in s/r seaice_read_pickup ENDIF ELSEIF ( fldName(1:6).EQ.'siSigm' ) THEN C- Note: try to restart without Sigma1,2,12 (as if SEAICEuseEVPpickup=F) C An alternative would be to restart only if SEAICEuseEVPpickup=F: C if SEAICEuseEVPpickup then stop / else warning / endif IF ( .NOT.pickupStrictlyMatch ) THEN _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' restart without "',fldName,'" (set to zero)' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) ENDIF ELSEIF ( fldName(1:8).EQ.'siUicNm1' .OR. & fldName(1:8).EQ.'siVicNm1' ) THEN IF ( .NOT.pickupStrictlyMatch ) THEN C print a warning and restart anyway SEAICEmomStartBDF = 0 _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' restart without "',fldName,'" (set to zero)' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) ENDIF ELSEIF ( fldName.EQ.'siTICES ' .OR. & fldName.EQ.'siTICE ' .OR. & fldName.EQ.'siUICE ' .OR. & fldName.EQ.'siVICE ' .OR. & fldName.EQ.'siAREA ' .OR. & fldName.EQ.'siHEFF ' .OR. & fldName.EQ.'siHSNOW ' .OR. & fldName.EQ.'siHSALT ' ) THEN stopFlag = .TRUE. _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ', & 'cannot restart without field "',fldName,'"' CALL PRINT_ERROR( msgBuf, myThid ) _END_MASTER( myThid ) #ifdef SEAICE_ITD ELSEIF ( fldName.EQ.'siAREAn ' .OR. & fldName.EQ.'siHEFFn ' .OR. & fldName.EQ.'siHSNOWn' ) THEN IF ( .NOT.pickupStrictlyMatch ) THEN C generate ITD from mean ice thickness useAvgFldsForITD = .TRUE. ELSE C if strict match is requested C run will bestopped in case of missing ITD fields stopFlag = .TRUE. WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ', & 'cannot restart without ITD field "',fldName,'"' CALL PRINT_ERROR( msgBuf, myThid ) ENDIF #endif #ifdef ALLOW_SITRACER ELSEIF ( fldName(1:6).EQ.'siTrac' ) THEN IF ( .NOT.pickupStrictlyMatch ) THEN _BEGIN_MASTER( myThid ) DO iTracer = 1, SItrMaxNum WRITE(fldNum,'(I2.2)') iTracer IF ( fldName(7:8).EQ.fldNum ) THEN WRITE(msgBuf,'(4A)') & '** WARNING ** SEAICE_CHECK_PICKUP: ', & 'restart without "',fldName,'" (set to zero)' CALL PRINT_MESSAGE( & msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) ENDIF ENDDO _END_MASTER( myThid ) ENDIF #endif /* ALLOW_SITRACER */ ELSE C- not recognized fields: stopFlag = .TRUE. _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ', & 'missing field "',fldName,'" not recognized' CALL PRINT_ERROR( msgBuf, myThid ) _END_MASTER( myThid ) ENDIF C- end nj loop ENDDO IF ( stopFlag ) THEN STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP' ELSEIF ( pickupStrictlyMatch ) THEN _BEGIN_MASTER( myThid ) WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ', & 'try with " pickupStrictlyMatch=.FALSE.,"', & ' in file: "data", NameList: "PARM03"' CALL PRINT_ERROR( msgBuf, myThid ) _END_MASTER( myThid ) STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP' ELSEIF ( warnCnts .GT. 0 ) THEN _BEGIN_MASTER( myThid ) #ifdef SEAICE_ITD IF ( useAvgFldsForITD ) THEN WRITE(msgBuf,'(3A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' no ITD fields available, restart from single category', & ' fields,' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(2A)') '** WARNING ** SEAICE_CHECK_PICKUP:', & ' i.e. AREA -> AREAITD, HEFF -> HEFFITD, etc.' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) CALL SEAICE_ITD_PICKUP( myIter, myThid ) ENDIF #endif WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP: ', & 'Will get only an approximated Restart' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) ENDIF ENDIF C-- end: seaice_pickup_read_mdsio c ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| RETURN END