pkg/thsice/thsice_check.F

C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_check.F,v 1.9 2015/07/29 00:48:24 jmc Exp $
C $Name:  $

#include "THSICE_OPTIONS.h"

CBOP
C     !ROUTINE: THSICE_CHECK
C     !INTERFACE:

      SUBROUTINE THSICE_CHECK( myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R THSICE_CHECK
C     | o Check parameters and other package dependences
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "THSICE_SIZE.h"
#include "THSICE_PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     myThid   :: my Thread Id number
      INTEGER myThid

C     !LOCAL VARIABLES:
C     msgBuf   :: Informational/error message buffer
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER errCount
CEOP

      _BEGIN_MASTER(myThid)
      errCount = 0

       WRITE(msgBuf,'(A)') 'THSICE_CHECK: #define THSICE'
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT, myThid )

C--   Check parameter consistency:
      IF ( .NOT.( thSIce_skipThermo .OR. useBulkForce .OR. useEXF
     &       .OR. useAIM .OR. useCheapAML .OR. useATM2d ) ) THEN
C-    need some form of ATM-surface pkg to provide Air-Ice surf fluxes
        WRITE(msgBuf,'(2A)')
     &   'THSICE_CHECK: needs some PKG (EXF,Bulk-Force,AIM,CheapAML)'
        CALL PRINT_ERROR( msgBuf, myThid )
        WRITE(msgBuf,'(2A)')
     &   'THSICE_CHECK: to provide Air-Ice surface fluxes for THSICE'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
      ENDIF
      IF ( thSIceAdvScheme.EQ.0 .AND. thSIce_diffK.NE.0. ) THEN
        WRITE(msgBuf,'(2A)')
     &   'THSICE_CHECK: to use thSIce_diffK, needs to select',
     &   ' one advection scheme (thSIceAdvScheme<>0)'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
      ENDIF
#ifndef ALLOW_GENERIC_ADVDIFF
      IF ( thSIceAdvScheme.NE.0 ) THEN
        WRITE(msgBuf,'(2A)') 'THSICE_CHECK: Need to compile ',
     &     '"generic_advdiff" pkg in order to use thSIceAdvScheme'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
      ENDIF
#endif /* ndef ALLOW_GENERIC_ADVDIFF */

      IF ( thSIceBalanceAtmFW.NE.0 ) THEN
#ifndef ALLOW_BALANCE_FLUXES
        WRITE(msgBuf,'(2A)') 'THSICE_CHECK: needs to have ',
     &     'ALLOW_BALANCE_FLUXES defined to use thSIceBalanceAtmFW'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
#endif
       IF ( balanceEmPmR ) THEN
        WRITE(msgBuf,'(2A)') 'THSICE_CHECK: cannot use',
     &       ' both balanceEmPmR and thSIceBalanceAtmFW'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
       ENDIF
      ENDIF

#ifdef ALLOW_AUTODIFF
      IF ( nitMaxTsf .GT. MaxTsf ) THEN
        WRITE(msgBuf,'(2A)')
     &   'THSICE_CHECK: Need to set MaxTsf >= nitMaxTsf for TAF'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
      ENDIF
# ifdef ALLOW_DBUG_THSICE
        WRITE(msgBuf,'(2A)')
     &   'THSICE_CHECK: cannot compile AD-code with ALLOW_DBUG_THSICE'
        CALL PRINT_ERROR( msgBuf, myThid )
        errCount = errCount + 1
# endif
#endif /* ALLOW_AUTODIFF */

#ifdef OLD_THSICE_CALL_SEQUENCE
        WRITE(msgBuf,'(2A)') '** WARNING ** THSICE_CHECK: ',
     &   'OLD_THSICE_CALL_SEQUENCE code no longer maintained'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        WRITE(msgBuf,'(2A)') '** WARNING ** THSICE_CHECK: ',
     &   'option and related code will be removed after chkpt-64e'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
#endif /* OLD_THSICE_CALL_SEQUENCE */

      IF ( useAIM .AND. .NOT.( stepFwd_oceMxL .OR. useCoupler )
     &            .AND.  tauRelax_MxL.NE. -1. _d 0 ) THEN
