/[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.35 - (show annotations) (download)
Fri Jun 26 23:10:10 2009 UTC (14 years, 11 months ago) by jahn
Branch: MAIN
CVS Tags: checkpoint62c, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62, checkpoint62b, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61s, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.34: +24 -1 lines
add package longstep

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

  ViewVC Help
Powered by ViewVC 1.1.22