/[MITgcm]/MITgcm/model/src/ini_parms.F
ViewVC logotype

Contents of /MITgcm/model/src/ini_parms.F

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


Revision 1.77 - (show annotations) (download)
Mon Mar 4 17:26:41 2002 UTC (22 years, 3 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint44f_post, checkpoint44g_post
Changes since 1.76: +1 -2 lines
Added PTRACERS package

This allows an arbitrary number of passive tracers to be integrated
forward simultaneously with the dynamicaly model.
 + Implemented so far:
    - basic forward algorithm (time-stepping, advection, diffusion, convection)
    - I/O and checkpointing
    - GM/Redi  *but*  using the GM/Redi coefficient of Salt
 + Not implemented so far:
    - KPP
    - OBCS
 + No specific example supplied (yet) but global_ocean.90x40x15 has the
   necessary data.ptracer file. Simply use -enable=ptracers and uncomment
   line in data.pkg. PTRACER01 then reproduces Salt exactly.
 + This package is disabled by default since it increases storage.

1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_parms.F,v 1.76 2002/02/10 00:35:30 jmc Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: INI_PARMS
8 C !INTERFACE:
9 SUBROUTINE INI_PARMS( myThid )
10 C !DESCRIPTION: \bv
11 C *==========================================================*
12 C | SUBROUTINE INI_PARMS
13 C | o Routine to set model "parameters"
14 C *==========================================================*
15 C | Notes:
16 C | ======
17 C | The present version of this routine is a place-holder.
18 C | A production version needs to handle parameters from an
19 C | external file and possibly reading in some initial field
20 C | values.
21 C *==========================================================*
22 C \ev
23
24 C !USES:
25 IMPLICIT NONE
26 C === Global variables ===
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29 #include "PARAMS.h"
30 #include "GRID.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C === Routine arguments ===
34 C myThid - Number of this instance of INI_PARMS
35 INTEGER myThid
36
37 C !LOCAL VARIABLES:
38 C === Local variables ===
39 C dxSpacing, dySpacing - Default spacing in X and Y.
40 C Units are that of coordinate system
41 C i.e. cartesian => metres
42 C s. polar => degrees
43 C goptCount - Used to count the nuber of grid options
44 C (only one is allowed! )
45 C msgBuf - Informational/error meesage buffer
46 C errIO - IO error flag
47 C iUnit - Work variable for IO unit number
48 C record - Work variable for IO buffer
49 C K, I, J - Loop counters
50 C xxxDefault - Default value for variable xxx
51 _RL dxSpacing
52 _RL dySpacing
53 CHARACTER*(MAX_LEN_FNAM) delXfile
54 CHARACTER*(MAX_LEN_FNAM) delYfile
55 CHARACTER*(MAX_LEN_MBUF) msgBuf
56 CHARACTER*(MAX_LEN_PREC) record
57 INTEGER goptCount
58 INTEGER K, I, J, IL, iUnit
59 INTEGER errIO
60 INTEGER IFNBLNK
61 EXTERNAL IFNBLNK
62 INTEGER ILNBLNK
63 EXTERNAL ILNBLNK
64 C Default values for variables which have vertical coordinate system
65 C dependency.
66 _RL viscArDefault
67 _RL diffKrTDefault
68 _RL diffKrSDefault
69 _RL hFacMinDrDefault
70 _RL delRDefault(Nr)
71 _RS rkFacDefault
72 C zCoordInputData :: Variables used to select between different coordinate systems.
73 C pCoordInputData :: The vertical coordinate system in the rest of the model is
74 C rCoordInputData :: written in terms of r. In the model "data" file input data can
75 C coordsSet :: be interms of z, p or r.
76 C :: e.g. delZ or delP or delR for the vertical grid spacing.
77 C :: The following rules apply:
78 C :: All parameters must use the same vertical coordinate system.
79 C :: e.g. delZ and viscAz is legal but
80 C :: delZ and viscAr is an error.
81 C :: Similarly specifyinh delZ and delP is an error.
82 C :: zCoord..., pCoord..., rCoord... are used to flag when z, p or r are
83 C :: used. coordsSet counts how many vertical coordinate systems have been
84 C used to specify variables. coordsSet > 1 is an error.
85 C
86 LOGICAL zCoordInputData
87 LOGICAL pCoordInputData
88 LOGICAL rCoordInputData
89 INTEGER coordsSet
90
91 C Retired main data file parameters. Kept here to trap use of old data files.
92 C zonal_filt_lat - Moved to package "zonal_filt"
93 C nRetired :: Counter used to trap gracefully namelists containing "retired"
94 C :: parameters. These are parameters that are either no-longer used
95 C or that have moved to a different input file and/or namelist.
96 _RL zonal_filt_lat
97 INTEGER nRetired
98 CEOP
99
100 C-- Continuous equation parameters
101 NAMELIST /PARM01/
102 & gravity, gBaro, rhonil, tAlpha, sBeta, f0, beta, omega,
103 & viscAh, viscAz, viscA4, cosPower, viscAstrain, viscAtension,
104 & diffKhT, diffKzT, diffK4T,
105 & diffKhS, diffKzS, diffK4S,
106 & tRef, sRef, eosType, Integr_GeoPot,
107 & no_slip_sides,no_slip_bottom,
108 & momViscosity, momAdvection, momForcing, useCoriolis,
109 & momPressureForcing, metricTerms, vectorInvariantMomentum,
110 & tempDiffusion, tempAdvection, tempForcing,
111 & saltDiffusion, saltAdvection, saltForcing,
112 & implicSurfPress, implicDiv2DFlow,
113 & implicitFreeSurface, rigidLid, freeSurfFac, hFacMin, hFacMinDz,
114 & exactConserv,uniformLin_PhiSurf,nonlinFreeSurf,hFacInf,hFacSup,
115 & staggerTimeStep,
116 & tempStepping, saltStepping, momStepping, tr1Stepping,
117 & implicitDiffusion, implicitViscosity,
118 & viscAr, diffKrT, diffKrS, hFacMinDr,
119 & viscAp, diffKpT, diffKpS, hFacMinDp,
120 & rhoConst, buoyancyRelation, HeatCapacity_Cp,
121 & writeBinaryPrec, readBinaryPrec, writeStatePrec,
122 & nonHydrostatic, globalFiles,
123 & allowFreezing, ivdc_kappa,
124 & bottomDragLinear,bottomDragQuadratic,
125 & usePickupBeforeC35, debugMode,
126 & readPickupWithTracer, writePickupWithTracer,
127 & tempAdvScheme, saltAdvScheme, tracerAdvScheme,
128 & multiDimAdvection, useEnergyConservingCoriolis,
129 & useJamartWetPoints,
130 & useRealFreshWaterFlux, convertFW2Salt,
131 & temp_EvPrRn, salt_EvPrRn, trac_EvPrRn,
132 & zonal_filt_lat
133
134 C-- Elliptic solver parameters
135 NAMELIST /PARM02/
136 & cg2dMaxIters, cg2dChkResFreq, cg2dTargetResidual,
137 & cg2dTargetResWunit, cg2dpcOffDFac,
138 & cg3dMaxIters, cg3dChkResFreq, cg3dTargetResidual
139
140 C-- Time stepping parammeters
141 NAMELIST /PARM03/
142 & nIter0, nTimeSteps, nEndIter, deltaT, deltaTmom, deltaTtracer,
143 & abEps, tauCD, rCD,
144 & startTime, endTime, chkPtFreq,
145 & dumpFreq, taveFreq, deltaTClock, diagFreq,
146 & monitorFreq, pChkPtFreq, cAdjFreq,
147 & tauThetaClimRelax, tauSaltClimRelax, tauTr1ClimRelax,
148 & periodicExternalForcing, externForcingPeriod, externForcingCycle
149
150 C-- Gridding parameters
151 NAMELIST /PARM04/
152 & usingCartesianGrid, dxSpacing, dySpacing, delX, delY, delZ,
153 & usingSphericalPolarGrid, phiMin, thetaMin, rSphere,
154 & usingCurvilinearGrid,
155 & delP, delR, rkFac, Ro_SeaLevel, groundAtK1,
156 & delXfile, delYfile
157
158 C-- Input files
159 NAMELIST /PARM05/
160 & bathyFile, topoFile, hydrogThetaFile, hydrogSaltFile,
161 & zonalWindFile, meridWindFile,
162 & thetaClimFile, saltClimFile,
163 & surfQfile, EmPmRfile, surfQswfile,
164 & uVelInitFile, vVelInitFile, pSurfInitFile,
165 & dQdTFile
166
167 C
168 _BEGIN_MASTER(myThid)
169
170 C Defaults values for input parameters
171 CALL SET_DEFAULTS(
172 O viscArDefault, diffKrTDefault, diffKrSDefault,
173 O hFacMinDrDefault, delRdefault, rkFacDefault,
174 I myThid )
175
176 C-- Initialise "which vertical coordinate system used" flags.
177 zCoordInputData = .FALSE.
178 pCoordInputData = .FALSE.
179 rCoordInputData = .FALSE.
180 usingPCoords = .FALSE.
181 usingZCoords = .FALSE.
182 coordsSet = 0
183
184 C-- Iniialise retired parameters to unlikely value
185 nRetired = 0
186 zonal_filt_lat = UNSET_RL
187
188 C-- Open the parameter file
189 OPEN(UNIT=scrUnit1,STATUS='SCRATCH')
190 OPEN(UNIT=scrUnit2,STATUS='SCRATCH')
191 OPEN(UNIT=modelDataUnit,FILE='data',STATUS='OLD',
192 & IOSTAT=errIO)
193 IF ( errIO .LT. 0 ) THEN
194 WRITE(msgBuf,'(A)')
195 & 'S/R INI_PARMS'
196 CALL PRINT_ERROR( msgBuf , 1)
197 WRITE(msgBuf,'(A)')
198 & 'Unable to open model parameter'
199 CALL PRINT_ERROR( msgBuf , 1)
200 WRITE(msgBuf,'(A)')
201 & 'file "data"'
202 CALL PRINT_ERROR( msgBuf , 1)
203 CALL MODELDATA_EXAMPLE( myThid )
204 STOP 'ABNORMAL END: S/R INI_PARMS'
205 ENDIF
206
207 DO WHILE ( .TRUE. )
208 READ(modelDataUnit,FMT='(A)',END=1001) RECORD
209 IL = MAX(ILNBLNK(RECORD),1)
210 IF ( RECORD(1:1) .NE. commentCharacter )
211 & WRITE(UNIT=scrUnit1,FMT='(A)') RECORD(:IL)
212 WRITE(UNIT=scrUnit2,FMT='(A)') RECORD(:IL)
213 ENDDO
214 1001 CONTINUE
215 CLOSE(modelDataUnit)
216
217 C-- Report contents of model parameter file
218 WRITE(msgBuf,'(A)')
219 &'// ======================================================='
220 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
221 & SQUEEZE_RIGHT , 1)
222 WRITE(msgBuf,'(A)') '// Model parameter file "data"'
223 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
224 & SQUEEZE_RIGHT , 1)
225 WRITE(msgBuf,'(A)')
226 &'// ======================================================='
227 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
228 & SQUEEZE_RIGHT , 1)
229 iUnit = scrUnit2
230 REWIND(iUnit)
231 DO WHILE ( .TRUE. )
232 READ(UNIT=iUnit,FMT='(A)',END=2001) RECORD
233 IL = MAX(ILNBLNK(RECORD),1)
234 WRITE(msgBuf,'(A,A)') '>',RECORD(:IL)
235 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
236 & SQUEEZE_RIGHT , 1)
237 ENDDO
238 2001 CONTINUE
239 CLOSE(iUnit)
240 WRITE(msgBuf,'(A)') ' '
241 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
242 & SQUEEZE_RIGHT , 1)
243
244
245 C-- Read settings from model parameter file "data".
246 iUnit = scrUnit1
247 REWIND(iUnit)
248
249 C-- Set default "physical" parameters
250 viscAz = UNSET_RL
251 viscAr = UNSET_RL
252 viscAp = UNSET_RL
253 diffKzT = UNSET_RL
254 diffKpT = UNSET_RL
255 diffKrT = UNSET_RL
256 diffKzS = UNSET_RL
257 diffKpS = UNSET_RL
258 diffKrS = UNSET_RL
259 gBaro = UNSET_RL
260 rhoConst = UNSET_RL
261 hFacMinDr = UNSET_RL
262 hFacMinDz = UNSET_RL
263 hFacMinDp = UNSET_RL
264 convertFW2Salt = UNSET_RL
265 READ(UNIT=iUnit,NML=PARM01) !,IOSTAT=errIO)
266 IF ( errIO .LT. 0 ) THEN
267 WRITE(msgBuf,'(A)')
268 & 'S/R INI_PARMS'
269 CALL PRINT_ERROR( msgBuf , 1)
270 WRITE(msgBuf,'(A)')
271 & 'Error reading numerical model '
272 CALL PRINT_ERROR( msgBuf , 1)
273 WRITE(msgBuf,'(A)')
274 & 'parameter file "data"'
275 CALL PRINT_ERROR( msgBuf , 1)
276 WRITE(msgBuf,'(A)')
277 & 'Problem in namelist PARM01'
278 CALL PRINT_ERROR( msgBuf , 1)
279 CALL MODELDATA_EXAMPLE( myThid )
280 STOP 'ABNORMAL END: S/R INI_PARMS'
281 ELSE
282 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM01 : OK'
283 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
284 & SQUEEZE_RIGHT , 1)
285 ENDIF
286 IF ( implicitFreeSurface ) freeSurfFac = 1.D0
287 IF ( rigidLid ) freeSurfFac = 0.D0
288 IF ( gBaro .EQ. UNSET_RL ) gBaro=gravity
289 IF ( rhoConst .EQ. UNSET_RL ) rhoConst=rhoNil
290 C-- Momentum viscosity on/off flag.
291 IF ( momViscosity ) THEN
292 vfFacMom = 1.D0
293 ELSE
294 vfFacMom = 0.D0
295 ENDIF
296 C-- Momentum advection on/off flag.
297 IF ( momAdvection ) THEN
298 afFacMom = 1.D0
299 ELSE
300 afFacMom = 0.D0
301 ENDIF
302 C-- Momentum forcing on/off flag.
303 IF ( momForcing ) THEN
304 foFacMom = 1.D0
305 ELSE
306 foFacMom = 0.D0
307 ENDIF
308 C-- Coriolis term on/off flag.
309 IF ( useCoriolis ) THEN
310 cfFacMom = 1.D0
311 ELSE
312 cfFacMom = 0.D0
313 ENDIF
314 C-- Pressure term on/off flag.
315 IF ( momPressureForcing ) THEN
316 pfFacMom = 1.D0
317 ELSE
318 pfFacMom = 0.D0
319 ENDIF
320 C-- Metric terms on/off flag.
321 IF ( metricTerms ) THEN
322 mTFacMom = 1.D0
323 ELSE
324 mTFacMom = 0.D0
325 ENDIF
326 C-- z,p,r coord input switching.
327 IF ( viscAz .NE. UNSET_RL ) zCoordInputData = .TRUE.
328 IF ( viscAp .NE. UNSET_RL ) pCoordInputData = .TRUE.
329 IF ( viscAr .NE. UNSET_RL ) rCoordInputData = .TRUE.
330 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAz
331 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAp
332 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscArDefault
333
334 IF ( diffKzT .NE. UNSET_RL ) zCoordInputData = .TRUE.
335 IF ( diffKpT .NE. UNSET_RL ) pCoordInputData = .TRUE.
336 IF ( diffKrT .NE. UNSET_RL ) rCoordInputData = .TRUE.
337 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKzT
338 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKpT
339 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKrTDefault
340
341 IF ( diffKzS .NE. UNSET_RL ) zCoordInputData = .TRUE.
342 IF ( diffKpS .NE. UNSET_RL ) pCoordInputData = .TRUE.
343 IF ( diffKrS .NE. UNSET_RL ) rCoordInputData = .TRUE.
344 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKzS
345 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKpS
346 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKrSDefault
347
348 IF ( hFacMinDz .NE. UNSET_RL ) zCoordInputData = .TRUE.
349 IF ( hFacMinDp .NE. UNSET_RL ) pCoordInputData = .TRUE.
350 IF ( hFacMinDr .NE. UNSET_RL ) rCoordInputData = .TRUE.
351 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDz
352 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDp
353 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDrDefault
354
355 IF (convertFW2Salt.EQ.UNSET_RL) THEN
356 convertFW2Salt = 35.
357 IF (useRealFreshWaterFlux) convertFW2Salt=-1
358 ENDIF
359
360 IF ( ivdc_kappa .NE. 0. .AND. .NOT. implicitDiffusion ) THEN
361 WRITE(msgBuf,'(A,A)')
362 & 'S/R INI_PARMS: To use ivdc_kappa you must enable implicit',
363 & ' vertical diffusion.'
364 CALL PRINT_ERROR( msgBuf , myThid)
365 STOP 'ABNORMAL END: S/R INI_PARMS'
366 ENDIF
367
368 coordsSet = 0
369 IF ( zCoordInputData ) coordsSet = coordsSet + 1
370 IF ( pCoordInputData ) coordsSet = coordsSet + 1
371 IF ( rCoordInputData ) coordsSet = coordsSet + 1
372 IF ( coordsSet .GT. 1 ) THEN
373 WRITE(msgBuf,'(A)')
374 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
375 CALL PRINT_ERROR( msgBuf , myThid)
376 STOP 'ABNORMAL END: S/R INI_PARMS'
377 ENDIF
378 IF ( rhoConst .LE. 0. ) THEN
379 WRITE(msgBuf,'(A)')
380 & 'S/R INI_PARMS: rhoConst must be greater than 0.'
381 CALL PRINT_ERROR( msgBuf , myThid)
382 STOP 'ABNORMAL END: S/R INI_PARMS'
383 ELSE
384 recip_rhoConst = 1.D0 / rhoConst
385 ENDIF
386 IF ( rhoNil .LE. 0. ) THEN
387 WRITE(msgBuf,'(A)')
388 & 'S/R INI_PARMS: rhoNil must be greater than 0.'
389 CALL PRINT_ERROR( msgBuf , myThid)
390 STOP 'ABNORMAL END: S/R INI_PARMS'
391 ELSE
392 recip_rhoNil = 1.D0 / rhoNil
393 ENDIF
394 IF ( HeatCapacity_Cp .LE. 0. ) THEN
395 WRITE(msgBuf,'(A)')
396 & 'S/R INI_PARMS: HeatCapacity_Cp must be greater than 0.'
397 CALL PRINT_ERROR( msgBuf , myThid)
398 STOP 'ABNORMAL END: S/R INI_PARMS'
399 ELSE
400 recip_Cp = 1.D0 / HeatCapacity_Cp
401 ENDIF
402 IF ( gravity .LE. 0. ) THEN
403 WRITE(msgBuf,'(A)')
404 & 'S/R INI_PARMS: gravity must be greater than 0.'
405 CALL PRINT_ERROR( msgBuf , myThid)
406 STOP 'ABNORMAL END: S/R INI_PARMS'
407 ELSE
408 recip_gravity = 1.D0 / gravity
409 ENDIF
410 C Set globalFiles flag for READ_WRITE_FLD package
411 CALL SET_WRITE_GLOBAL_FLD( globalFiles )
412 C Set globalFiles flag for READ_WRITE_REC package
413 CALL SET_WRITE_GLOBAL_REC( globalFiles )
414 C Set globalFiles flag for READ_WRITE_REC package
415 CALL SET_WRITE_GLOBAL_PICKUP( globalFiles )
416
417 C Check for retired parameters still being used
418 nRetired = 0
419 IF ( zonal_filt_lat .NE. UNSET_RL ) THEN
420 nRetired = nRetired+1
421 WRITE(msgBuf,'(A,A)')
422 & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is',
423 & ' no longer allowed in file "data".'
424 CALL PRINT_ERROR( msgBuf , myThid)
425 WRITE(msgBuf,'(A,A)')
426 & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is',
427 & ' now read from file "data.zonfilt".'
428 CALL PRINT_ERROR( msgBuf , myThid)
429 ENDIF
430
431 C-- Elliptic solver parameters
432 READ(UNIT=iUnit,NML=PARM02) !,IOSTAT=errIO)
433 IF ( errIO .LT. 0 ) THEN
434 WRITE(msgBuf,'(A)')
435 & 'S/R INI_PARMS'
436 CALL PRINT_ERROR( msgBuf , 1)
437 WRITE(msgBuf,'(A)')
438 & 'Error reading numerical model '
439 CALL PRINT_ERROR( msgBuf , 1)
440 WRITE(msgBuf,'(A)')
441 & 'parameter file "data".'
442 CALL PRINT_ERROR( msgBuf , 1)
443 WRITE(msgBuf,'(A)')
444 & 'Problem in namelist PARM02'
445 CALL PRINT_ERROR( msgBuf , 1)
446 CALL MODELDATA_EXAMPLE( myThid )
447 STOP 'ABNORMAL END: S/R INI_PARMS'
448 ELSE
449 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM02 : OK'
450 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
451 & SQUEEZE_RIGHT , 1)
452 ENDIF
453
454 C-- Time stepping parameters
455 rCD = -1.D0
456 READ(UNIT=iUnit,NML=PARM03) !,IOSTAT=errIO)
457 IF ( errIO .LT. 0 ) THEN
458 WRITE(msgBuf,'(A)')
459 & 'S/R INI_PARMS'
460 CALL PRINT_ERROR( msgBuf , 1)
461 WRITE(msgBuf,'(A)')
462 & 'Error reading numerical model '
463 CALL PRINT_ERROR( msgBuf , 1)
464 WRITE(msgBuf,'(A)')
465 & 'parameter file "data"'
466 CALL PRINT_ERROR( msgBuf , 1)
467 WRITE(msgBuf,'(A)')
468 & 'Problem in namelist PARM03'
469 CALL PRINT_ERROR( msgBuf , 1)
470 CALL MODELDATA_EXAMPLE( myThid )
471 STOP 'ABNORMAL END: S/R INI_PARMS'
472 ELSE
473 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM03 : OK'
474 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
475 & SQUEEZE_RIGHT , 1)
476 ENDIF
477 C Process "timestepping" params
478 C o Time step size
479 IF ( deltaT .EQ. 0. ) deltaT = deltaTmom
480 IF ( deltaT .EQ. 0. ) deltaT = deltaTtracer
481 IF ( deltaTmom .EQ. 0. ) deltaTmom = deltaT
482 IF ( deltaTtracer .EQ. 0. ) deltaTtracer = deltaT
483 IF ( deltaTClock .EQ. 0. ) deltaTClock = deltaT
484 IF ( periodicExternalForcing ) THEN
485 IF ( externForcingCycle*externForcingPeriod .EQ. 0. ) THEN
486 WRITE(msgBuf,'(A)')
487 & 'S/R INI_PARMS: externForcingCycle,externForcingPeriod =0'
488 CALL PRINT_ERROR( msgBuf , 1)
489 STOP 'ABNORMAL END: S/R INI_PARMS'
490 ENDIF
491 IF ( INT(externForcingCycle/externForcingPeriod) .NE.
492 & externForcingCycle/externForcingPeriod ) THEN
493 WRITE(msgBuf,'(A)')
494 & 'S/R INI_PARMS: externForcingCycle <> N*externForcingPeriod'
495 CALL PRINT_ERROR( msgBuf , 1)
496 STOP 'ABNORMAL END: S/R INI_PARMS'
497 ENDIF
498 IF ( externForcingCycle.le.externForcingPeriod ) THEN
499 WRITE(msgBuf,'(A)')
500 & 'S/R INI_PARMS: externForcingCycle < externForcingPeriod'
501 CALL PRINT_ERROR( msgBuf , 1)
502 STOP 'ABNORMAL END: S/R INI_PARMS'
503 ENDIF
504 IF ( externForcingPeriod.lt.deltaTclock ) THEN
505 WRITE(msgBuf,'(A)')
506 & 'S/R INI_PARMS: externForcingPeriod < deltaTclock'
507 CALL PRINT_ERROR( msgBuf , 1)
508 STOP 'ABNORMAL END: S/R INI_PARMS'
509 ENDIF
510 ENDIF
511 C o Convection frequency
512 IF ( cAdjFreq .LT. 0. ) THEN
513 cAdjFreq = deltaTClock
514 ENDIF
515 IF ( ivdc_kappa .NE. 0. .AND. cAdjFreq .NE. 0. ) THEN
516 WRITE(msgBuf,'(A,A)')
517 & 'S/R INI_PARMS: You have enabled both ivdc_kappa and',
518 & ' convective adjustment.'
519 CALL PRINT_ERROR( msgBuf , myThid)
520 STOP 'ABNORMAL END: S/R INI_PARMS'
521 ENDIF
522 C o CD coupling
523 IF ( tauCD .EQ. 0.D0 ) THEN
524 tauCD = deltaTmom
525 ENDIF
526 IF ( rCD .LT. 0. ) THEN
527 rCD = 1. - deltaTMom/tauCD
528 ENDIF
529 C o Temperature climatology relaxation time scale
530 IF ( tauThetaClimRelax .EQ. 0.D0 ) THEN
531 doThetaClimRelax = .FALSE.
532 lambdaThetaClimRelax = 0.D0
533 ELSE
534 doThetaClimRelax = .TRUE.
535 lambdaThetaClimRelax = 1./tauThetaClimRelax
536 ENDIF
537 C o Salinity climatology relaxation time scale
538 IF ( tauSaltClimRelax .EQ. 0.D0 ) THEN
539 doSaltClimRelax = .FALSE.
540 lambdaSaltClimRelax = 0.D0
541 ELSE
542 doSaltClimRelax = .TRUE.
543 lambdaSaltClimRelax = 1./tauSaltClimRelax
544 ENDIF
545 C o Tracer 1 climatology relaxation time scale
546 IF ( tauTr1ClimRelax .EQ. 0.D0 ) THEN
547 doTr1ClimRelax = .FALSE.
548 lambdaTr1ClimRelax = 0.D0
549 ELSE
550 doTr1ClimRelax = .TRUE.
551 lambdaTr1ClimRelax = 1./tauTr1ClimRelax
552 ENDIF
553
554 C o Start time
555 IF ( nIter0 .NE. 0 .AND. startTime .EQ. 0. )
556 & startTime = deltaTClock*float(nIter0)
557 C o nIter0
558 IF ( nIter0 .EQ. 0 .AND. startTime .NE. 0. )
559 & nIter0 = INT( startTime/deltaTClock )
560
561 C o nTimeSteps 1
562 IF ( nTimeSteps .EQ. 0 .AND. nEndIter .NE. 0 )
563 & nTimeSteps = nEndIter-nIter0
564 C o nTimeSteps 2
565 IF ( nTimeSteps .EQ. 0 .AND. endTime .NE. 0. )
566 & nTimeSteps = int(0.5+(endTime-startTime)/deltaTclock)
567 C o nEndIter 1
568 IF ( nEndIter .EQ. 0 .AND. nTimeSteps .NE. 0 )
569 & nEndIter = nIter0+nTimeSteps
570 C o nEndIter 2
571 IF ( nEndIter .EQ. 0 .AND. endTime .NE. 0. )
572 & nEndIter = int(0.5+endTime/deltaTclock)
573 C o End Time 1
574 IF ( endTime .EQ. 0. .AND. nTimeSteps .NE. 0 )
575 & endTime = startTime + deltaTClock*float(nTimeSteps)
576 C o End Time 2
577 IF ( endTime .EQ. 0. .AND. nEndIter .NE. 0 )
578 & endTime = deltaTClock*float(nEndIter)
579
580 C o Consistent?
581 IF ( nEndIter .NE. nIter0+nTimeSteps ) THEN
582 WRITE(msgBuf,'(A)')
583 & 'S/R INI_PARMS: nIter0, nTimeSteps and nEndIter are inconsistent'
584 CALL PRINT_ERROR( msgBuf , 1)
585 WRITE(msgBuf,'(A)')
586 & 'S/R INI_PARMS: Perhaps more than two were set at once'
587 CALL PRINT_ERROR( msgBuf , 1)
588 STOP 'ABNORMAL END: S/R INI_PARMS'
589 ENDIF
590 IF ( nTimeSteps .NE. int(0.5+(endTime-startTime)/deltaTClock) )
591 & THEN
592 WRITE(msgBuf,'(A)')
593 & 'S/R INI_PARMS: both endTime and nTimeSteps have been set'
594 CALL PRINT_ERROR( msgBuf , 1)
595 WRITE(msgBuf,'(A)')
596 & 'S/R INI_PARMS: but are inconsistent'
597 CALL PRINT_ERROR( msgBuf , 1)
598 STOP 'ABNORMAL END: S/R INI_PARMS'
599 ENDIF
600
601 C o Monitor (should also add CPP flag for monitor?)
602 IF (monitorFreq.LT.0.) THEN
603 monitorFreq=0.
604 IF (dumpFreq.NE.0.) monitorFreq=dumpFreq
605 IF (diagFreq.NE.0..AND.diagFreq.LT.monitorFreq)
606 & monitorFreq=diagFreq
607 IF (taveFreq.NE.0..AND.taveFreq.LT.monitorFreq)
608 & monitorFreq=taveFreq
609 IF (chkPtFreq.NE.0..AND.chkPtFreq.LT.monitorFreq)
610 & monitorFreq=chkPtFreq
611 IF (pChkPtFreq.NE.0..AND.pChkPtFreq.LT.monitorFreq)
612 & monitorFreq=pChkPtFreq
613 IF (monitorFreq.EQ.0.) monitorFreq=deltaTclock
614 ENDIF
615
616 C o If taveFreq is finite, then we must make sure the diagnostics
617 C code is being compiled
618 #ifndef ALLOW_TIMEAVE
619 IF (taveFreq.NE.0.) THEN
620 WRITE(msgBuf,'(A)')
621 & 'S/R INI_PARMS: taveFreq <> 0 but you have'
622 CALL PRINT_ERROR( msgBuf , 1)
623 WRITE(msgBuf,'(A)')
624 & 'not compiled the model with the diagnostics routines.'
625 CALL PRINT_ERROR( msgBuf , 1)
626 WRITE(msgBuf,'(A,A)')
627 & 'Re-compile with: #define ALLOW_TIMEAVE',
628 & ' or -DALLOW_TIMEAVE'
629 CALL PRINT_ERROR( msgBuf , 1)
630 STOP 'ABNORMAL END: S/R INI_PARMS'
631 ENDIF
632 #endif
633
634 C-- Grid parameters
635 C In cartesian coords distances are in metres
636 rkFac = UNSET_RS
637 DO K =1,Nr
638 delZ(K) = UNSET_RL
639 delP(K) = UNSET_RL
640 delR(K) = UNSET_RL
641 ENDDO
642 C In spherical polar distances are in degrees
643 recip_rSphere = 1.D0/rSphere
644 dxSpacing = UNSET_RL
645 dySpacing = UNSET_RL
646 delXfile = ' '
647 delYfile = ' '
648 READ(UNIT=iUnit,NML=PARM04) !,IOSTAT=errIO)
649 IF ( errIO .LT. 0 ) THEN
650 WRITE(msgBuf,'(A)')
651 & 'S/R INI_PARMS'
652 CALL PRINT_ERROR( msgBuf , 1)
653 WRITE(msgBuf,'(A)')
654 & 'Error reading numerical model '
655 CALL PRINT_ERROR( msgBuf , 1)
656 WRITE(msgBuf,'(A)')
657 & 'parameter file "data"'
658 CALL PRINT_ERROR( msgBuf , 1)
659 WRITE(msgBuf,'(A)')
660 & 'Problem in namelist PARM04'
661 CALL PRINT_ERROR( msgBuf , 1)
662 CALL MODELDATA_EXAMPLE( myThid )
663 STOP 'ABNORMAL END: S/R INI_PARMS'
664 ELSE
665 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM04 : OK'
666 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
667 & SQUEEZE_RIGHT , 1)
668 ENDIF
669
670 C X coordinate
671 IF ( delXfile .NE. ' ' ) THEN
672 IF ( delX(1) .NE. UNSET_RL .OR. dxSpacing .NE. UNSET_RL ) THEN
673 WRITE(msgBuf,'(A,A)') 'Too many specifications for delX:',
674 & 'Specify only one of delX, dxSpacing or delXfile'
675 CALL PRINT_ERROR( msgBuf , 1)
676 STOP 'ABNORMAL END: S/R INI_PARMS'
677 ELSE
678 _BEGIN_MASTER( myThid )
679 IF (readBinaryPrec.EQ.precFloat32) THEN
680 OPEN(37,FILE=delXfile,STATUS='OLD',FORM='UNFORMATTED',
681 & ACCESS='DIRECT',RECL=WORDLENGTH*Nx)
682 READ(37,rec=1) delX
683 #ifdef _BYTESWAPIO
684 call MDS_BYTESWAPR4( Nx, delX )
685 #endif
686 CLOSE(37)
687 ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
688 OPEN(37,FILE=delXfile,STATUS='OLD',FORM='UNFORMATTED',
689 & ACCESS='DIRECT',RECL=WORDLENGTH*2*Nx)
690 READ(37,rec=1) delX
691 #ifdef _BYTESWAPIO
692 call MDS_BYTESWAPR8( Nx, delX )
693 #endif
694 CLOSE(37)
695 ENDIF
696 _END_MASTER(myThid)
697 ENDIF
698 ENDIF
699 IF ( dxSpacing .NE. UNSET_RL ) THEN
700 DO i=1,Nx
701 delX(i) = dxSpacing
702 ENDDO
703 ENDIF
704 C Y coordinate
705 IF ( delYfile .NE. ' ' ) THEN
706 IF ( delY(1) .NE. UNSET_RL .OR. dySpacing .NE. UNSET_RL ) THEN
707 WRITE(msgBuf,'(A,A)') 'Too many specifications for delY:',
708 & 'Specify only one of delY, dySpacing or delYfile'
709 CALL PRINT_ERROR( msgBuf , 1)
710 STOP 'ABNORMAL END: S/R INI_PARMS'
711 ELSE
712 _BEGIN_MASTER( myThid )
713 IF (readBinaryPrec.EQ.precFloat32) THEN
714 OPEN(37,FILE=delYfile,STATUS='OLD',FORM='UNFORMATTED',
715 & ACCESS='DIRECT',RECL=WORDLENGTH*Ny)
716 READ(37,rec=1) delY
717 #ifdef _BYTESWAPIO
718 call MDS_BYTESWAPR4( Ny, delY )
719 #endif
720 CLOSE(37)
721 ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
722 OPEN(37,FILE=delYfile,STATUS='OLD',FORM='UNFORMATTED',
723 & ACCESS='DIRECT',RECL=WORDLENGTH*2*Ny)
724 READ(37,rec=1) delY
725 #ifdef _BYTESWAPIO
726 call MDS_BYTESWAPR8( Ny, delY )
727 #endif
728 CLOSE(37)
729 ENDIF
730 _END_MASTER(myThid)
731 ENDIF
732 ENDIF
733 IF ( dySpacing .NE. UNSET_RL ) THEN
734 DO i=1,Ny
735 delY(i) = dySpacing
736 ENDDO
737 ENDIF
738 C
739 IF ( rSphere .NE. 0 ) THEN
740 recip_rSphere = 1.D0/rSphere
741 ELSE
742 recip_rSphere = 0.
743 ENDIF
744 C-- Initialize EOS coefficients (3rd order polynomial)
745 IF (eostype.eq.'POLY3') THEN
746 OPEN(37,FILE='POLY3.COEFFS',STATUS='OLD',FORM='FORMATTED')
747 READ(37,*) I
748 IF (I.NE.Nr) THEN
749 WRITE(msgBuf,'(A)')
750 & 'ini_parms: attempt to read POLY3.COEFFS failed'
751 CALL PRINT_ERROR( msgBuf , 1)
752 WRITE(msgBuf,'(A)')
753 & ' because bad # of levels in data'
754 CALL PRINT_ERROR( msgBuf , 1)
755 STOP 'Bad data in POLY3.COEFFS'
756 ENDIF
757 READ(37,*) (eosRefT(K),eosRefS(K),eosSig0(K),K=1,Nr)
758 DO K=1,Nr
759 READ(37,*) (eosC(I,K),I=1,9)
760 ENDDO
761 CLOSE(37)
762 ENDIF
763 C-- Check for conflicting grid definitions.
764 goptCount = 0
765 IF ( usingCartesianGrid ) goptCount = goptCount+1
766 IF ( usingSphericalPolarGrid ) goptCount = goptCount+1
767 IF ( usingCurvilinearGrid ) goptCount = goptCount+1
768 IF ( goptCount .GT. 1 ) THEN
769 WRITE(msgBuf,'(A)')
770 & 'S/R INI_PARMS: More than one coordinate system requested'
771 CALL PRINT_ERROR( msgBuf , myThid)
772 STOP 'ABNORMAL END: S/R INI_PARMS'
773 ENDIF
774 IF ( goptCount .LT. 1 ) THEN
775 WRITE(msgBuf,'(A)')
776 & 'S/R INI_PARMS: No coordinate system requested'
777 CALL PRINT_ERROR( msgBuf , myThid)
778 STOP 'ABNORMAL END: S/R INI_PARMS'
779 ENDIF
780 C-- Make metric term settings consistent with underlying grid.
781 IF ( usingCartesianGrid ) THEN
782 usingSphericalPolarMterms = .FALSE.
783 metricTerms = .FALSE.
784 mTFacMom = 0.
785 useBetaPlaneF = .TRUE.
786 ENDIF
787 IF ( usingSphericalPolarGrid ) THEN
788 useConstantF = .FALSE.
789 useBetaPlaneF = .FALSE.
790 useSphereF = .TRUE.
791 usingSphericalPolarMterms = metricTerms
792 ENDIF
793 IF ( usingCurvilinearGrid ) THEN
794 useSphereF = .TRUE.
795 ENDIF
796 C-- p, z, r coord parameters
797 DO K = 1, Nr
798 IF ( delZ(K) .NE. UNSET_RL ) zCoordInputData = .TRUE.
799 IF ( delP(K) .NE. UNSET_RL ) pCoordInputData = .TRUE.
800 IF ( delR(K) .NE. UNSET_RL ) rCoordInputData = .TRUE.
801 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delZ(K)
802 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delP(K)
803 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delRDefault(K)
804 IF ( delR(K) .EQ. 0. ) THEN
805 WRITE(msgBuf,'(A,I4)')
806 & 'S/R INI_PARMS: No value for delZ/delP/delR at K = ',K
807 CALL PRINT_ERROR( msgBuf , 1)
808 STOP 'ABNORMAL END: S/R INI_PARMS'
809 ENDIF
810 ENDDO
811 C Check for multiple coordinate systems
812 CoordsSet = 0
813 IF ( zCoordInputData ) coordsSet = coordsSet + 1
814 IF ( pCoordInputData ) coordsSet = coordsSet + 1
815 IF ( rCoordInputData ) coordsSet = coordsSet + 1
816 IF ( coordsSet .GT. 1 ) THEN
817 WRITE(msgBuf,'(A)')
818 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
819 CALL PRINT_ERROR( msgBuf , myThid)
820 STOP 'ABNORMAL END: S/R INI_PARMS'
821 ENDIF
822
823 C-- Input files
824 READ(UNIT=iUnit,NML=PARM05) !,IOSTAT=errIO)
825 IF ( errIO .LT. 0 ) THEN
826 WRITE(msgBuf,'(A)')
827 & 'Error reading numerical model '
828 CALL PRINT_ERROR( msgBuf , 1)
829 WRITE(msgBuf,'(A)')
830 & 'parameter file "data"'
831 CALL PRINT_ERROR( msgBuf , 1)
832 WRITE(msgBuf,'(A)')
833 & 'Problem in namelist PARM05'
834 CALL PRINT_ERROR( msgBuf , 1)
835 CALL MODELDATA_EXAMPLE( myThid )
836 STOP 'ABNORMAL END: S/R INI_PARMS'
837 ELSE
838 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM05 : OK'
839 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
840 & SQUEEZE_RIGHT , 1)
841 ENDIF
842
843 C
844 C-- Set factors required for mixing pressure and meters as vertical coordinate.
845 C rkFac is a "sign" parameter which is used where the orientation of the vertical
846 C coordinate (pressure or meters) relative to the vertical index (K) is important.
847 C rkFac = 1 applies when K and the coordinate are in the opposite sense.
848 C rkFac = -1 applies when K and the coordinate are in the same sense.
849 C horiVertRatio is a parameter that maps horizontal units to vertical units.
850 C It is used in certain special cases where lateral and vertical terms are
851 C being combined and a single frame of reference is needed.
852 IF ( zCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
853 rkFac = 1.D0
854 horiVertRatio = 1.D0
855 ENDIF
856 IF ( pCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
857 rkFac = -1.D0
858 horiVertRatio = Gravity * rhoConst
859 ENDIF
860 IF ( rCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
861 rkFac = 1.D0
862 horiVertRatio = 1.D0
863 ENDIF
864 IF (buoyancyRelation.EQ.'ATMOSPHERIC')
865 & horiVertRatio = Gravity * rhoConst
866 IF ( rkFac .EQ. UNSET_RS ) rkFac=rkFacDefault
867 recip_rkFac = 1.D0 / rkFac
868 recip_horiVertRatio = 1./horiVertRatio
869 IF ( zCoordInputData ) usingZCoords = .TRUE.
870 IF ( pCoordInputData ) usingPCoords = .TRUE.
871
872 C
873 CLOSE(iUnit)
874
875 C-- Check whether any retired parameters were found.
876 C-- Stop if they were
877 IF ( nRetired .GT. 0 ) THEN
878 WRITE(msgBuf,'(A)')
879 & 'Error reading '
880 CALL PRINT_ERROR( msgBuf , 1)
881 WRITE(msgBuf,'(A)')
882 & 'parameter file "data"'
883 CALL PRINT_ERROR( msgBuf , 1)
884 WRITE(msgBuf,'(A)')
885 & 'some out of date parameters were found in the namelist'
886 CALL PRINT_ERROR( msgBuf , 1)
887 STOP 'ABNORMAL END: S/R INI_PARMS'
888 ENDIF
889
890 _END_MASTER(myThid)
891
892 C-- Everyone else must wait for the parameters to be loaded
893 _BARRIER
894 C
895 RETURN
896 END
897

  ViewVC Help
Powered by ViewVC 1.1.22