itd/code/seaice_check_pickup.F

C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_check_pickup.F,v 1.7 2012/03/05 15:21:44 gforget 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 ILNBLNK

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
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      CHARACTER*(8) fldName
      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.
        warnCnts = nMissing

        DO nj=1,nMissing
         fldName = missFldList(nj)
         IF     ( fldName.EQ.'siTICE  '
     &                      .AND. tIceFlag.LE.1 ) THEN
          IF ( .NOT.pickupStrictlyMatch ) THEN
           WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
     &      ' restart with Tice from 1rst category'
           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
          ENDIF
         ELSEIF ( fldName.EQ.'siTICES '
     &                      .AND. tIceFlag.LE.2 ) THEN
          IF (SEAICE_multDim.GT.1) THEN
          IF ( .NOT.pickupStrictlyMatch ) THEN
           WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
     &      ' restart from single category Tice (copied to TICES)'
           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
C      copy TICE -> TICES
           DO bj=myByLo(myThid),myByHi(myThid)
            DO bi=myBxLo(myThid),myBxHi(myThid)
             DO k=1,MULTDIM
              DO j=1-OLy,sNy+OLy
               DO i=1-OLx,sNx+OLx
                TICES(i,j,k,bi,bj) = TICE(i,j,bi,bj)
               ENDDO
              ENDDO
             ENDDO
            ENDDO
           ENDDO
          ENDIF
          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
           WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP:',
     &      ' restart without "',fldName,'" (set to zero)'
           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, 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.
           WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
     &       'cannot restart without field "',fldName,'"'
           CALL PRINT_ERROR( msgBuf, myThid )
