/[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.70 - (show annotations) (download)
Wed Sep 26 18:09:15 2001 UTC (22 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint42, checkpoint41
Changes since 1.69: +22 -13 lines
Bringing comments up to data and formatting for document extraction.

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

  ViewVC Help
Powered by ViewVC 1.1.22