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

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

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


Revision 1.4 - (show annotations) (download)
Thu May 8 19:50:09 2008 UTC (16 years, 1 month ago) by jahn
Branch: MAIN
Changes since 1.3: +44 -1 lines
add second-order moment advection schemes (80 and 81);
this uses a dynamically allocated internal state data structure
(#define PTRACERS_ALLOW_DYN_STATE in PTRACERS_OPTIONS.h)
and requires a fortran 90 compiler

1 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_fixed.F,v 1.3 2007/12/17 22:03:15 jmc Exp $
2 C $Name: $
3
4 #include "PTRACERS_OPTIONS.h"
5 #include "GAD_OPTIONS.h"
6
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 #include "PTRACERS_MOD.h"
19 IMPLICIT NONE
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "PTRACERS_SIZE.h"
24 #include "PTRACERS_PARAMS.h"
25 #include "PTRACERS_RESTART.h"
26 #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 _BEGIN_MASTER( myThid )
42
43 C Initialise internal parameter in common block:
44 DO iTracer = 1, PTRACERS_num
45 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 WRITE(msgBuf,'(2A,I3,A,L)') 'PTRACERS_INIT_FIXED: ',
72 & 'PTRACERS_SOM_Advection(', iTracer, ') = ',
73 & PTRACERS_SOM_Advection(iTracer)
74 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
75 & SQUEEZE_RIGHT, myThid)
76
77 PTRACERS_MultiDimAdv(iTracer) = multiDimAdvection
78 PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
79 PTRACERS_startAB(iTracer) = nIter0 - PTRACERS_Iter0
80 ENDDO
81
82 #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 C Loop over tracers
92 DO iTracer = 1, PTRACERS_numInUse
93
94 IF (
95 & 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
106 C end of Tracer loop
107 ENDDO
108 _END_MASTER( myThid )
109 _BARRIER
110
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