pkg/ptracers/ptracers_init_fixed.F

1edeb03c55 Jean*0001 #include "PTRACERS_OPTIONS.h"
                0002
d2825c6d08 Ed H*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1edeb03c55 Jean*0004 CBOP
04b12a5db5 Jean*0005 C     !ROUTINE: PTRACERS_INIT_FIXED
1edeb03c55 Jean*0006
d2825c6d08 Ed H*0007 C     !INTERFACE:
04b12a5db5 Jean*0008       SUBROUTINE PTRACERS_INIT_FIXED( myThid )
1edeb03c55 Jean*0009
d2825c6d08 Ed H*0010 C     !DESCRIPTION:
1edeb03c55 Jean*0011 C     Initialize PTRACERS constant
04b12a5db5 Jean*0012
d2825c6d08 Ed H*0013 C     !USES:
d217ad1db8 Oliv*0014 #include "PTRACERS_MOD.h"
1edeb03c55 Jean*0015       IMPLICIT NONE
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
636477d15b Jean*0019 #include "PTRACERS_SIZE.h"
0a278985fd Jean*0020 #include "PTRACERS_PARAMS.h"
1edeb03c55 Jean*0021 #include "GAD.h"
                0022
d2825c6d08 Ed H*0023 C     !INPUT PARAMETERS:
1edeb03c55 Jean*0024       INTEGER myThid
d2825c6d08 Ed H*0025 CEOP
1edeb03c55 Jean*0026
                0027 #ifdef ALLOW_PTRACERS
a9f828d17c Jean*0028 C     !FUNCTIONS
                0029       INTEGER  GAD_ADVSCHEME_GET
                0030       EXTERNAL GAD_ADVSCHEME_GET
                0031
d2825c6d08 Ed H*0032 C     !LOCAL VARIABLES:
a9f828d17c Jean*0033 C     iTracer     :: tracer index
                0034 C     errCount    :: error counter
                0035 C     tracMinSize :: overlap minimum size for ptracers advection
                0036 C     msgBuf      :: Informational/error message buffer
1edeb03c55 Jean*0037       INTEGER iTracer
a9f828d17c Jean*0038       INTEGER errCount
                0039       INTEGER tracMinSize, minSize
                0040       LOGICAL updateMinSize
965ef81639 Jean*0041       CHARACTER*(MAX_LEN_MBUF) msgBuf
04b12a5db5 Jean*0042
d31276c95b Jean*0043       _BEGIN_MASTER( myThid )
a9f828d17c Jean*0044       errCount = 0
d31276c95b Jean*0045
                0046 C     Initialise internal parameter in common block:
                0047       DO iTracer = 1, PTRACERS_num
2ac3d7bd33 Jean*0048         PTRACERS_MultiDimAdv(iTracer)  = multiDimAdvection
                0049         PTRACERS_SOM_Advection(iTracer)= .FALSE.
f0b15bfd7f Oliv*0050         PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
fc10d43a89 Jean*0051         PTRACERS_AdamsBash_Tr(iTracer) = .FALSE.
f0b15bfd7f Oliv*0052       ENDDO
                0053
37549204de Jean*0054 C--   Loop over tracers
a9f828d17c Jean*0055       tracMinSize = 0
f0b15bfd7f Oliv*0056       DO iTracer = 1, PTRACERS_numInUse
                0057
a9f828d17c Jean*0058 C-    Check for valid advection-scheme number
bd50fe7d15 Gael*0059         IF ( PTRACERS_advScheme(iTracer).NE.0 ) THEN
476db55f69 Oliv*0060          minSize = GAD_ADVSCHEME_GET( PTRACERS_advScheme(iTracer) )
                0061          IF ( minSize.LT.0 ) THEN
a9f828d17c Jean*0062           WRITE(msgBuf,'(2A,I6)') 'PTRACERS_INIT_FIXED: ',
                0063      &    'invalid Adv. Scheme number=', PTRACERS_advScheme(iTracer)
                0064           CALL PRINT_ERROR( msgBuf, myThid )
                0065           WRITE(msgBuf,'(2A,I6)') 'PTRACERS_INIT_FIXED: ',
                0066      &    'for tracer #', iTracer
                0067           CALL PRINT_ERROR( msgBuf, myThid )
                0068           errCount = errCount + 1
476db55f69 Oliv*0069          ENDIF
                0070         ELSE
                0071          minSize = 1
a9f828d17c Jean*0072         ENDIF
                0073 C     Overlap minimum size consistent with ptracers advection
                0074         tracMinSize = MAX( tracMinSize, minSize )
                0075
f0b15bfd7f Oliv*0076         IF (
                0077      &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
                0078      &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
bd50fe7d15 Gael*0079      &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH .OR.
                0080      &       PTRACERS_advScheme(iTracer).EQ.0
f0b15bfd7f Oliv*0081      &     ) PTRACERS_MultiDimAdv(iTracer) = .FALSE.
                0082         useMultiDimAdvec = useMultiDimAdvec
                0083      &                .OR. PTRACERS_MultiDimAdv(iTracer)
                0084         PTRACERS_AdamsBashGtr(iTracer) =
                0085      &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
                0086      &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
                0087      &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
