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

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

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


Revision 1.32 - (show annotations) (download)
Mon Aug 18 14:34:43 2008 UTC (15 years, 9 months ago) by jmc
Branch: MAIN
Changes since 1.31: +2 -1 lines
fix previous check-in (forgot to add pTracers_useDWNSLP in namelist)

1 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_readparms.F,v 1.31 2008/08/17 02:09:36 jmc Exp $
2 C $Name: $
3
4 #include "PTRACERS_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: PTRACERS_READPARMS
9
10 C !INTERFACE:
11 SUBROUTINE PTRACERS_READPARMS( myThid )
12
13 C !DESCRIPTION:
14 C Initialize PTRACERS parameters, read in data.ptracers
15
16 C !USES:
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PTRACERS_SIZE.h"
21 #include "PTRACERS_PARAMS.h"
22 #include "PARAMS.h"
23 #ifdef ALLOW_MNC
24 #include "MNC_PARAMS.h"
25 #endif
26
27 C !INPUT PARAMETERS:
28 INTEGER myThid
29 CEOP
30
31 #ifdef ALLOW_PTRACERS
32
33 C !LOCAL VARIABLES:
34 C k,iTracer :: loop indices
35 C iUnit :: unit number for I/O
36 C msgBuf :: message buffer
37 INTEGER k, iTracer
38 INTEGER iUnit
39 INTEGER ic
40 CHARACTER*(MAX_LEN_MBUF) msgBuf
41 _RL PTRACERS_diffKr(PTRACERS_num)
42 _RL tauTr1ClimRelax
43
44 C PTRACERS_taveFreq :: Frequency with which time-averaged PTRACERS
45 C are written to post-processing files.
46 C tauTr1ClimRelax :: old parameter (will be removed 1 day)
47 NAMELIST /PTRACERS_PARM01/
48 & tauTr1ClimRelax,
49 & PTRACERS_dumpFreq,
50 & PTRACERS_taveFreq,
51 & PTRACERS_monitorFreq,
52 & PTRACERS_advScheme,
53 & PTRACERS_ImplVertAdv,
54 & PTRACERS_diffKh,
55 & PTRACERS_diffK4,
56 & PTRACERS_diffKr,
57 & PTRACERS_diffKrNr,
58 & PTRACERS_ref,
59 & PTRACERS_EvPrRn,
60 & PTRACERS_useGMRedi,
61 & PTRACERS_useDWNSLP,
62 & PTRACERS_useKPP,
63 & PTRACERS_Iter0,
64 & PTRACERS_numInUse,
65 & PTRACERS_initialFile,
66 & PTRACERS_useRecords,
67 & PTRACERS_names,
68 & PTRACERS_long_names,
69 & PTRACERS_units,
70 & PTRACERS_timeave_mnc,
71 & PTRACERS_snapshot_mnc,
72 & PTRACERS_monitor_mnc,
73 & PTRACERS_pickup_write_mnc,
74 & PTRACERS_pickup_read_mnc
75
76 _BEGIN_MASTER(myThid)
77
78 C This routine has been called by the main model so we set our
79 C internal flag to indicate we are in business
80 c PTRACERSisON=.TRUE.
81 C Note(jmc): remove this flag which is not really usefull (not set properly
82 C when usePTRACERS=F and always TRUE otherwise);
83 C much better to use "usePTRACERS" flag instead.
84
85 C Set ptracer IO & diagnostics labels (2 characters long)
86 CALL PTRACERS_SET_IOLABEL(
87 O PTRACERS_ioLabel,
88 I PTRACERS_num, myThid )
89
90 C Set defaults values for parameters in PTRACERS.h
91 PTRACERS_dumpFreq = dumpFreq
92 PTRACERS_taveFreq = taveFreq
93 PTRACERS_monitorFreq = monitorFreq
94 PTRACERS_Iter0 = 0
95 PTRACERS_numInUse=-1
96 DO iTracer=1,PTRACERS_num
97 PTRACERS_advScheme(iTracer)=saltAdvScheme
98 PTRACERS_ImplVertAdv(iTracer) = .FALSE.
99 PTRACERS_diffKh(iTracer)=diffKhS
100 PTRACERS_diffK4(iTracer)=diffK4S
101 PTRACERS_diffKr(iTracer)=UNSET_RL
102 DO k=1,Nr
103 PTRACERS_diffKrNr(k,iTracer)=diffKrNrS(k)
104 PTRACERS_ref (k,iTracer)=0. _d 0
105 ENDDO
106 PTRACERS_EvPrRn(iTracer)=UNSET_RL
107 PTRACERS_useGMRedi(iTracer)=useGMRedi
108 PTRACERS_useGMRedi(iTracer)=useGMRedi
109 PTRACERS_useDWNSLP(iTracer)=useDOWN_SLOPE
110 PTRACERS_initialFile(iTracer)=' '
111 DO ic = 1,MAX_LEN_FNAM
112 PTRACERS_names(iTracer)(ic:ic) = ' '
113 PTRACERS_long_names(iTracer)(ic:ic) = ' '
114 PTRACERS_units(iTracer)(ic:ic) = ' '
115 ENDDO
116 ENDDO
117 PTRACERS_useRecords = .FALSE.
118 #ifdef ALLOW_MNC
119 PTRACERS_timeave_mnc = useMNC .AND. timeave_mnc
120 PTRACERS_snapshot_mnc = useMNC .AND. snapshot_mnc
121 PTRACERS_monitor_mnc = useMNC .AND. monitor_mnc
122 PTRACERS_pickup_write_mnc = useMNC .AND. pickup_write_mnc
123 PTRACERS_pickup_read_mnc = useMNC .AND. pickup_read_mnc
124 #else
125 PTRACERS_timeave_mnc = .FALSE.
126 PTRACERS_snapshot_mnc = .FALSE.
127 PTRACERS_monitor_mnc = .FALSE.
128 PTRACERS_pickup_write_mnc = .FALSE.
129 PTRACERS_pickup_read_mnc = .FALSE.
130 #endif
131 tauTr1ClimRelax = 0.
132
133 C Open and read the data.ptracers file
134 WRITE(msgBuf,'(A)') ' PTRACERS_READPARMS: opening data.ptracers'
135 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
136 & SQUEEZE_RIGHT , myThid )
137 CALL OPEN_COPY_DATA_FILE(
138 I 'data.ptracers', 'PTRACERS_READPARMS',
139 O iUnit,
140 I myThid )
141 READ(UNIT=iUnit,NML=PTRACERS_PARM01)
142 WRITE(msgBuf,'(A)')
143 & ' PTRACERS_READPARMS: finished reading data.ptracers'
144 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
145 & SQUEEZE_RIGHT , myThid )
146
147 C Close the open data file
148 CLOSE(iUnit)
149
150 C Now set-up any remaining parameters that result from the input
151 C parameters
152
153 C Tracer 1 climatology relaxation time scale (<- but the code is gone !)
154 IF ( tauTr1ClimRelax .EQ. 0. ) THEN
155 lambdaTr1ClimRelax = 0.
156 ELSE
157 lambdaTr1ClimRelax = 1./tauTr1ClimRelax
158 ENDIF
159
160 C If PTRACERS_numInUse was not set in data.ptracers then we can
161 C assume that all PTRACERS fields will be in use
162 IF (PTRACERS_numInUse.LT.0) THEN
163 PTRACERS_numInUse=PTRACERS_num
164 ENDIF
165 C Check we are not trying to use more tracers than allowed
166 IF (PTRACERS_numInUse.GT.PTRACERS_num) THEN
167 WRITE(msgBuf,'(A,I4,A,I4,A)')
168 & ' PTRACERS_READPARMS: You requested',PTRACERS_numInUse,
169 & ' tracers at run time when only',PTRACERS_num,
170 & ' were specified at compile time. Naughty! '
171 CALL PRINT_ERROR( msgBuf, myThid )
172 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
173 ENDIF
174 C Check that enough parameters were specified
175 DO iTracer=1,PTRACERS_numInUse
176 IF (PTRACERS_advScheme(iTracer).EQ.0) THEN
177 WRITE(msgBuf,'(A,A,I3)')
178 & ' PTRACERS_READPARMS: ',
179 & 'No advect. scheme specified for tracer #',
180 & iTracer
181 CALL PRINT_ERROR( msgBuf, myThid )
182 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
183 ENDIF
184 ENDDO
185 #ifndef INCLUDE_IMPLVERTADV_CODE
186 DO iTracer=1,PTRACERS_numInUse
187 IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN
188 WRITE(msgBuf,'(A)')
189 & 'PTRACERS_READPARMS: #undef INCLUDE_IMPLVERTADV_CODE'
190 CALL PRINT_ERROR( msgBuf, myThid )
191 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
192 & ' but pTracers_ImplVertAdv(',iTracer,' ) is TRUE'
193 CALL PRINT_ERROR( msgBuf, myThid )
194 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
195 ENDIF
196 ENDDO
197 #endif
198 DO iTracer=1,PTRACERS_numInUse
199 IF ( PTRACERS_useGMRedi(iTracer) .AND. .NOT.useGMRedi ) THEN
200 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
201 & ' pTracers_useGMRedi(',iTracer,' ) is TRUE'
202 CALL PRINT_ERROR( msgBuf, myThid )
203 WRITE(msgBuf,'(A,L5,A)')
204 & 'PTRACERS_READPARMS: But not useGMRedi (=',useGMRedi,')'
205 CALL PRINT_ERROR( msgBuf, myThid )
206 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
207 ENDIF
208 IF ( PTRACERS_useDWNSLP(iTracer) .AND. .NOT.useDOWN_SLOPE ) THEN
209 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
210 & ' pTracers_useDWNSLP(',iTracer,' ) is TRUE'
211 CALL PRINT_ERROR( msgBuf, myThid )
212 WRITE(msgBuf,'(2A,L5,A)') 'PTRACERS_READPARMS:',
213 & ' But not useDOWN_SLOPE (=', useDOWN_SLOPE, ')'
214 CALL PRINT_ERROR( msgBuf, myThid )
215 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
216 ENDIF
217 IF ( PTRACERS_useKPP(iTracer) .AND. .NOT.useKPP ) THEN
218 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
219 & ' pTracers_useKPP(',iTracer,' ) is TRUE'
220 CALL PRINT_ERROR( msgBuf, myThid )
221 WRITE(msgBuf,'(A,L5,A)')
222 & 'PTRACERS_READPARMS: But not useKPP (=',useKPP,')'
223 CALL PRINT_ERROR( msgBuf, myThid )
224 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
225 ENDIF
226 IF ( PTRACERS_diffKr(iTracer).NE.UNSET_RL ) THEN
227 DO k=1,Nr
228 PTRACERS_diffKrNr(k,iTracer)=PTRACERS_diffKr(iTracer)
229 ENDDO
230 ENDIF
231 ENDDO
232
233 #ifdef ALLOW_MNC
234 PTRACERS_timeave_mnc = useMNC .AND. PTRACERS_timeave_mnc
235 PTRACERS_snapshot_mnc = useMNC .AND. PTRACERS_snapshot_mnc
236 PTRACERS_monitor_mnc = useMNC .AND. PTRACERS_monitor_mnc
237 PTRACERS_pickup_write_mnc = useMNC .AND. PTRACERS_pickup_write_mnc
238 PTRACERS_pickup_read_mnc = useMNC .AND. PTRACERS_pickup_read_mnc
239
240 PTRACERS_timeave_mdsio = (.NOT. PTRACERS_timeave_mnc)
241 & .OR. outputTypesInclusive
242 PTRACERS_snapshot_mdsio = (.NOT. PTRACERS_snapshot_mnc)
243 & .OR. outputTypesInclusive
244 PTRACERS_monitor_stdio = (.NOT. PTRACERS_monitor_mnc)
245 & .OR. outputTypesInclusive
246 PTRACERS_pickup_write_mdsio = (.NOT. PTRACERS_pickup_write_mnc)
247 & .OR. outputTypesInclusive
248 PTRACERS_pickup_read_mdsio = (.NOT. PTRACERS_pickup_read_mnc)
249 & .OR. outputTypesInclusive
250 #else
251 PTRACERS_timeave_mnc = .FALSE.
252 PTRACERS_snapshot_mnc = .FALSE.
253 PTRACERS_monitor_mnc = .FALSE.
254 PTRACERS_pickup_write_mnc = .FALSE.
255 PTRACERS_pickup_read_mnc = .FALSE.
256 PTRACERS_timeave_mdsio = .TRUE.
257 PTRACERS_snapshot_mdsio = .TRUE.
258 PTRACERS_monitor_stdio = .TRUE.
259 PTRACERS_pickup_write_mdsio = .TRUE.
260 PTRACERS_pickup_read_mdsio = .TRUE.
261 #endif
262
263 C-- Print a summary of pTracer parameter values:
264 iUnit = standardMessageUnit
265 WRITE(msgBuf,'(A)') '// ==================================='
266 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
267 WRITE(msgBuf,'(A)') '// PTRACERS parameters '
268 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
269 WRITE(msgBuf,'(A)') '// ==================================='
270 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
271 CALL WRITE_0D_I( PTRACERS_numInUse, INDEX_NONE,
272 & 'PTRACERS_numInUse =',
273 & ' /* number of tracers */')
274 CALL WRITE_0D_I( PTRACERS_Iter0, INDEX_NONE,
275 & 'PTRACERS_Iter0 =',
276 & ' /* timestep number when tracers are initialized */')
277 CALL WRITE_0D_R8(PTRACERS_dumpFreq, INDEX_NONE,
278 & 'PTRACERS_dumpFreq =',
279 & ' /* Frequency^-1 for snapshot output (s) */')
280 CALL WRITE_0D_R8(PTRACERS_taveFreq, INDEX_NONE,
281 & 'PTRACERS_taveFreq =',
282 & ' /* Frequency^-1 for time-Aver. output (s) */')
283 CALL WRITE_0D_L( PTRACERS_useRecords, INDEX_NONE,
284 & 'PTRACERS_useRecords =', ' /* all tracers in 1 file */')
285
286 CALL WRITE_0D_L( PTRACERS_timeave_mnc, INDEX_NONE,
287 & 'PTRACERS_timeave_mnc =',
288 & ' /* use MNC for Tave output */')
289 CALL WRITE_0D_L( PTRACERS_snapshot_mnc, INDEX_NONE,
290 & 'PTRACERS_snapshot_mnc =',
291 & ' /* use MNC for snapshot output */')
292 CALL WRITE_0D_L( PTRACERS_pickup_write_mnc, INDEX_NONE,
293 & 'PTRACERS_pickup_write_mnc =',
294 & ' /* use MNC for writing pickups */')
295 CALL WRITE_0D_L( PTRACERS_pickup_read_mnc, INDEX_NONE,
296 & 'PTRACERS_pickup_read_mnc =',
297 & ' /* use MNC for reading pickups */')
298
299 DO iTracer=1,PTRACERS_numInUse
300 WRITE(msgBuf,'(A)') ' -----------------------------------'
301 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
302 WRITE(msgBuf,'(A,I4)') ' tracer number : ',iTracer
303 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
304 CALL WRITE_0D_C( PTRACERS_ioLabel(iTracer), 0, INDEX_NONE,
305 & 'PTRACERS_ioLabel =', ' /* tracer IO Label */')
306 CALL WRITE_0D_I( PTRACERS_advScheme(iTracer), INDEX_NONE,
307 & 'PTRACERS_advScheme =', ' /* Advection Scheme */')
308 CALL WRITE_0D_L( PTRACERS_ImplVertAdv(iTracer), INDEX_NONE,
309 & 'PTRACERS_ImplVertAdv =',
310 & ' /* implicit vert. advection flag */')
311 CALL WRITE_0D_R8( PTRACERS_diffKh(iTracer), INDEX_NONE,
312 & 'PTRACERS_diffKh =', ' /* Laplacian Diffusivity */')
313 CALL WRITE_0D_R8( PTRACERS_diffK4(iTracer), INDEX_NONE,
314 & 'PTRACERS_diffK4 =', ' /* Biharmonic Diffusivity */')
315 CALL WRITE_1D_R8( PTRACERS_diffKrNr(1,iTracer), Nr, INDEX_K,
316 & 'PTRACERS_diffKrNr =', ' /* Vertical Diffusivity */')
317 CALL WRITE_0D_L( PTRACERS_useGMRedi(iTracer), INDEX_NONE,
318 & 'PTRACERS_useGMRedi =', ' /* apply GM-Redi */')
319 CALL WRITE_0D_L( PTRACERS_useDWNSLP(iTracer), INDEX_NONE,
320 & 'PTRACERS_useDWNSLP =', ' /* apply DOWN-SLOPE Flow */')
321 CALL WRITE_0D_L( PTRACERS_useKPP(iTracer), INDEX_NONE,
322 & 'PTRACERS_useKPP =', ' /* apply KPP scheme */')
323 CALL WRITE_1D_R8( PTRACERS_ref(1,iTracer), Nr, INDEX_K,
324 & 'PTRACERS_ref =', ' /* Reference vertical profile */')
325 CALL WRITE_0D_R8( PTRACERS_EvPrRn(iTracer), INDEX_NONE,
326 & 'PTRACERS_EvPrRn =', '/* tracer conc. in Evap. & Rain */')
327
328 ENDDO
329 WRITE(msgBuf,'(A)') ' -----------------------------------'
330 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
331
332 _END_MASTER(myThid)
333 C Everyone else must wait for the parameters to be loaded
334 _BARRIER
335
336 #endif /* ALLOW_PTRACERS */
337
338 RETURN
339 END
340

  ViewVC Help
Powered by ViewVC 1.1.22