#ifdef ALLOW_SITRACER
         ELSEIF ( fldName(1:6).EQ.'siTrac' ) THEN
           DO iTracer = 1, SItrMaxNum
            WRITE(fldNum,'(I2.2)') iTracer
            IF ( fldName(7:8).EQ.fldNum ) THEN
             IF ( .NOT.pickupStrictlyMatch ) THEN
              WRITE(msgBuf,'(4A)') 
     &         '** WARNINGS ** SEAICE_CHECK_PICKUP: ',
     &         'restart without "',fldName,'" (set to zero)'
              CALL PRINT_MESSAGE( 
     &         msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
             ENDIF
            ENDIF
           ENDDO
#endif /* ALLOW_SITRACER */
         ELSE
C-    not recognized fields:
           stopFlag = .TRUE.
           WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
     &       'missing field "',fldName,'" not recognized'
           CALL PRINT_ERROR( msgBuf, myThid )
         ENDIF
C-    end nj loop
        ENDDO

        IF ( stopFlag ) THEN
         STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
        ELSEIF ( pickupStrictlyMatch ) THEN
         WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
     &      'try with " pickupStrictlyMatch=.FALSE.,"',
     &      ' in file: "data", NameList: "PARM03"'
         CALL PRINT_ERROR( msgBuf, myThid )
         STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
        ELSEIF ( warnCnts .GT. 0 ) THEN
         WRITE(msgBuf,'(4A)') '** WARNING ** SEAICE_CHECK_PICKUP: ',
     &     'Will get only an approximated Restart'
         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
        ENDIF

       ENDIF

C--   end: seaice_pickup_read_mdsio
c     ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      RETURN
      END
1	dimitri	1.1	C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_check_pickup.F,v 1.7 2012/03/05 15:21:44 gforget Exp $
2			C $Name: $
3
4			#include "SEAICE_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: SEAICE_CHECK_PICKUP
8			C !INTERFACE:
9			SUBROUTINE SEAICE_CHECK_PICKUP(
10			I missFldList,
11			I nMissing, nbFields,
12			I myIter, myThid )
13
14
15			C !DESCRIPTION:
16			C Check that fields that are needed to restart have been read.
17			C In case some fields are missing, stop if pickupStrictlyMatch=T
18			C or try, if possible, to restart without the missing field.
19
20			C !USES:
21			IMPLICIT NONE
22
23			C == Global variables ===
24			#include "SIZE.h"
25			#include "EEPARAMS.h"
26			#include "PARAMS.h"
27			#include "SEAICE_SIZE.h"
28			#include "SEAICE_PARAMS.h"
29			#include "SEAICE.h"
30			#include "SEAICE_TRACER.h"
31
32			C !INPUT/OUTPUT PARAMETERS:
33			C missFldList :: List of missing fields (attempted to read but not found)
34			C nMissing :: Number of missing fields (attempted to read but not found)
35			C nbFields :: number of fields in pickup file (read from meta file)
36			C myIter :: Iteration number
37			C myThid :: my Thread Id. number
38			CHARACTER(8) missFldList()
39			INTEGER nMissing
40			INTEGER nbFields
41			INTEGER myIter
42			INTEGER myThid
43			CEOP
44
45			C !FUNCTIONS
46			INTEGER ILNBLNK
47			EXTERNAL ILNBLNK
48
49			C !LOCAL VARIABLES:
50			C == Local variables ==
51			C nj :: record & field number
52			C ioUnit :: temp for writing msg unit
53			C msgBuf :: Informational/error message buffer
54			C i,j,k :: loop indices
55			C bi,bj :: tile indices
56			INTEGER nj, ioUnit
57			INTEGER tIceFlag, warnCnts
58			LOGICAL stopFlag
59			c LOGICAL oldIceAge
60			CHARACTER*(MAX_LEN_MBUF) msgBuf
61			CHARACTER*(8) fldName
62			INTEGER i,j,k,bi,bj
63			#ifdef ALLOW_SITRACER
64			INTEGER iTracer
65			CHARACTER*(2) fldNum
66			#endif
67			CEOP
68
69			c IF ( seaice_pickup_read_mdsio ) THEN
70
71			IF ( nMissing.GE.1 ) THEN
72			ioUnit = errorMessageUnit
73			tIceFlag = 0
74			c oldIceAge = .TRUE.
75			DO nj=1,nMissing
76			IF ( missFldList(nj).EQ.'siTICES ' ) tIceFlag = tIceFlag + 2
77			IF ( missFldList(nj).EQ.'siTICE ' ) tIceFlag = tIceFlag + 1
78			c IF ( missFldList(nj).EQ.'siAGE ' ) oldIceAge = .FALSE.
79			ENDDO
80			stopFlag = .FALSE.
81			warnCnts = nMissing
82
83			DO nj=1,nMissing
84			fldName = missFldList(nj)
85			IF ( fldName.EQ.'siTICE '
86			& .AND. tIceFlag.LE.1 ) THEN
87			IF ( .NOT.pickupStrictlyMatch ) THEN
88			WRITE(msgBuf,'(4A)') ' WARNING SEAICE_CHECK_PICKUP:',
89			& ' restart with Tice from 1rst category'
90			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
91			ENDIF
92			ELSEIF ( fldName.EQ.'siTICES '
93			& .AND. tIceFlag.LE.2 ) THEN
94			IF (SEAICE_multDim.GT.1) THEN
95			IF ( .NOT.pickupStrictlyMatch ) THEN
96			WRITE(msgBuf,'(4A)') ' WARNING SEAICE_CHECK_PICKUP:',
97			& ' restart from single category Tice (copied to TICES)'
98			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
99			C copy TICE -> TICES
100			DO bj=myByLo(myThid),myByHi(myThid)
101			DO bi=myBxLo(myThid),myBxHi(myThid)
102			DO k=1,MULTDIM
103			DO j=1-OLy,sNy+OLy
104			DO i=1-OLx,sNx+OLx
105			TICES(i,j,k,bi,bj) = TICE(i,j,bi,bj)
106			ENDDO
107			ENDDO
108			ENDDO
109			ENDDO
110			ENDDO
111			ENDIF
112			ENDIF
113			ELSEIF ( fldName(1:6).EQ.'siSigm' ) THEN
114			C- Note: try to restart without Sigma1,2,12 (as if SEAICEuseEVPpickup=F)
115			C An alternative would be to restart only if SEAICEuseEVPpickup=F:
116			C if SEAICEuseEVPpickup then stop / else warning / endif
117			IF ( .NOT.pickupStrictlyMatch ) THEN
118			WRITE(msgBuf,'(4A)') ' WARNING SEAICE_CHECK_PICKUP:',
119			& ' restart without "',fldName,'" (set to zero)'
120			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
121			ENDIF
122			ELSEIF ( fldName.EQ.'siTICES ' .OR.
123			& fldName.EQ.'siTICE ' .OR.
124			& fldName.EQ.'siUICE ' .OR.
125			& fldName.EQ.'siVICE ' .OR.
126			& fldName.EQ.'siAREA ' .OR.
127			& fldName.EQ.'siHEFF ' .OR.
128			& fldName.EQ.'siHSNOW ' .OR.
129			& fldName.EQ.'siHSALT ' ) THEN
130			stopFlag = .TRUE.
131			WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
132			& 'cannot restart without field "',fldName,'"'
133			CALL PRINT_ERROR( msgBuf, myThid )
134			#ifdef ALLOW_SITRACER
135			ELSEIF ( fldName(1:6).EQ.'siTrac' ) THEN
136			DO iTracer = 1, SItrMaxNum
137			WRITE(fldNum,'(I2.2)') iTracer
138			IF ( fldName(7:8).EQ.fldNum ) THEN
139			IF ( .NOT.pickupStrictlyMatch ) THEN
140			WRITE(msgBuf,'(4A)')
141			& ' WARNINGS SEAICE_CHECK_PICKUP: ',
142			& 'restart without "',fldName,'" (set to zero)'
143			CALL PRINT_MESSAGE(
144			& msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
145			ENDIF
146			ENDIF
147			ENDDO
148			#endif /* ALLOW_SITRACER */
149			ELSE
150			C- not recognized fields:
151			stopFlag = .TRUE.
152			WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
153			& 'missing field "',fldName,'" not recognized'
154			CALL PRINT_ERROR( msgBuf, myThid )
155			ENDIF
156			C- end nj loop
157			ENDDO
158
159			IF ( stopFlag ) THEN
160			STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
161			ELSEIF ( pickupStrictlyMatch ) THEN
162			WRITE(msgBuf,'(4A)') 'SEAICE_CHECK_PICKUP: ',
163			& 'try with " pickupStrictlyMatch=.FALSE.,"',
164			& ' in file: "data", NameList: "PARM03"'
165			CALL PRINT_ERROR( msgBuf, myThid )
166			STOP 'ABNORMAL END: S/R SEAICE_CHECK_PICKUP'
167			ELSEIF ( warnCnts .GT. 0 ) THEN
168			WRITE(msgBuf,'(4A)') ' WARNING SEAICE_CHECK_PICKUP: ',
169			& 'Will get only an approximated Restart'
170			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
171			ENDIF
172
173			ENDIF
174
175			C-- end: seaice_pickup_read_mdsio
176			c ENDIF
177
178			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
179
180			RETURN
181			END