fc10d43a89 Jean*0088         IF ( .NOT.PTRACERS_doAB_onGpTr ) THEN
                0089          PTRACERS_AdamsBash_Tr(iTracer) = PTRACERS_AdamsBashGtr(iTracer)
                0090          PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
                0091         ENDIF
f0b15bfd7f Oliv*0092
d217ad1db8 Oliv*0093         PTRACERS_SOM_Advection(iTracer) =
                0094      &    PTRACERS_advScheme(iTracer).GE.ENUM_SOM_PRATHER
                0095      &    .AND. PTRACERS_advScheme(iTracer).LE.ENUM_SOM_LIMITER
                0096 #ifndef PTRACERS_ALLOW_DYN_STATE
                0097         IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
                0098           WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
                0099      &   'trying to use 2nd.Order-Moment Advection without'
bb680a5d5b Jean*0100           CALL PRINT_ERROR( msgBuf, myThid )
d217ad1db8 Oliv*0101           WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
                0102      &   'dynamical internal state data structures compiled'
bb680a5d5b Jean*0103           CALL PRINT_ERROR( msgBuf, myThid )
d217ad1db8 Oliv*0104           WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
                0105      &   'Re-compile with:  #define PTRACERS_ALLOW_DYN_STATE'
bb680a5d5b Jean*0106           CALL PRINT_ERROR( msgBuf, myThid )
a9f828d17c Jean*0107           errCount = errCount + 1
d217ad1db8 Oliv*0108         ENDIF
                0109 #endif /* ndef PTRACERS_ALLOW_DYN_STATE */
                0110
37549204de Jean*0111 C--   end of Tracer loop
d31276c95b Jean*0112       ENDDO
                0113
a9f828d17c Jean*0114 C--   Update Overlap minimum size according to tracer advection
                0115       updateMinSize = GAD_OlMinSize(1).LT.tracMinSize
                0116       GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1), tracMinSize )
                0117 C-    Constraint on size of the overlap (after updating "useMultiDimAdvec"):
                0118       IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
                0119 C-    multi-dim-advection on CS-grid requires to double the size of OLx,OLy
                0120         updateMinSize = updateMinSize .OR. ( GAD_OlMinSize(3).LT.2 )
                0121         GAD_OlMinSize(3) = MAX( GAD_OlMinSize(3), 2 )
                0122       ENDIF
                0123       IF ( updateMinSize ) THEN
                0124         WRITE(msgBuf,'(2A,9I3)') 'PTRACERS_INIT_FIXED: ',
                0125      &      'updated GAD_OlMinSize=', GAD_OlMinSize
                0126         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0127      &                    SQUEEZE_RIGHT, myThid )
                0128       ENDIF
                0129
d217ad1db8 Oliv*0130 #ifdef PTRACERS_ALLOW_DYN_STATE
811d3e9bd3 Jean*0131       CALL PTRACERS_INIT_FIXED_DYNAMIC( PtrISt,
d217ad1db8 Oliv*0132      &                                  PTRACERS_numInUse,
                0133      &                                  PTRACERS_SOM_Advection,
                0134      &                                  sNx, sNy, Nr, OLx, OLy,
                0135      &                                  nSx, nSy, nSOM,
                0136      &                                  myThid )
                0137 #endif
                0138
a9f828d17c Jean*0139 C--   Stop if any error was found:
                0140       IF ( errCount .GE. 1 ) THEN
                0141         WRITE(msgBuf,'(A,I3,A)')
                0142      &  'S/R PTRACERS_INIT_FIXED: detected', errCount,' fatal error(s)'
                0143         CALL PRINT_ERROR( msgBuf, myThid )
                0144         CALL ALL_PROC_DIE( 0 )
                0145         STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
                0146       ENDIF
                0147
37549204de Jean*0148       _END_MASTER( myThid )
                0149       _BARRIER
965ef81639 Jean*0150
                0151 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0152
971f463862 Jean*0153 #ifdef ALLOW_MNC
                0154       IF (useMNC) THEN
                0155 C       Initialize the MNC variable types for PTRACERS
                0156         CALL PTRACERS_MNC_INIT( myThid )
                0157       ENDIF
                0158 #endif
                0159
2e8121cfc9 Jean*0160 #ifdef ALLOW_DIAGNOSTICS
                0161       IF ( useDiagnostics ) THEN
                0162         CALL PTRACERS_DIAGNOSTICS_INIT( myThid )
                0163       ENDIF
                0164 #endif
                0165
1edeb03c55 Jean*0166 #endif /* ALLOW_PTRACERS */
                0167
                0168       RETURN
                0169       END