C-    with pkg/aim, usual way to use pkg/thsice is to step-forward Mixed-Layer
C     (stepFwd_oceMxL=T); otherwise, need to be sure SST are set, e.g. by AIM
C     when setting tauRelax_MxL=-1 ; add a warning if this is not the case
        WRITE(msgBuf,'(2A)') '** WARNING ** THSICE_CHECK: ',
     &   'SST are not stepped forward (stepFwd_oceMx=F)'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        WRITE(msgBuf,'(2A)') '** WARNING ** THSICE_CHECK: ',
     &   'nor set (from files) by pkg/aim (tauRelax_MxL<>-1)'
c    &   'nor copied from pkg/aim SST (tauRelax_MxL<>-1.)'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
      ENDIF

      IF ( errCount.GE.1 ) THEN
        WRITE(msgBuf,'(A,I3,A)')
     &       'THSICE_CHECK: detected', errCount,' fatal error(s)'
        CALL PRINT_ERROR( msgBuf, myThid )
        CALL ALL_PROC_DIE( 0 )
        STOP 'ABNORMAL END: S/R THSICE_CHECK'
      ENDIF

      _END_MASTER(myThid)

      RETURN
      END
1	jmc	1.10	C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_check.F,v 1.9 2015/07/29 00:48:24 jmc Exp $
2	jmc	1.3	C $Name: $
3	heimbach	1.1
4			#include "THSICE_OPTIONS.h"
5
6	jmc	1.7	CBOP
7			C !ROUTINE: THSICE_CHECK
8			C !INTERFACE:
9
10	jmc	1.3	SUBROUTINE THSICE_CHECK( myThid )
11	heimbach	1.1
12	jmc	1.7	C !DESCRIPTION: \bv
13			C ==========================================================
14			C \| S/R THSICE_CHECK
15			C \| o Check parameters and other package dependences
16			C ==========================================================
17			C \ev
18
19			C !USES:
20	jmc	1.3	IMPLICIT NONE
21	heimbach	1.1
22	jmc	1.7	C == Global variables ===
23	jmc	1.4	#include "SIZE.h"
24	heimbach	1.1	#include "EEPARAMS.h"
25	jmc	1.4	#include "PARAMS.h"
26	heimbach	1.1	#include "THSICE_SIZE.h"
27			#include "THSICE_PARAMS.h"
28
29	jmc	1.7	C !INPUT/OUTPUT PARAMETERS:
30			C myThid :: my Thread Id number
31	jmc	1.3	INTEGER myThid
32	heimbach	1.1
33	jmc	1.7	C !LOCAL VARIABLES:
34			C msgBuf :: Informational/error message buffer
35	heimbach	1.1	CHARACTER*(MAX_LEN_MBUF) msgBuf
36	jmc	1.9	INTEGER errCount
37	jmc	1.7	CEOP
38	heimbach	1.1
39			_BEGIN_MASTER(myThid)
40	jmc	1.9	errCount = 0
41	heimbach	1.1
42			WRITE(msgBuf,'(A)') 'THSICE_CHECK: #define THSICE'
43			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
44	jmc	1.7	& SQUEEZE_RIGHT, myThid )
45	heimbach	1.1
46	jmc	1.4	C-- Check parameter consistency:
47	jmc	1.10	IF ( .NOT.( thSIce_skipThermo .OR. useBulkForce .OR. useEXF
48			& .OR. useAIM .OR. useCheapAML .OR. useATM2d ) ) THEN
49	jmc	1.7	C- need some form of ATM-surface pkg to provide Air-Ice surf fluxes
50			WRITE(msgBuf,'(2A)')
51			& 'THSICE_CHECK: needs some PKG (EXF,Bulk-Force,AIM,CheapAML)'
52			CALL PRINT_ERROR( msgBuf, myThid )
53			WRITE(msgBuf,'(2A)')
54			& 'THSICE_CHECK: to provide Air-Ice surface fluxes for THSICE'
55			CALL PRINT_ERROR( msgBuf, myThid )
56	jmc	1.9	errCount = errCount + 1
57	jmc	1.7	ENDIF
58	jmc	1.4	IF ( thSIceAdvScheme.EQ.0 .AND. thSIce_diffK.NE.0. ) THEN
59			WRITE(msgBuf,'(2A)')
60			& 'THSICE_CHECK: to use thSIce_diffK, needs to select',
61			& ' one advection scheme (thSIceAdvScheme<>0)'
62	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
63	jmc	1.9	errCount = errCount + 1
64	jmc	1.4	ENDIF
65			#ifndef ALLOW_GENERIC_ADVDIFF
66			IF ( thSIceAdvScheme.NE.0 ) THEN
67			WRITE(msgBuf,'(2A)') 'THSICE_CHECK: Need to compile ',
68			& '"generic_advdiff" pkg in order to use thSIceAdvScheme'
69	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
70	jmc	1.9	errCount = errCount + 1
71	jmc	1.4	ENDIF
72			#endif /* ndef ALLOW_GENERIC_ADVDIFF */
73
74			IF ( thSIceBalanceAtmFW.NE.0 ) THEN
75			#ifndef ALLOW_BALANCE_FLUXES
76	jmc	1.8	WRITE(msgBuf,'(2A)') 'THSICE_CHECK: needs to have ',
77			& 'ALLOW_BALANCE_FLUXES defined to use thSIceBalanceAtmFW'
78	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
79	jmc	1.9	errCount = errCount + 1
80	jmc	1.4	#endif
81			IF ( balanceEmPmR ) THEN
82			WRITE(msgBuf,'(2A)') 'THSICE_CHECK: cannot use',
83			& ' both balanceEmPmR and thSIceBalanceAtmFW'
84	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
85	jmc	1.9	errCount = errCount + 1
86	jmc	1.4	ENDIF
87			ENDIF
88
89	jmc	1.6	#ifdef ALLOW_AUTODIFF
90	heimbach	1.1	IF ( nitMaxTsf .GT. MaxTsf ) THEN
91	jmc	1.4	WRITE(msgBuf,'(2A)')
92			& 'THSICE_CHECK: Need to set MaxTsf >= nitMaxTsf for TAF'
93	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
94	jmc	1.9	errCount = errCount + 1
95	heimbach	1.1	ENDIF
96	jmc	1.6	# ifdef ALLOW_DBUG_THSICE
97			WRITE(msgBuf,'(2A)')
98			& 'THSICE_CHECK: cannot compile AD-code with ALLOW_DBUG_THSICE'
99	jmc	1.7	CALL PRINT_ERROR( msgBuf, myThid )
100	jmc	1.9	errCount = errCount + 1
101	jmc	1.6	# endif
102			#endif /* ALLOW_AUTODIFF */
103	heimbach	1.1
104	jmc	1.5	#ifdef OLD_THSICE_CALL_SEQUENCE
105			WRITE(msgBuf,'(2A)') ' WARNING THSICE_CHECK: ',
106			& 'OLD_THSICE_CALL_SEQUENCE code no longer maintained'
107			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
108			& SQUEEZE_RIGHT, myThid )
109			WRITE(msgBuf,'(2A)') ' WARNING THSICE_CHECK: ',
110			& 'option and related code will be removed after chkpt-64e'
111			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
112			& SQUEEZE_RIGHT, myThid )
113	jmc	1.7	#endif /* OLD_THSICE_CALL_SEQUENCE */
114	jmc	1.5
115	jmc	1.9	IF ( useAIM .AND. .NOT.( stepFwd_oceMxL .OR. useCoupler )
116			& .AND. tauRelax_MxL.NE. -1. _d 0 ) THEN
117			C- with pkg/aim, usual way to use pkg/thsice is to step-forward Mixed-Layer
118			C (stepFwd_oceMxL=T); otherwise, need to be sure SST are set, e.g. by AIM
119			C when setting tauRelax_MxL=-1 ; add a warning if this is not the case
120			WRITE(msgBuf,'(2A)') ' WARNING THSICE_CHECK: ',
121			& 'SST are not stepped forward (stepFwd_oceMx=F)'
122			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
123			& SQUEEZE_RIGHT, myThid )
124			WRITE(msgBuf,'(2A)') ' WARNING THSICE_CHECK: ',
125			& 'nor set (from files) by pkg/aim (tauRelax_MxL<>-1)'
126			c & 'nor copied from pkg/aim SST (tauRelax_MxL<>-1.)'
127			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
128			& SQUEEZE_RIGHT, myThid )
129			ENDIF
130
131			IF ( errCount.GE.1 ) THEN
132			WRITE(msgBuf,'(A,I3,A)')
133			& 'THSICE_CHECK: detected', errCount,' fatal error(s)'
134			CALL PRINT_ERROR( msgBuf, myThid )
135			CALL ALL_PROC_DIE( 0 )
136			STOP 'ABNORMAL END: S/R THSICE_CHECK'
137			ENDIF
138
139	heimbach	1.2	_END_MASTER(myThid)
140
141	jmc	1.3	RETURN
142			END