/[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.79 - (show annotations) (download)
Sat Jun 15 03:28:39 2002 UTC (21 years, 11 months ago) by jmc
Branch: MAIN
Changes since 1.78: +8 -3 lines
Add new flags:
* T,S forcing outside Adams-Bashforh
* temp,salt Advection and Forcing (turn on/off)
* for each tracer: internal flag for multiDimAdvection & A-B

1 C $Header: /u/gcmpack/MITgcm/model/src/ini_parms.F,v 1.78 2002/03/07 14:09:02 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 & forcing_In_AB, 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, delRc,
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-- Advection and Forcing for Temp and salt on/off flags
327 tempAdvection = tempStepping .AND. tempAdvection
328 tempForcing = tempStepping .AND. tempForcing
329 saltAdvection = saltStepping .AND. saltAdvection
330 saltForcing = saltStepping .AND. saltForcing
331 C-- z,p,r coord input switching.
332 IF ( viscAz .NE. UNSET_RL ) zCoordInputData = .TRUE.
333 IF ( viscAp .NE. UNSET_RL ) pCoordInputData = .TRUE.
334 IF ( viscAr .NE. UNSET_RL ) rCoordInputData = .TRUE.
335 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAz
336 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAp
337 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscArDefault
338
339 IF ( diffKzT .NE. UNSET_RL ) zCoordInputData = .TRUE.
340 IF ( diffKpT .NE. UNSET_RL ) pCoordInputData = .TRUE.
341 IF ( diffKrT .NE. UNSET_RL ) rCoordInputData = .TRUE.
342 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKzT
343 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKpT
344 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKrTDefault
345
346 IF ( diffKzS .NE. UNSET_RL ) zCoordInputData = .TRUE.
347 IF ( diffKpS .NE. UNSET_RL ) pCoordInputData = .TRUE.
348 IF ( diffKrS .NE. UNSET_RL ) rCoordInputData = .TRUE.
349 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKzS
350 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKpS
351 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKrSDefault
352
353 IF ( hFacMinDz .NE. UNSET_RL ) zCoordInputData = .TRUE.
354 IF ( hFacMinDp .NE. UNSET_RL ) pCoordInputData = .TRUE.
355 IF ( hFacMinDr .NE. UNSET_RL ) rCoordInputData = .TRUE.
356 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDz
357 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDp
358 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDrDefault
359
360 IF (convertFW2Salt.EQ.UNSET_RL) THEN
361 convertFW2Salt = 35.
362 IF (useRealFreshWaterFlux) convertFW2Salt=-1
363 ENDIF
364
365 IF ( ivdc_kappa .NE. 0. .AND. .NOT. implicitDiffusion ) THEN
366 WRITE(msgBuf,'(A,A)')
367 & 'S/R INI_PARMS: To use ivdc_kappa you must enable implicit',
368 & ' vertical diffusion.'
369 CALL PRINT_ERROR( msgBuf , myThid)
370 STOP 'ABNORMAL END: S/R INI_PARMS'
371 ENDIF
372
373 coordsSet = 0
374 IF ( zCoordInputData ) coordsSet = coordsSet + 1
375 IF ( pCoordInputData ) coordsSet = coordsSet + 1
376 IF ( rCoordInputData ) coordsSet = coordsSet + 1
377 IF ( coordsSet .GT. 1 ) THEN
378 WRITE(msgBuf,'(A)')
379 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
380 CALL PRINT_ERROR( msgBuf , myThid)
381 STOP 'ABNORMAL END: S/R INI_PARMS'
382 ENDIF
383 IF ( rhoConst .LE. 0. ) THEN
384 WRITE(msgBuf,'(A)')
385 & 'S/R INI_PARMS: rhoConst must be greater than 0.'
386 CALL PRINT_ERROR( msgBuf , myThid)
387 STOP 'ABNORMAL END: S/R INI_PARMS'
388 ELSE
389 recip_rhoConst = 1.D0 / rhoConst
390 ENDIF
391 IF ( rhoNil .LE. 0. ) THEN
392 WRITE(msgBuf,'(A)')
393 & 'S/R INI_PARMS: rhoNil must be greater than 0.'
394 CALL PRINT_ERROR( msgBuf , myThid)
395 STOP 'ABNORMAL END: S/R INI_PARMS'
396 ELSE
397 recip_rhoNil = 1.D0 / rhoNil
398 ENDIF
399 IF ( HeatCapacity_Cp .LE. 0. ) THEN
400 WRITE(msgBuf,'(A)')
401 & 'S/R INI_PARMS: HeatCapacity_Cp must be greater than 0.'
402 CALL PRINT_ERROR( msgBuf , myThid)
403 STOP 'ABNORMAL END: S/R INI_PARMS'
404 ELSE
405 recip_Cp = 1.D0 / HeatCapacity_Cp
406 ENDIF
407 IF ( gravity .LE. 0. ) THEN
408 WRITE(msgBuf,'(A)')
409 & 'S/R INI_PARMS: gravity must be greater than 0.'
410 CALL PRINT_ERROR( msgBuf , myThid)
411 STOP 'ABNORMAL END: S/R INI_PARMS'
412 ELSE
413 recip_gravity = 1.D0 / gravity
414 ENDIF
415 C Set globalFiles flag for READ_WRITE_FLD package
416 CALL SET_WRITE_GLOBAL_FLD( globalFiles )
417 C Set globalFiles flag for READ_WRITE_REC package
418 CALL SET_WRITE_GLOBAL_REC( globalFiles )
419 C Set globalFiles flag for READ_WRITE_REC package
420 CALL SET_WRITE_GLOBAL_PICKUP( globalFiles )
421
422 C Check for retired parameters still being used
423 nRetired = 0
424 IF ( zonal_filt_lat .NE. UNSET_RL ) THEN
425 nRetired = nRetired+1
426 WRITE(msgBuf,'(A,A)')
427 & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is',
428 & ' no longer allowed in file "data".'
429 CALL PRINT_ERROR( msgBuf , myThid)
430 WRITE(msgBuf,'(A,A)')
431 & 'S/R INI_PARMS: Paramater "zonal_filt_lat" is',
432 & ' now read from file "data.zonfilt".'
433 CALL PRINT_ERROR( msgBuf , myThid)
434 ENDIF
435
436 C-- Elliptic solver parameters
437 READ(UNIT=iUnit,NML=PARM02) !,IOSTAT=errIO)
438 IF ( errIO .LT. 0 ) THEN
439 WRITE(msgBuf,'(A)')
440 & 'S/R INI_PARMS'
441 CALL PRINT_ERROR( msgBuf , 1)
442 WRITE(msgBuf,'(A)')
443 & 'Error reading numerical model '
444 CALL PRINT_ERROR( msgBuf , 1)
445 WRITE(msgBuf,'(A)')
446 & 'parameter file "data".'
447 CALL PRINT_ERROR( msgBuf , 1)
448 WRITE(msgBuf,'(A)')
449 & 'Problem in namelist PARM02'
450 CALL PRINT_ERROR( msgBuf , 1)
451 CALL MODELDATA_EXAMPLE( myThid )
452 STOP 'ABNORMAL END: S/R INI_PARMS'
453 ELSE
454 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM02 : OK'
455 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
456 & SQUEEZE_RIGHT , 1)
457 ENDIF
458
459 C-- Time stepping parameters
460 rCD = -1.D0
461 READ(UNIT=iUnit,NML=PARM03) !,IOSTAT=errIO)
462 IF ( errIO .LT. 0 ) THEN
463 WRITE(msgBuf,'(A)')
464 & 'S/R INI_PARMS'
465 CALL PRINT_ERROR( msgBuf , 1)
466 WRITE(msgBuf,'(A)')
467 & 'Error reading numerical model '
468 CALL PRINT_ERROR( msgBuf , 1)
469 WRITE(msgBuf,'(A)')
470 & 'parameter file "data"'
471 CALL PRINT_ERROR( msgBuf , 1)
472 WRITE(msgBuf,'(A)')
473 & 'Problem in namelist PARM03'
474 CALL PRINT_ERROR( msgBuf , 1)
475 CALL MODELDATA_EXAMPLE( myThid )
476 STOP 'ABNORMAL END: S/R INI_PARMS'
477 ELSE
478 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM03 : OK'
479 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
480 & SQUEEZE_RIGHT , 1)
481 ENDIF
482 C Process "timestepping" params
483 C o Time step size
484 IF ( deltaT .EQ. 0. ) deltaT = deltaTmom
485 IF ( deltaT .EQ. 0. ) deltaT = deltaTtracer
486 IF ( deltaTmom .EQ. 0. ) deltaTmom = deltaT
487 IF ( deltaTtracer .EQ. 0. ) deltaTtracer = deltaT
488 IF ( deltaTClock .EQ. 0. ) deltaTClock = deltaT
489 IF ( periodicExternalForcing ) THEN
490 IF ( externForcingCycle*externForcingPeriod .EQ. 0. ) THEN
491 WRITE(msgBuf,'(A)')
492 & 'S/R INI_PARMS: externForcingCycle,externForcingPeriod =0'
493 CALL PRINT_ERROR( msgBuf , 1)
494 STOP 'ABNORMAL END: S/R INI_PARMS'
495 ENDIF
496 IF ( INT(externForcingCycle/externForcingPeriod) .NE.
497 & externForcingCycle/externForcingPeriod ) THEN
498 WRITE(msgBuf,'(A)')
499 & 'S/R INI_PARMS: externForcingCycle <> N*externForcingPeriod'
500 CALL PRINT_ERROR( msgBuf , 1)
501 STOP 'ABNORMAL END: S/R INI_PARMS'
502 ENDIF
503 IF ( externForcingCycle.le.externForcingPeriod ) THEN
504 WRITE(msgBuf,'(A)')
505 & 'S/R INI_PARMS: externForcingCycle < externForcingPeriod'
506 CALL PRINT_ERROR( msgBuf , 1)
507 STOP 'ABNORMAL END: S/R INI_PARMS'
508 ENDIF
509 IF ( externForcingPeriod.lt.deltaTclock ) THEN
510 WRITE(msgBuf,'(A)')
511 & 'S/R INI_PARMS: externForcingPeriod < deltaTclock'
512 CALL PRINT_ERROR( msgBuf , 1)
513 STOP 'ABNORMAL END: S/R INI_PARMS'
514 ENDIF
515 ENDIF
516 C o Convection frequency
517 IF ( cAdjFreq .LT. 0. ) THEN
518 cAdjFreq = deltaTClock
519 ENDIF
520 IF ( ivdc_kappa .NE. 0. .AND. cAdjFreq .NE. 0. ) THEN
521 WRITE(msgBuf,'(A,A)')
522 & 'S/R INI_PARMS: You have enabled both ivdc_kappa and',
523 & ' convective adjustment.'
524 CALL PRINT_ERROR( msgBuf , myThid)
525 STOP 'ABNORMAL END: S/R INI_PARMS'
526 ENDIF
527 C o CD coupling
528 IF ( tauCD .EQ. 0.D0 ) THEN
529 tauCD = deltaTmom
530 ENDIF
531 IF ( rCD .LT. 0. ) THEN
532 rCD = 1. - deltaTMom/tauCD
533 ENDIF
534 C o Temperature climatology relaxation time scale
535 IF ( tauThetaClimRelax .EQ. 0.D0 ) THEN
536 doThetaClimRelax = .FALSE.
537 lambdaThetaClimRelax = 0.D0
538 ELSE
539 doThetaClimRelax = .TRUE.
540 lambdaThetaClimRelax = 1./tauThetaClimRelax
541 ENDIF
542 C o Salinity climatology relaxation time scale
543 IF ( tauSaltClimRelax .EQ. 0.D0 ) THEN
544 doSaltClimRelax = .FALSE.
545 lambdaSaltClimRelax = 0.D0
546 ELSE
547 doSaltClimRelax = .TRUE.
548 lambdaSaltClimRelax = 1./tauSaltClimRelax
549 ENDIF
550 C o Tracer 1 climatology relaxation time scale
551 IF ( tauTr1ClimRelax .EQ. 0.D0 ) THEN
552 doTr1ClimRelax = .FALSE.
553 lambdaTr1ClimRelax = 0.D0
554 ELSE
555 doTr1ClimRelax = .TRUE.
556 lambdaTr1ClimRelax = 1./tauTr1ClimRelax
557 ENDIF
558
559 C o Start time
560 IF ( nIter0 .NE. 0 .AND. startTime .EQ. 0. )
561 & startTime = deltaTClock*float(nIter0)
562 C o nIter0
563 IF ( nIter0 .EQ. 0 .AND. startTime .NE. 0. )
564 & nIter0 = INT( startTime/deltaTClock )
565
566 C o nTimeSteps 1
567 IF ( nTimeSteps .EQ. 0 .AND. nEndIter .NE. 0 )
568 & nTimeSteps = nEndIter-nIter0
569 C o nTimeSteps 2
570 IF ( nTimeSteps .EQ. 0 .AND. endTime .NE. 0. )
571 & nTimeSteps = int(0.5+(endTime-startTime)/deltaTclock)
572 C o nEndIter 1
573 IF ( nEndIter .EQ. 0 .AND. nTimeSteps .NE. 0 )
574 & nEndIter = nIter0+nTimeSteps
575 C o nEndIter 2
576 IF ( nEndIter .EQ. 0 .AND. endTime .NE. 0. )
577 & nEndIter = int(0.5+endTime/deltaTclock)
578 C o End Time 1
579 IF ( endTime .EQ. 0. .AND. nTimeSteps .NE. 0 )
580 & endTime = startTime + deltaTClock*float(nTimeSteps)
581 C o End Time 2
582 IF ( endTime .EQ. 0. .AND. nEndIter .NE. 0 )
583 & endTime = deltaTClock*float(nEndIter)
584
585 C o Consistent?
586 IF ( nEndIter .NE. nIter0+nTimeSteps ) THEN
587 WRITE(msgBuf,'(A)')
588 & 'S/R INI_PARMS: nIter0, nTimeSteps and nEndIter are inconsistent'
589 CALL PRINT_ERROR( msgBuf , 1)
590 WRITE(msgBuf,'(A)')
591 & 'S/R INI_PARMS: Perhaps more than two were set at once'
592 CALL PRINT_ERROR( msgBuf , 1)
593 STOP 'ABNORMAL END: S/R INI_PARMS'
594 ENDIF
595 IF ( nTimeSteps .NE. int(0.5+(endTime-startTime)/deltaTClock) )
596 & THEN
597 WRITE(msgBuf,'(A)')
598 & 'S/R INI_PARMS: both endTime and nTimeSteps have been set'
599 CALL PRINT_ERROR( msgBuf , 1)
600 WRITE(msgBuf,'(A)')
601 & 'S/R INI_PARMS: but are inconsistent'
602 CALL PRINT_ERROR( msgBuf , 1)
603 STOP 'ABNORMAL END: S/R INI_PARMS'
604 ENDIF
605
606 C o Monitor (should also add CPP flag for monitor?)
607 IF (monitorFreq.LT.0.) THEN
608 monitorFreq=0.
609 IF (dumpFreq.NE.0.) monitorFreq=dumpFreq
610 IF (diagFreq.NE.0..AND.diagFreq.LT.monitorFreq)
611 & monitorFreq=diagFreq
612 IF (taveFreq.NE.0..AND.taveFreq.LT.monitorFreq)
613 & monitorFreq=taveFreq
614 IF (chkPtFreq.NE.0..AND.chkPtFreq.LT.monitorFreq)
615 & monitorFreq=chkPtFreq
616 IF (pChkPtFreq.NE.0..AND.pChkPtFreq.LT.monitorFreq)
617 & monitorFreq=pChkPtFreq
618 IF (monitorFreq.EQ.0.) monitorFreq=deltaTclock
619 ENDIF
620
621 C o If taveFreq is finite, then we must make sure the diagnostics
622 C code is being compiled
623 #ifndef ALLOW_TIMEAVE
624 IF (taveFreq.NE.0.) THEN
625 WRITE(msgBuf,'(A)')
626 & 'S/R INI_PARMS: taveFreq <> 0 but you have'
627 CALL PRINT_ERROR( msgBuf , 1)
628 WRITE(msgBuf,'(A)')
629 & 'not compiled the model with the diagnostics routines.'
630 CALL PRINT_ERROR( msgBuf , 1)
631 WRITE(msgBuf,'(A,A)')
632 & 'Re-compile with: #define ALLOW_TIMEAVE',
633 & ' or -DALLOW_TIMEAVE'
634 CALL PRINT_ERROR( msgBuf , 1)
635 STOP 'ABNORMAL END: S/R INI_PARMS'
636 ENDIF
637 #endif
638
639 C-- Grid parameters
640 C In cartesian coords distances are in metres
641 rkFac = UNSET_RS
642 DO K =1,Nr
643 delZ(K) = UNSET_RL
644 delP(K) = UNSET_RL
645 delR(K) = UNSET_RL
646 ENDDO
647 C In spherical polar distances are in degrees
648 recip_rSphere = 1.D0/rSphere
649 dxSpacing = UNSET_RL
650 dySpacing = UNSET_RL
651 delXfile = ' '
652 delYfile = ' '
653 READ(UNIT=iUnit,NML=PARM04) !,IOSTAT=errIO)
654 IF ( errIO .LT. 0 ) THEN
655 WRITE(msgBuf,'(A)')
656 & 'S/R INI_PARMS'
657 CALL PRINT_ERROR( msgBuf , 1)
658 WRITE(msgBuf,'(A)')
659 & 'Error reading numerical model '
660 CALL PRINT_ERROR( msgBuf , 1)
661 WRITE(msgBuf,'(A)')
662 & 'parameter file "data"'
663 CALL PRINT_ERROR( msgBuf , 1)
664 WRITE(msgBuf,'(A)')
665 & 'Problem in namelist PARM04'
666 CALL PRINT_ERROR( msgBuf , 1)
667 CALL MODELDATA_EXAMPLE( myThid )
668 STOP 'ABNORMAL END: S/R INI_PARMS'
669 ELSE
670 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM04 : OK'
671 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
672 & SQUEEZE_RIGHT , 1)
673 ENDIF
674
675 C X coordinate
676 IF ( delXfile .NE. ' ' ) THEN
677 IF ( delX(1) .NE. UNSET_RL .OR. dxSpacing .NE. UNSET_RL ) THEN
678 WRITE(msgBuf,'(A,A)') 'Too many specifications for delX:',
679 & 'Specify only one of delX, dxSpacing or delXfile'
680 CALL PRINT_ERROR( msgBuf , 1)
681 STOP 'ABNORMAL END: S/R INI_PARMS'
682 ELSE
683 _BEGIN_MASTER( myThid )
684 IF (readBinaryPrec.EQ.precFloat32) THEN
685 OPEN(37,FILE=delXfile,STATUS='OLD',FORM='UNFORMATTED',
686 & ACCESS='DIRECT',RECL=WORDLENGTH*Nx)
687 READ(37,rec=1) delX
688 #ifdef _BYTESWAPIO
689 call MDS_BYTESWAPR4( Nx, delX )
690 #endif
691 CLOSE(37)
692 ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
693 OPEN(37,FILE=delXfile,STATUS='OLD',FORM='UNFORMATTED',
694 & ACCESS='DIRECT',RECL=WORDLENGTH*2*Nx)
695 READ(37,rec=1) delX
696 #ifdef _BYTESWAPIO
697 call MDS_BYTESWAPR8( Nx, delX )
698 #endif
699 CLOSE(37)
700 ENDIF
701 _END_MASTER(myThid)
702 ENDIF
703 ENDIF
704 IF ( dxSpacing .NE. UNSET_RL ) THEN
705 DO i=1,Nx
706 delX(i) = dxSpacing
707 ENDDO
708 ENDIF
709 C Y coordinate
710 IF ( delYfile .NE. ' ' ) THEN
711 IF ( delY(1) .NE. UNSET_RL .OR. dySpacing .NE. UNSET_RL ) THEN
712 WRITE(msgBuf,'(A,A)') 'Too many specifications for delY:',
713 & 'Specify only one of delY, dySpacing or delYfile'
714 CALL PRINT_ERROR( msgBuf , 1)
715 STOP 'ABNORMAL END: S/R INI_PARMS'
716 ELSE
717 _BEGIN_MASTER( myThid )
718 IF (readBinaryPrec.EQ.precFloat32) THEN
719 OPEN(37,FILE=delYfile,STATUS='OLD',FORM='UNFORMATTED',
720 & ACCESS='DIRECT',RECL=WORDLENGTH*Ny)
721 READ(37,rec=1) delY
722 #ifdef _BYTESWAPIO
723 call MDS_BYTESWAPR4( Ny, delY )
724 #endif
725 CLOSE(37)
726 ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
727 OPEN(37,FILE=delYfile,STATUS='OLD',FORM='UNFORMATTED',
728 & ACCESS='DIRECT',RECL=WORDLENGTH*2*Ny)
729 READ(37,rec=1) delY
730 #ifdef _BYTESWAPIO
731 call MDS_BYTESWAPR8( Ny, delY )
732 #endif
733 CLOSE(37)
734 ENDIF
735 _END_MASTER(myThid)
736 ENDIF
737 ENDIF
738 IF ( dySpacing .NE. UNSET_RL ) THEN
739 DO i=1,Ny
740 delY(i) = dySpacing
741 ENDDO
742 ENDIF
743 C
744 IF ( rSphere .NE. 0 ) THEN
745 recip_rSphere = 1.D0/rSphere
746 ELSE
747 recip_rSphere = 0.
748 ENDIF
749 C-- Initialize EOS coefficients (3rd order polynomial)
750 IF (eostype.eq.'POLY3') THEN
751 OPEN(37,FILE='POLY3.COEFFS',STATUS='OLD',FORM='FORMATTED')
752 READ(37,*) I
753 IF (I.NE.Nr) THEN
754 WRITE(msgBuf,'(A)')
755 & 'ini_parms: attempt to read POLY3.COEFFS failed'
756 CALL PRINT_ERROR( msgBuf , 1)
757 WRITE(msgBuf,'(A)')
758 & ' because bad # of levels in data'
759 CALL PRINT_ERROR( msgBuf , 1)
760 STOP 'Bad data in POLY3.COEFFS'
761 ENDIF
762 READ(37,*) (eosRefT(K),eosRefS(K),eosSig0(K),K=1,Nr)
763 DO K=1,Nr
764 READ(37,*) (eosC(I,K),I=1,9)
765 ENDDO
766 CLOSE(37)
767 ENDIF
768 C-- Check for conflicting grid definitions.
769 goptCount = 0
770 IF ( usingCartesianGrid ) goptCount = goptCount+1
771 IF ( usingSphericalPolarGrid ) goptCount = goptCount+1
772 IF ( usingCurvilinearGrid ) goptCount = goptCount+1
773 IF ( goptCount .GT. 1 ) THEN
774 WRITE(msgBuf,'(A)')
775 & 'S/R INI_PARMS: More than one coordinate system requested'
776 CALL PRINT_ERROR( msgBuf , myThid)
777 STOP 'ABNORMAL END: S/R INI_PARMS'
778 ENDIF
779 IF ( goptCount .LT. 1 ) THEN
780 WRITE(msgBuf,'(A)')
781 & 'S/R INI_PARMS: No coordinate system requested'
782 CALL PRINT_ERROR( msgBuf , myThid)
783 STOP 'ABNORMAL END: S/R INI_PARMS'
784 ENDIF
785 C-- Make metric term settings consistent with underlying grid.
786 IF ( usingCartesianGrid ) THEN
787 usingSphericalPolarMterms = .FALSE.
788 metricTerms = .FALSE.
789 mTFacMom = 0.
790 useBetaPlaneF = .TRUE.
791 ENDIF
792 IF ( usingSphericalPolarGrid ) THEN
793 useConstantF = .FALSE.
794 useBetaPlaneF = .FALSE.
795 useSphereF = .TRUE.
796 usingSphericalPolarMterms = metricTerms
797 ENDIF
798 IF ( usingCurvilinearGrid ) THEN
799 useSphereF = .TRUE.
800 ENDIF
801 C-- set cell Center depth and put Interface at the middle between 2 C
802 setCenterDr = .FALSE.
803 IF (delRc(1).NE.UNSET_RL) setCenterDr=.TRUE.
804 DO K=1,Nr+1
805 IF (delRc(K).EQ.UNSET_RL) setCenterDr = .FALSE.
806 ENDDO
807 C-- p, z, r coord parameters
808 DO K = 1, Nr
809 IF ( delZ(K) .NE. UNSET_RL ) zCoordInputData = .TRUE.
810 IF ( delP(K) .NE. UNSET_RL ) pCoordInputData = .TRUE.
811 IF ( delR(K) .NE. UNSET_RL ) rCoordInputData = .TRUE.
812 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delZ(K)
813 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delP(K)
814 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delRDefault(K)
815 IF (.NOT.setCenterDr .AND. delR(K).EQ.delRDefault(K) ) THEN
816 WRITE(msgBuf,'(A,I4)')
817 & 'S/R INI_PARMS: No value for delZ/delP/delR at K = ',K
818 CALL PRINT_ERROR( msgBuf , 1)
819 STOP 'ABNORMAL END: S/R INI_PARMS'
820 ELSEIF ( setCenterDr .AND. delR(K).NE.delRDefault(K) ) THEN
821 WRITE(msgBuf,'(2A,I4)') 'S/R INI_PARMS:',
822 & ' Cannot specify both delRc and delZ/delP/delR at K=', K
823 CALL PRINT_ERROR( msgBuf , 1)
824 STOP 'ABNORMAL END: S/R INI_PARMS'
825 ENDIF
826 ENDDO
827 C Check for multiple coordinate systems
828 CoordsSet = 0
829 IF ( zCoordInputData ) coordsSet = coordsSet + 1
830 IF ( pCoordInputData ) coordsSet = coordsSet + 1
831 IF ( rCoordInputData ) coordsSet = coordsSet + 1
832 IF ( coordsSet .GT. 1 ) THEN
833 WRITE(msgBuf,'(A)')
834 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
835 CALL PRINT_ERROR( msgBuf , myThid)
836 STOP 'ABNORMAL END: S/R INI_PARMS'
837 ENDIF
838
839 C-- Input files
840 READ(UNIT=iUnit,NML=PARM05) !,IOSTAT=errIO)
841 IF ( errIO .LT. 0 ) THEN
842 WRITE(msgBuf,'(A)')
843 & 'Error reading numerical model '
844 CALL PRINT_ERROR( msgBuf , 1)
845 WRITE(msgBuf,'(A)')
846 & 'parameter file "data"'
847 CALL PRINT_ERROR( msgBuf , 1)
848 WRITE(msgBuf,'(A)')
849 & 'Problem in namelist PARM05'
850 CALL PRINT_ERROR( msgBuf , 1)
851 CALL MODELDATA_EXAMPLE( myThid )
852 STOP 'ABNORMAL END: S/R INI_PARMS'
853 ELSE
854 WRITE(msgBuf,'(A)') 'S/R INI_PARMS ; read PARM05 : OK'
855 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
856 & SQUEEZE_RIGHT , 1)
857 ENDIF
858
859 C
860 C-- Set factors required for mixing pressure and meters as vertical coordinate.
861 C rkFac is a "sign" parameter which is used where the orientation of the vertical
862 C coordinate (pressure or meters) relative to the vertical index (K) is important.
863 C rkFac = 1 applies when K and the coordinate are in the opposite sense.
864 C rkFac = -1 applies when K and the coordinate are in the same sense.
865 C horiVertRatio is a parameter that maps horizontal units to vertical units.
866 C It is used in certain special cases where lateral and vertical terms are
867 C being combined and a single frame of reference is needed.
868 IF ( zCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
869 rkFac = 1.D0
870 horiVertRatio = 1.D0
871 ENDIF
872 IF ( pCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
873 rkFac = -1.D0
874 horiVertRatio = Gravity * rhoConst
875 ENDIF
876 IF ( rCoordInputData .AND. rkFac .EQ. UNSET_RS ) THEN
877 rkFac = 1.D0
878 horiVertRatio = 1.D0
879 ENDIF
880 IF (buoyancyRelation.EQ.'ATMOSPHERIC')
881 & horiVertRatio = Gravity * rhoConst
882 IF ( rkFac .EQ. UNSET_RS ) rkFac=rkFacDefault
883 recip_rkFac = 1.D0 / rkFac
884 recip_horiVertRatio = 1./horiVertRatio
885 IF ( zCoordInputData ) usingZCoords = .TRUE.
886 IF ( pCoordInputData ) usingPCoords = .TRUE.
887
888 C
889 CLOSE(iUnit)
890
891 C-- Check whether any retired parameters were found.
892 C-- Stop if they were
893 IF ( nRetired .GT. 0 ) THEN
894 WRITE(msgBuf,'(A)')
895 & 'Error reading '
896 CALL PRINT_ERROR( msgBuf , 1)
897 WRITE(msgBuf,'(A)')
898 & 'parameter file "data"'
899 CALL PRINT_ERROR( msgBuf , 1)
900 WRITE(msgBuf,'(A)')
901 & 'some out of date parameters were found in the namelist'
902 CALL PRINT_ERROR( msgBuf , 1)
903 STOP 'ABNORMAL END: S/R INI_PARMS'
904 ENDIF
905
906 _END_MASTER(myThid)
907
908 C-- Everyone else must wait for the parameters to be loaded
909 _BARRIER
910 C
911 RETURN
912 END
913

  ViewVC Help
Powered by ViewVC 1.1.22