pkg/ptracers/ptracers_init_fixed.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_fixed.F,v 1.5 2008/05/09 00:38:45 jmc Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"
#include "GAD_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PTRACERS_INIT_FIXED

C     !INTERFACE:
      SUBROUTINE PTRACERS_INIT_FIXED( myThid )

C     !DESCRIPTION:
C     Initialize PTRACERS constant

C     !USES:
#include "PTRACERS_MOD.h"
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "PTRACERS_RESTART.h"
#include "GAD.h"

C     !INPUT PARAMETERS:
      INTEGER myThid
CEOP

#ifdef ALLOW_PTRACERS

C     !LOCAL VARIABLES:
C     iTracer  :: tracer index
C     msgBuf      - Informational/error meesage buffer
      INTEGER iTracer
      INTEGER minOlSize
      CHARACTER*(MAX_LEN_MBUF) msgBuf

      _BEGIN_MASTER( myThid )

C     Initialise internal parameter in common block:
      DO iTracer = 1, PTRACERS_num
        PTRACERS_MultiDimAdv(iTracer) = multiDimAdvection
        PTRACERS_SOM_Advection(iTracer) = .FALSE.
        PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
        PTRACERS_startAB(iTracer) = nIter0 - PTRACERS_Iter0
      ENDDO

C     Loop over tracers
      DO iTracer = 1, PTRACERS_numInUse

        IF (
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
     &     ) PTRACERS_MultiDimAdv(iTracer) = .FALSE.
        useMultiDimAdvec = useMultiDimAdvec
     &                .OR. PTRACERS_MultiDimAdv(iTracer)
        PTRACERS_AdamsBashGtr(iTracer) =
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH

        PTRACERS_SOM_Advection(iTracer) =
     &    PTRACERS_advScheme(iTracer).GE.ENUM_SOM_PRATHER
     &    .AND. PTRACERS_advScheme(iTracer).LE.ENUM_SOM_LIMITER
#ifndef GAD_ALLOW_SOM_ADVECT
        IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'trying to use 2nd.Order-Moment Advection that is not compiled'
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'Re-compile with:  #define GAD_ALLOW_SOM_ADVECT'
          CALL PRINT_ERROR( msgBuf , myThid)
          STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
        ENDIF
#endif /* ndef GAD_ALLOW_SOM_ADVECT */
#ifndef PTRACERS_ALLOW_DYN_STATE
        IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'trying to use 2nd.Order-Moment Advection without'
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'dynamical internal state data structures compiled'
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'Re-compile with:  #define PTRACERS_ALLOW_DYN_STATE'
          CALL PRINT_ERROR( msgBuf , myThid)
          STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
        ENDIF
#endif /* ndef PTRACERS_ALLOW_DYN_STATE */

        WRITE(msgBuf,'(2A,I4,A,L5)') 'PTRACERS_INIT_FIXED: ',
     &     'PTRACERS_SOM_Advection(', iTracer, ') = ',
     &     PTRACERS_SOM_Advection(iTracer)
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &     SQUEEZE_RIGHT, myThid)

C       end of Tracer loop
      ENDDO

#ifdef PTRACERS_ALLOW_DYN_STATE
      CALL PTRACERS_INIT_FIXED_DYNAMIC( PtrISt, 
     &                                  PTRACERS_numInUse,
     &                                  PTRACERS_SOM_Advection,
     &                                  sNx, sNy, Nr, OLx, OLy,
     &                                  nSx, nSy, nSOM,
     &                                  myThid )
#endif

      _END_MASTER( myThid )
      _BARRIER

C--   Check size of the overlap :
      IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
C-    multi-dim-advection on CS-grid requires to double the size of Olx,Oly
        minOlSize = 2
        DO iTracer = 1, PTRACERS_numInUse
         IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_FLUX_LIMIT .OR.
     &        PTRACERS_advScheme(iTracer).EQ.ENUM_DST3_FLUX_LIMIT .OR.
     &        PTRACERS_advScheme(iTracer).EQ.ENUM_DST3 ) minOlSize = 4
        ENDDO
        IF ( Olx.LT.minOlSize .OR. Oly.LT.minOlSize ) THEN
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &     'Multi-Dim Advection with 5-points stencil'
          CALL PRINT_ERROR( msgBuf , myThid)
          WRITE(msgBuf,'(2A,I2)') 'PTRACERS_INIT_FIXED: ',
     &     'advection scheme needs at least Olx,Oly=', minOlSize
          CALL PRINT_ERROR( msgBuf , myThid)
          STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
        ENDIF
      ENDIF

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

#ifdef ALLOW_MNC
      IF (useMNC) THEN
C       Initialize the MNC variable types for PTRACERS
        CALL PTRACERS_MNC_INIT( myThid )
      ENDIF
#endif

#ifdef ALLOW_DIAGNOSTICS
      IF ( useDiagnostics ) THEN
        CALL PTRACERS_DIAGNOSTICS_INIT( myThid )
      ENDIF
#endif

#endif /* ALLOW_PTRACERS */

      RETURN
      END
