/[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.69 - (show annotations) (download)
Mon Sep 10 01:22:48 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint40pre9, checkpoint40
Changes since 1.68: +3 -2 lines
Added multi-dimensional form of advection
 o available only for single step schemes (ie. can't be used with ABII)
 o stable for max(cfl_u,cfl_v,cfl_w)<=1  (without cfl_u+cfl_v+cfl_w <=1)
 o selected using multiDimAdvection=.T.  (default)
 o had to hack some existing routines to work on local arrays

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

  ViewVC Help
Powered by ViewVC 1.1.22