/[MITgcm]/MITgcm/pkg/ptracers/ptracers_init_fixed.F
ViewVC logotype

Annotation of /MITgcm/pkg/ptracers/ptracers_init_fixed.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.5 - (hide annotations) (download)
Fri May 9 00:38:45 2008 UTC (16 years ago) by jmc
Branch: MAIN
Changes since 1.4: +2 -2 lines
some compilers require a length with Logical print format "L"

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_fixed.F,v 1.4 2008/05/08 19:50:09 jahn 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.4 PTRACERS_SOM_Advection(iTracer) =
46     & PTRACERS_advScheme(iTracer).GE.ENUM_SOM_PRATHER
47     & .AND. PTRACERS_advScheme(iTracer).LE.ENUM_SOM_LIMITER
48     #ifndef GAD_ALLOW_SOM_ADVECT
49     IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
50     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
51     & 'trying to use 2nd.Order-Moment Advection that is not compiled'
52     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
53     & 'Re-compile with: #define GAD_ALLOW_SOM_ADVECT'
54     CALL PRINT_ERROR( msgBuf , myThid)
55     STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
56     ENDIF
57     #endif /* ndef GAD_ALLOW_SOM_ADVECT */
58     #ifndef PTRACERS_ALLOW_DYN_STATE
59     IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
60     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
61     & 'trying to use 2nd.Order-Moment Advection without'
62     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
63     & 'dynamical internal state data structures compiled'
64     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
65     & 'Re-compile with: #define PTRACERS_ALLOW_DYN_STATE'
66     CALL PRINT_ERROR( msgBuf , myThid)
67     STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
68     ENDIF
69     #endif /* ndef PTRACERS_ALLOW_DYN_STATE */
70    
71 jmc 1.5 WRITE(msgBuf,'(2A,I3,A,L5)') 'PTRACERS_INIT_FIXED: ',
72 jahn 1.4 & 'PTRACERS_SOM_Advection(', iTracer, ') = ',
73     & PTRACERS_SOM_Advection(iTracer)
74     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
75     & SQUEEZE_RIGHT, myThid)
76    
77 jmc 1.3 PTRACERS_MultiDimAdv(iTracer) = multiDimAdvection
78     PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
79     PTRACERS_startAB(iTracer) = nIter0 - PTRACERS_Iter0
80     ENDDO
81    
82 jahn 1.4 #ifdef PTRACERS_ALLOW_DYN_STATE
83     CALL PTRACERS_INIT_FIXED_DYNAMIC( PtrISt,
84     & PTRACERS_numInUse,
85     & PTRACERS_SOM_Advection,
86     & sNx, sNy, Nr, OLx, OLy,
87     & nSx, nSy, nSOM,
88     & myThid )
89     #endif
90    
91 jmc 1.1 C Loop over tracers
92     DO iTracer = 1, PTRACERS_numInUse
93    
94     IF (
95 jmc 1.3 & PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
96     & PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
97     & PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
98     & ) PTRACERS_MultiDimAdv(iTracer) = .FALSE.
99     useMultiDimAdvec = useMultiDimAdvec
100     & .OR. PTRACERS_MultiDimAdv(iTracer)
101     PTRACERS_AdamsBashGtr(iTracer) =
102     & PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
103     & PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
104     & PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
105 jmc 1.1
106     C end of Tracer loop
107     ENDDO
108 jmc 1.3 _END_MASTER( myThid )
109     _BARRIER
110 jmc 1.1
111     C-- Check size of the overlap :
112     IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
113     C- multi-dim-advection on CS-grid requires to double the size of Olx,Oly
114     minOlSize = 2
115     DO iTracer = 1, PTRACERS_numInUse
116     IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_FLUX_LIMIT .OR.
117     & PTRACERS_advScheme(iTracer).EQ.ENUM_DST3_FLUX_LIMIT .OR.
118     & PTRACERS_advScheme(iTracer).EQ.ENUM_DST3 ) minOlSize = 4
119     ENDDO
120     IF ( Olx.LT.minOlSize .OR. Oly.LT.minOlSize ) THEN
121     WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
122     & 'Multi-Dim Advection with 5-points stencil'
123     CALL PRINT_ERROR( msgBuf , myThid)
124     WRITE(msgBuf,'(2A,I2)') 'PTRACERS_INIT_FIXED: ',
125     & 'advection scheme needs at least Olx,Oly=', minOlSize
126     CALL PRINT_ERROR( msgBuf , myThid)
127     STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
128     ENDIF
129     ENDIF
130    
131     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
132    
133     #ifdef ALLOW_MNC
134     IF (useMNC) THEN
135     C Initialize the MNC variable types for PTRACERS
136     CALL PTRACERS_MNC_INIT( myThid )
137     ENDIF
138     #endif
139    
140     #ifdef ALLOW_DIAGNOSTICS
141     IF ( useDiagnostics ) THEN
142     CALL PTRACERS_DIAGNOSTICS_INIT( myThid )
143     ENDIF
144     #endif
145    
146     #endif /* ALLOW_PTRACERS */
147    
148     RETURN
149     END

  ViewVC Help
Powered by ViewVC 1.1.22