1	jahn	1.6	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_fixed.F,v 1.5 2008/05/09 00:38:45 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PTRACERS_OPTIONS.h"
5	jahn	1.4	#include "GAD_OPTIONS.h"
6	jmc	1.1
7			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8			CBOP
9			C !ROUTINE: PTRACERS_INIT_FIXED
10
11			C !INTERFACE:
12			SUBROUTINE PTRACERS_INIT_FIXED( myThid )
13
14			C !DESCRIPTION:
15			C Initialize PTRACERS constant
16
17			C !USES:
18	jahn	1.4	#include "PTRACERS_MOD.h"
19	jmc	1.1	IMPLICIT NONE
20			#include "SIZE.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "PTRACERS_SIZE.h"
24	jmc	1.2	#include "PTRACERS_PARAMS.h"
25	jmc	1.3	#include "PTRACERS_RESTART.h"
26	jmc	1.1	#include "GAD.h"
27
28			C !INPUT PARAMETERS:
29			INTEGER myThid
30			CEOP
31
32			#ifdef ALLOW_PTRACERS
33
34			C !LOCAL VARIABLES:
35			C iTracer :: tracer index
36			C msgBuf - Informational/error meesage buffer
37			INTEGER iTracer
38			INTEGER minOlSize
39			CHARACTER*(MAX_LEN_MBUF) msgBuf
40
41	jmc	1.3	_BEGIN_MASTER( myThid )
42
43			C Initialise internal parameter in common block:
44			DO iTracer = 1, PTRACERS_num
45	jahn	1.6	PTRACERS_MultiDimAdv(iTracer) = multiDimAdvection
46			PTRACERS_SOM_Advection(iTracer) = .FALSE.
47			PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
48			PTRACERS_startAB(iTracer) = nIter0 - PTRACERS_Iter0
49			ENDDO
50
51			C Loop over tracers
52			DO iTracer = 1, PTRACERS_numInUse
53
54			IF (
55			& PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
56			& PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
57			& PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
58			& ) PTRACERS_MultiDimAdv(iTracer) = .FALSE.
59			useMultiDimAdvec = useMultiDimAdvec
60			& .OR. PTRACERS_MultiDimAdv(iTracer)
61			PTRACERS_AdamsBashGtr(iTracer) =
62			& PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
63			& PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
64			& PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
65
66	jahn	1.4	PTRACERS_SOM_Advection(iTracer) =
67			& PTRACERS_advScheme(iTracer).GE.ENUM_SOM_PRATHER
68			& .AND. PTRACERS_advScheme(iTracer).LE.ENUM_SOM_LIMITER
69			#ifndef GAD_ALLOW_SOM_ADVECT
70			IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
71			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
72			& 'trying to use 2nd.Order-Moment Advection that is not compiled'
73			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
74			& 'Re-compile with: #define GAD_ALLOW_SOM_ADVECT'
75			CALL PRINT_ERROR( msgBuf , myThid)
76			STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
77			ENDIF
78			#endif /* ndef GAD_ALLOW_SOM_ADVECT */
79			#ifndef PTRACERS_ALLOW_DYN_STATE
80			IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
81			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
82			& 'trying to use 2nd.Order-Moment Advection without'
83			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
84			& 'dynamical internal state data structures compiled'
85			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
86			& 'Re-compile with: #define PTRACERS_ALLOW_DYN_STATE'
87			CALL PRINT_ERROR( msgBuf , myThid)
88			STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
89			ENDIF
90			#endif /* ndef PTRACERS_ALLOW_DYN_STATE */
91
92	jahn	1.6	WRITE(msgBuf,'(2A,I4,A,L5)') 'PTRACERS_INIT_FIXED: ',
93	jahn	1.4	& 'PTRACERS_SOM_Advection(', iTracer, ') = ',
94			& PTRACERS_SOM_Advection(iTracer)
95			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
96			& SQUEEZE_RIGHT, myThid)
97
98	jahn	1.6	C end of Tracer loop
99	jmc	1.3	ENDDO
100
101	jahn	1.4	#ifdef PTRACERS_ALLOW_DYN_STATE
102			CALL PTRACERS_INIT_FIXED_DYNAMIC( PtrISt,
103			& PTRACERS_numInUse,
104			& PTRACERS_SOM_Advection,
105			& sNx, sNy, Nr, OLx, OLy,
106			& nSx, nSy, nSOM,
107			& myThid )
108			#endif
109
110	jmc	1.3	_END_MASTER( myThid )
111			_BARRIER
112	jmc	1.1
113			C-- Check size of the overlap :
114			IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
115			C- multi-dim-advection on CS-grid requires to double the size of Olx,Oly
116			minOlSize = 2
117			DO iTracer = 1, PTRACERS_numInUse
118			IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_FLUX_LIMIT .OR.
119			& PTRACERS_advScheme(iTracer).EQ.ENUM_DST3_FLUX_LIMIT .OR.
120			& PTRACERS_advScheme(iTracer).EQ.ENUM_DST3 ) minOlSize = 4
121			ENDDO
122			IF ( Olx.LT.minOlSize .OR. Oly.LT.minOlSize ) THEN
123			WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
124			& 'Multi-Dim Advection with 5-points stencil'
125			CALL PRINT_ERROR( msgBuf , myThid)
126			WRITE(msgBuf,'(2A,I2)') 'PTRACERS_INIT_FIXED: ',
127			& 'advection scheme needs at least Olx,Oly=', minOlSize
128			CALL PRINT_ERROR( msgBuf , myThid)
129			STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
130			ENDIF
131			ENDIF
132
133			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
134
135			#ifdef ALLOW_MNC
136			IF (useMNC) THEN
137			C Initialize the MNC variable types for PTRACERS
138			CALL PTRACERS_MNC_INIT( myThid )
139			ENDIF
140			#endif
141
142			#ifdef ALLOW_DIAGNOSTICS
143			IF ( useDiagnostics ) THEN
144			CALL PTRACERS_DIAGNOSTICS_INIT( myThid )
145			ENDIF
146			#endif
147
148			#endif /* ALLOW_PTRACERS */
149
150			RETURN
151			END