/[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.28 - (show annotations) (download)
Sat Nov 10 22:09:32 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59k
Changes since 1.27: +8 -1 lines
use a 2 characters string ioLabel to identify tracers (if more than 99 tracers)

1 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_readparms.F,v 1.27 2007/11/05 18:48:04 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
43 C PTRACERS_taveFreq :: Frequency with which time-averaged PTRACERS
44 C are written to post-processing files.
45 NAMELIST /PTRACERS_PARM01/
46 & PTRACERS_dumpFreq,
47 & PTRACERS_taveFreq,
48 & PTRACERS_monitorFreq,
49 & PTRACERS_advScheme,
50 & PTRACERS_ImplVertAdv,
51 & PTRACERS_diffKh,
52 & PTRACERS_diffK4,
53 & PTRACERS_diffKr,
54 & PTRACERS_diffKrNr,
55 & PTRACERS_ref,
56 & PTRACERS_EvPrRn,
57 & PTRACERS_useGMRedi,
58 & PTRACERS_useKPP,
59 & PTRACERS_Iter0,
60 & PTRACERS_numInUse,
61 & PTRACERS_initialFile,
62 & PTRACERS_useRecords,
63 & PTRACERS_names,
64 & PTRACERS_long_names,
65 & PTRACERS_units,
66 & PTRACERS_timeave_mnc,
67 & PTRACERS_snapshot_mnc,
68 & PTRACERS_monitor_mnc,
69 & PTRACERS_pickup_write_mnc,
70 & PTRACERS_pickup_read_mnc
71
72 _BEGIN_MASTER(myThid)
73
74 C This routine has been called by the main model so we set our
75 C internal flag to indicate we are in business
76 PTRACERSisON=.TRUE.
77
78 C Set ptracer IO & diagnostics labels (2 characters long)
79 CALL PTRACERS_SET_IOLABEL(
80 O PTRACERS_ioLabel,
81 I PTRACERS_num, myThid )
82
83 C Set defaults values for parameters in PTRACERS.h
84 PTRACERS_dumpFreq = dumpFreq
85 PTRACERS_taveFreq = taveFreq
86 PTRACERS_monitorFreq = monitorFreq
87 PTRACERS_Iter0 = 0
88 PTRACERS_numInUse=-1
89 DO iTracer=1,PTRACERS_num
90 PTRACERS_advScheme(iTracer)=saltAdvScheme
91 PTRACERS_ImplVertAdv(iTracer) = .FALSE.
92 PTRACERS_diffKh(iTracer)=diffKhS
93 PTRACERS_diffK4(iTracer)=diffK4S
94 PTRACERS_diffKr(iTracer)=UNSET_RL
95 DO k=1,Nr
96 PTRACERS_diffKrNr(k,iTracer)=diffKrNrS(k)
97 PTRACERS_ref (k,iTracer)=0. _d 0
98 ENDDO
99 PTRACERS_EvPrRn(iTracer)=UNSET_RL
100 PTRACERS_useGMRedi(iTracer)=useGMRedi
101 PTRACERS_useKPP(iTracer)=useKPP
102 PTRACERS_initialFile(iTracer)=' '
103 DO ic = 1,MAX_LEN_FNAM
104 PTRACERS_names(iTracer)(ic:ic) = ' '
105 PTRACERS_long_names(iTracer)(ic:ic) = ' '
106 PTRACERS_units(iTracer)(ic:ic) = ' '
107 ENDDO
108 ENDDO
109 PTRACERS_useRecords = .FALSE.
110 #ifdef ALLOW_MNC
111 PTRACERS_timeave_mnc = useMNC .AND. timeave_mnc
112 PTRACERS_snapshot_mnc = useMNC .AND. snapshot_mnc
113 PTRACERS_monitor_mnc = useMNC .AND. monitor_mnc
114 PTRACERS_pickup_write_mnc = useMNC .AND. pickup_write_mnc
115 PTRACERS_pickup_read_mnc = useMNC .AND. pickup_read_mnc
116 #else
117 PTRACERS_timeave_mnc = .FALSE.
118 PTRACERS_snapshot_mnc = .FALSE.
119 PTRACERS_monitor_mnc = .FALSE.
120 PTRACERS_pickup_write_mnc = .FALSE.
121 PTRACERS_pickup_read_mnc = .FALSE.
122 #endif
123
124 C Open and read the data.ptracers file
125 WRITE(msgBuf,'(A)') ' PTRACERS_READPARMS: opening data.ptracers'
126 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
127 & SQUEEZE_RIGHT , myThid )
128 CALL OPEN_COPY_DATA_FILE(
129 I 'data.ptracers', 'PTRACERS_READPARMS',
130 O iUnit,
131 I myThid )
132 READ(UNIT=iUnit,NML=PTRACERS_PARM01)
133 WRITE(msgBuf,'(A)')
134 & ' PTRACERS_READPARMS: finished reading data.ptracers'
135 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
136 & SQUEEZE_RIGHT , myThid )
137
138 C Close the open data file
139 CLOSE(iUnit)
140
141 C Now set-up any remaining parameters that result from the input
142 C parameters
143
144 C If PTRACERS_numInUse was not set in data.ptracers then we can
145 C assume that all PTRACERS fields will be in use
146 IF (PTRACERS_numInUse.LT.0) THEN
147 PTRACERS_numInUse=PTRACERS_num
148 ENDIF
149 C Check we are not trying to use more tracers than allowed
150 IF (PTRACERS_numInUse.GT.PTRACERS_num) THEN
151 WRITE(msgBuf,'(A,I4,A,I4,A)')
152 & ' PTRACERS_READPARMS: You requested',PTRACERS_numInUse,
153 & ' tracers at run time when only',PTRACERS_num,
154 & ' were specified at compile time. Naughty! '
155 CALL PRINT_ERROR( msgBuf, myThid )
156 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
157 ENDIF
158 C Check that enough parameters were specified
159 DO iTracer=1,PTRACERS_numInUse
160 IF (PTRACERS_advScheme(iTracer).EQ.0) THEN
161 WRITE(msgBuf,'(A,A,I3)')
162 & ' PTRACERS_READPARMS: ',
163 & 'No advect. scheme specified for tracer #',
164 & iTracer
165 CALL PRINT_ERROR( msgBuf, myThid )
166 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
167 ENDIF
168 ENDDO
169 #ifndef INCLUDE_IMPLVERTADV_CODE
170 DO iTracer=1,PTRACERS_numInUse
171 IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN
172 WRITE(msgBuf,'(A)')
173 & 'PTRACERS_READPARMS: #undef INCLUDE_IMPLVERTADV_CODE'
174 CALL PRINT_ERROR( msgBuf, myThid )
175 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
176 & ' but pTracers_ImplVertAdv(',iTracer,' ) is TRUE'
177 CALL PRINT_ERROR( msgBuf, myThid )
178 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
179 ENDIF
180 ENDDO
181 #endif
182 DO iTracer=1,PTRACERS_numInUse
183 IF ( PTRACERS_useGMRedi(iTracer) .AND. .NOT.useGMRedi ) THEN
184 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
185 & ' pTracers_useGMRedi(',iTracer,' ) is TRUE'
186 CALL PRINT_ERROR( msgBuf, myThid )
187 WRITE(msgBuf,'(A,L5,A)')
188 & 'PTRACERS_READPARMS: But not useGMRedi (=',useGMRedi,')'
189 CALL PRINT_ERROR( msgBuf, myThid )
190 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
191 ENDIF
192 IF ( PTRACERS_useKPP(iTracer) .AND. .NOT.useKPP ) THEN
193 WRITE(msgBuf,'(2A,I3,A)') 'PTRACERS_READPARMS:',
194 & ' pTracers_useKPP(',iTracer,' ) is TRUE'
195 CALL PRINT_ERROR( msgBuf, myThid )
196 WRITE(msgBuf,'(A,L5,A)')
197 & 'PTRACERS_READPARMS: But not useKPP (=',useKPP,')'
198 CALL PRINT_ERROR( msgBuf, myThid )
199 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
200 ENDIF
201 IF ( PTRACERS_diffKr(iTracer).NE.UNSET_RL ) THEN
202 DO k=1,Nr
203 PTRACERS_diffKrNr(k,iTracer)=PTRACERS_diffKr(iTracer)
204 ENDDO
205 ENDIF
206 ENDDO
207
208 #ifdef ALLOW_MNC
209 PTRACERS_timeave_mnc = useMNC .AND. PTRACERS_timeave_mnc
210 PTRACERS_snapshot_mnc = useMNC .AND. PTRACERS_snapshot_mnc
211 PTRACERS_monitor_mnc = useMNC .AND. PTRACERS_monitor_mnc
212 PTRACERS_pickup_write_mnc = useMNC .AND. PTRACERS_pickup_write_mnc
213 PTRACERS_pickup_read_mnc = useMNC .AND. PTRACERS_pickup_read_mnc
214
215 PTRACERS_timeave_mdsio = (.NOT. PTRACERS_timeave_mnc)
216 & .OR. outputTypesInclusive
217 PTRACERS_snapshot_mdsio = (.NOT. PTRACERS_snapshot_mnc)
218 & .OR. outputTypesInclusive
219 PTRACERS_monitor_stdio = (.NOT. PTRACERS_monitor_mnc)
220 & .OR. outputTypesInclusive
221 PTRACERS_pickup_write_mdsio = (.NOT. PTRACERS_pickup_write_mnc)
222 & .OR. outputTypesInclusive
223 PTRACERS_pickup_read_mdsio = (.NOT. PTRACERS_pickup_read_mnc)
224 & .OR. outputTypesInclusive
225 #else
226 PTRACERS_timeave_mnc = .FALSE.
227 PTRACERS_snapshot_mnc = .FALSE.
228 PTRACERS_monitor_mnc = .FALSE.
229 PTRACERS_pickup_write_mnc = .FALSE.
230 PTRACERS_pickup_read_mnc = .FALSE.
231 PTRACERS_timeave_mdsio = .TRUE.
232 PTRACERS_snapshot_mdsio = .TRUE.
233 PTRACERS_monitor_stdio = .TRUE.
234 PTRACERS_pickup_write_mdsio = .TRUE.
235 PTRACERS_pickup_read_mdsio = .TRUE.
236 #endif
237
238 C-- Print a summary of pTracer parameter values:
239 iUnit = standardMessageUnit
240 WRITE(msgBuf,'(A)') '// ==================================='
241 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
242 WRITE(msgBuf,'(A)') '// PTRACERS parameters '
243 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
244 WRITE(msgBuf,'(A)') '// ==================================='
245 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , myThid )
246 CALL WRITE_0D_I( PTRACERS_numInUse, INDEX_NONE,
247 & 'PTRACERS_numInUse =',
248 & ' /* number of tracers */')
249 CALL WRITE_0D_I( PTRACERS_Iter0, INDEX_NONE,
250 & 'PTRACERS_Iter0 =',
251 & ' /* timestep number when tracers are initialized */')
252 CALL WRITE_0D_R8(PTRACERS_dumpFreq, INDEX_NONE,
253 & 'PTRACERS_dumpFreq =',
254 & ' /* Frequency^-1 for snapshot output (s) */')
255 CALL WRITE_0D_R8(PTRACERS_taveFreq, INDEX_NONE,
256 & 'PTRACERS_taveFreq =',
257 & ' /* Frequency^-1 for time-Aver. output (s) */')
258 CALL WRITE_0D_L( PTRACERS_useRecords, INDEX_NONE,
259 & 'PTRACERS_useRecords =', ' /* all tracers in 1 file */')
260
261 CALL WRITE_0D_L( PTRACERS_timeave_mnc, INDEX_NONE,
262 & 'PTRACERS_timeave_mnc =',
263 & ' /* use MNC for Tave output */')
264 CALL WRITE_0D_L( PTRACERS_snapshot_mnc, INDEX_NONE,
265 & 'PTRACERS_snapshot_mnc =',
266 & ' /* use MNC for snapshot output */')
267 CALL WRITE_0D_L( PTRACERS_pickup_write_mnc, INDEX_NONE,
268 & 'PTRACERS_pickup_write_mnc =',
269 & ' /* use MNC for writing pickups */')
270 CALL WRITE_0D_L( PTRACERS_pickup_read_mnc, INDEX_NONE,
271 & 'PTRACERS_pickup_read_mnc =',
272 & ' /* use MNC for reading pickups */')
273
274 DO iTracer=1,PTRACERS_numInUse
275 WRITE(msgBuf,'(A)') ' -----------------------------------'
276 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
277 WRITE(msgBuf,'(A,I4)') ' tracer number : ',iTracer
278 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
279 CALL WRITE_0D_C( PTRACERS_ioLabel(iTracer), 0, INDEX_NONE,
280 & 'PTRACERS_ioLabel =', ' /* tracer IO Label */')
281 CALL WRITE_0D_I( PTRACERS_advScheme(iTracer), INDEX_NONE,
282 & 'PTRACERS_advScheme =', ' /* Advection Scheme */')
283 CALL WRITE_0D_L( PTRACERS_ImplVertAdv(iTracer), INDEX_NONE,
284 & 'PTRACERS_ImplVertAdv =',
285 & ' /* implicit vert. advection flag */')
286 CALL WRITE_0D_R8( PTRACERS_diffKh(iTracer), INDEX_NONE,
287 & 'PTRACERS_diffKh =', ' /* Laplacian Diffusivity */')
288 CALL WRITE_0D_R8( PTRACERS_diffK4(iTracer), INDEX_NONE,
289 & 'PTRACERS_diffK4 =', ' /* Biharmonic Diffusivity */')
290 CALL WRITE_1D_R8( PTRACERS_diffKrNr(1,iTracer), Nr, INDEX_K,
291 & 'PTRACERS_diffKrNr =', ' /* Vertical Diffusivity */')
292 CALL WRITE_0D_L( PTRACERS_useGMRedi(iTracer), INDEX_NONE,
293 & 'PTRACERS_useGMRedi =', ' /* apply GM-Redi */')
294 CALL WRITE_0D_L( PTRACERS_useKPP(iTracer), INDEX_NONE,
295 & 'PTRACERS_useKPP =', ' /* apply KPP scheme */')
296 CALL WRITE_1D_R8( PTRACERS_ref(1,iTracer), Nr, INDEX_K,
297 & 'PTRACERS_ref =', ' /* Reference vertical profile */')
298 CALL WRITE_0D_R8( PTRACERS_EvPrRn(iTracer), INDEX_NONE,
299 & 'PTRACERS_EvPrRn =', '/* tracer conc. in Evap. & Rain */')
300
301 ENDDO
302 WRITE(msgBuf,'(A)') ' -----------------------------------'
303 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT, myThid )
304
305 _END_MASTER(myThid)
306 C Everyone else must wait for the parameters to be loaded
307 _BARRIER
308
309 #endif /* ALLOW_PTRACERS */
310
311 RETURN
312 END
313

  ViewVC Help
Powered by ViewVC 1.1.22