/[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.29 - (show annotations) (download)
Sun Sep 6 14:45:11 1998 UTC (25 years, 8 months ago) by cnh
Branch: MAIN
Changes since 1.28: +6 -1 lines
Consistent isomorphism changes

1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/ini_parms.F,v 1.28 1998/09/05 17:52:13 cnh Exp $
2
3 #include "CPP_OPTIONS.h"
4
5 SUBROUTINE INI_PARMS( myThid )
6 C /==========================================================\
7 C | SUBROUTINE INI_PARMS |
8 C | o Routine to set model "parameters" |
9 C |==========================================================|
10 C | Notes: |
11 C | ====== |
12 C | The present version of this routine is a place-holder. |
13 C | A production version needs to handle parameters from an |
14 C | external file and possibly reading in some initial field |
15 C | values. |
16 C \==========================================================/
17
18 C === Global variables ===
19 #include "SIZE.h"
20 #include "EEPARAMS.h"
21 #include "PARAMS.h"
22 #include "GRID.h"
23 #include "CG2D.h"
24
25 C === Routine arguments ===
26 C myThid - Number of this instance of INI_PARMS
27 INTEGER myThid
28
29 C === Local variables ===
30 C dxSpacing, dySpacing - Default spacing in X and Y.
31 C Units are that of coordinate system
32 C i.e. cartesian => metres
33 C s. polar => degrees
34 C goptCount - Used to count the nuber of grid options
35 C (only one is allowed! )
36 C msgBuf - Informational/error meesage buffer
37 C errIO - IO error flag
38 C iUnit - Work variable for IO unit number
39 C record - Work variable for IO buffer
40 C K, I, J - Loop counters
41 C xxxDefault - Default value for variable xxx
42 _RL dxSpacing
43 _RL dySpacing
44 CHARACTER*(MAX_LEN_MBUF) msgBuf
45 CHARACTER*(MAX_LEN_PREC) record
46 INTEGER goptCount
47 INTEGER K, I, J, IL, iUnit
48 INTEGER errIO
49 INTEGER IFNBLNK
50 EXTERNAL IFNBLNK
51 INTEGER ILNBLNK
52 EXTERNAL ILNBLNK
53 C Default values for variables which have vertical coordinate system
54 C dependency.
55 _RL viscArDefault
56 _RL diffKrTDefault
57 _RL diffKrSDefault
58 _RL hFacMinDrDefault
59 _RL delRDefault
60 C zCoordInputData - These are used to select between different coordinate systems.
61 C pCoordInputData The vertical coordinate system in the rest of the model is
62 C rCoordInputData written in terms of r. In the model "data" file input data can
63 C coordsSet be interms of z, p or r.
64 C e.g. delZ or delP or delR for the vertical grid spacing.
65 C The following rules apply:
66 C All parameters must use the same vertical coordinate system.
67 C e.g. delZ and viscAz is legal but
68 C delZ and viscAr is an error.
69 C Similarly specifyinh delZ and delP is an error.
70 C zCoord..., pCoord..., rCoord... are used to flag when z, p or r are
71 C used. coordsSet counts how many vertical coordinate systems have been
72 C used to specify variables. coordsSet > 1 is an error.
73 C
74 LOGICAL zCoordInputData
75 LOGICAL pCoordInputData
76 LOGICAL rCoordInputData
77 INTEGER coordsSet
78
79 C-- Continuous equation parameters
80 NAMELIST /PARM01/
81 & gravity, gBaro, rhonil, tAlpha, sBeta, f0, beta,
82 & viscAh, viscAz, viscA4,
83 & diffKhT, diffKzT, diffK4T,
84 & diffKhS, diffKzS, diffK4S,
85 & GMmaxslope,GMlength,GMalpha,GMdepth,GMkbackground,GMmaxval,
86 & tRef, sRef, eosType,
87 & momViscosity, momAdvection, momForcing, useCoriolis,
88 & momPressureForcing, metricTerms,
89 & tempDiffusion, tempAdvection, tempForcing,
90 & saltDiffusion, saltAdvection, saltForcing,
91 & implicitFreeSurface, rigidLid, freeSurfFac, hFacMin, hFacMinDz,
92 & tempStepping, saltStepping, momStepping, implicitDiffusion,
93 & viscAr, diffKrT, diffKrS, hFacMinDr,
94 & viscAp, diffKpT, diffKpS, hFacMinDp,
95 & rhoConst, buoyancyRelation
96
97 C-- Elliptic solver parameters
98 NAMELIST /PARM02/
99 & cg2dMaxIters, cg2dChkResFreq, cg2dTargetResidual, cg2dpcOffDFac
100
101 C-- Time stepping parammeters
102 NAMELIST /PARM03/
103 & nIter0, nTimeSteps, deltaT, deltaTmom, deltaTtracer, abEps, tauCD, rCD,
104 & startTime, endTime, chkPtFreq, dumpFreq, taveFreq, deltaTClock,
105 & pChkPtFreq, cAdjFreq, tauThetaClimRelax, tauSaltClimRelax,
106 & periodicExternalForcing, externForcingPeriod, externForcingCycle
107
108 C-- Gridding parameters
109 NAMELIST /PARM04/
110 & usingCartesianGrid, delZ, dxSpacing, dySpacing, delX, delY,
111 & usingSphericalPolarGrid, phiMin, thetaMin, rSphere,
112 & l, m, n, delP, delR, rkFac
113
114 C-- Input files
115 NAMELIST /PARM05/
116 & bathyFile, hydrogThetaFile, hydrogSaltFile,
117 & zonalWindFile, meridWindFile, thetaClimFile,
118 & saltClimFile
119
120
121 C
122 _BEGIN_MASTER(myThid)
123
124 C-- Initialise "which vertical coordinate system used" flags.
125 zCoordInputData = .FALSE.
126 pCoordInputData = .FALSE.
127 rCoordInputData = .FALSE.
128 usingPCoords = .FALSE.
129 usingZCoords = .FALSE.
130 coordsSet = 0
131
132 C-- Open the parameter file
133 OPEN(UNIT=scrUnit1,STATUS='SCRATCH')
134 OPEN(UNIT=scrUnit2,STATUS='SCRATCH')
135 OPEN(UNIT=modelDataUnit,FILE='data',STATUS='OLD',err=1,IOSTAT=errIO)
136 IF ( errIO .GE. 0 ) GOTO 2
137 1 CONTINUE
138 WRITE(msgBuf,'(A)')
139 & 'S/R INI_PARMS'
140 CALL PRINT_ERROR( msgBuf , 1)
141 WRITE(msgBuf,'(A)')
142 & 'Unable to open model parameter'
143 CALL PRINT_ERROR( msgBuf , 1)
144 WRITE(msgBuf,'(A)')
145 & 'file "data"'
146 CALL PRINT_ERROR( msgBuf , 1)
147 CALL MODELDATA_EXAMPLE( myThid )
148 STOP 'ABNORMAL END: S/R INI_PARMS'
149 2 CONTINUE
150
151 1000 CONTINUE
152 READ(modelDataUnit,FMT='(A)',END=1001) RECORD
153 IL = MAX(ILNBLNK(RECORD),1)
154 IF ( RECORD(1:1) .NE. commentCharacter )
155 & WRITE(UNIT=scrUnit1,FMT='(A)') RECORD(:IL)
156 WRITE(UNIT=scrUnit2,FMT='(A)') RECORD(:IL)
157 GOTO 1000
158 1001 CONTINUE
159 CLOSE(modelDataUnit)
160
161 C-- Report contents of model parameter file
162 WRITE(msgBuf,'(A)')
163 &'// ======================================================='
164 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
165 WRITE(msgBuf,'(A)') '// Model parameter file "data"'
166 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
167 WRITE(msgBuf,'(A)')
168 &'// ======================================================='
169 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
170 & SQUEEZE_RIGHT , 1)
171 iUnit = scrUnit2
172 REWIND(iUnit)
173 2000 CONTINUE
174 READ(UNIT=iUnit,FMT='(A)',END=2001) RECORD
175 IL = MAX(ILNBLNK(RECORD),1)
176 WRITE(msgBuf,'(A,A)') '>',RECORD(:IL)
177 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
178 GOTO 2000
179 2001 CONTINUE
180 CLOSE(iUnit)
181 WRITE(msgBuf,'(A)') ' '
182 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
183 & SQUEEZE_RIGHT , 1)
184
185
186 C-- Read settings from model parameter file "data".
187 iUnit = scrUnit1
188 REWIND(iUnit)
189
190 C-- Set default "physical" parameters
191 DO K =1,Nr
192 tRef(K) = 30.D0 - FLOAT( K )
193 ENDDO
194 gravity = 9.81D0
195 gBaro = gravity
196 rhoNil = 999.8D0
197 rhoConst = 999.8D0
198 f0 = 1.D-4
199 beta = 1.D-11
200 viscAh = 1.D3
201 diffKhT = 1.D3
202 diffKhS = 1.D3
203 viscArDefault = 1.D-3
204 viscAz = UNSET_RL
205 viscAr = UNSET_RL
206 viscAp = UNSET_RL
207 diffKrTDefault = 1.D-5
208 diffKzT = UNSET_RL
209 diffKpT = UNSET_RL
210 diffKrT = UNSET_RL
211 diffKrSDefault = 1.D-5
212 diffKzS = UNSET_RL
213 diffKpS = UNSET_RL
214 diffKrS = UNSET_RL
215 viscA4 = 0.
216 diffK4T = 0.
217 diffK4S = 0.
218 GMmaxslope = 1.D-2
219 GMlength = 200.D3
220 GMalpha = 0.D0
221 GMdepth = 1000.D0
222 GMkbackground= 0.D0
223 GMmaxval = 2500.D0
224 tAlpha = 2.D-4
225 sBeta = 7.4D-4
226 eosType = 'LINEAR'
227 buoyancyRelation = 'OCEANIC'
228 implicitFreeSurface = .TRUE.
229 rigidLid = .FALSE.
230 freeSurfFac = 1.D0
231 hFacMin = 0.D0
232 hFacMinDrDefault = 0.D0
233 hFacMinDr = UNSET_RL
234 hFacMinDz = UNSET_RL
235 hFacMinDp = UNSET_RL
236 momViscosity = .TRUE.
237 momAdvection = .TRUE.
238 momForcing = .TRUE.
239 useCoriolis = .TRUE.
240 momPressureForcing = .TRUE.
241 momStepping = .TRUE.
242 tempStepping = .TRUE.
243 saltStepping = .TRUE.
244 metricTerms = .TRUE.
245 implicitDiffusion = .FALSE.
246 READ(UNIT=iUnit,NML=PARM01,IOSTAT=errIO,err=3)
247 IF ( errIO .GE. 0 ) GOTO 4
248 3 CONTINUE
249 WRITE(msgBuf,'(A)')
250 & 'S/R INI_PARMS'
251 CALL PRINT_ERROR( msgBuf , 1)
252 WRITE(msgBuf,'(A)')
253 & 'Error reading numerical model '
254 CALL PRINT_ERROR( msgBuf , 1)
255 WRITE(msgBuf,'(A)')
256 & 'parameter file "data"'
257 CALL PRINT_ERROR( msgBuf , 1)
258 WRITE(msgBuf,'(A)')
259 & 'Problem in namelist PARM01'
260 CALL PRINT_ERROR( msgBuf , 1)
261 CALL MODELDATA_EXAMPLE( myThid )
262 STOP 'ABNORMAL END: S/R INI_PARMS'
263 4 CONTINUE
264 IF ( implicitFreeSurface ) freeSurfFac = 1.D0
265 IF ( rigidLid ) freeSurfFac = 0.D0
266 C-- Momentum viscosity on/off flag.
267 IF ( momViscosity ) THEN
268 vfFacMom = 1.D0
269 ELSE
270 vfFacMom = 0.D0
271 ENDIF
272 C-- Momentum advection on/off flag.
273 IF ( momAdvection ) THEN
274 afFacMom = 1.D0
275 ELSE
276 afFacMom = 0.D0
277 ENDIF
278 C-- Momentum forcing on/off flag.
279 IF ( momForcing ) THEN
280 foFacMom = 1.D0
281 ELSE
282 foFacMom = 0.D0
283 ENDIF
284 C-- Coriolis term on/off flag.
285 IF ( useCoriolis ) THEN
286 cfFacMom = 1.D0
287 ELSE
288 cfFacMom = 0.D0
289 ENDIF
290 C-- Pressure term on/off flag.
291 IF ( momPressureForcing ) THEN
292 pfFacMom = 1.D0
293 ELSE
294 pfFacMom = 0.D0
295 ENDIF
296 C-- Metric terms on/off flag.
297 IF ( metricTerms ) THEN
298 mTFacMom = 1.D0
299 ELSE
300 mTFacMom = 1.D0
301 ENDIF
302 C-- z,p,r coord input switching.
303 IF ( viscAz .NE. UNSET_RL ) zCoordInputData = .TRUE.
304 IF ( viscAp .NE. UNSET_RL ) pCoordInputData = .TRUE.
305 IF ( viscAr .NE. UNSET_RL ) rCoordInputData = .TRUE.
306 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAz
307 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscAp
308 IF ( viscAr .EQ. UNSET_RL ) viscAr = viscArDefault
309
310 IF ( diffKzT .NE. UNSET_RL ) zCoordInputData = .TRUE.
311 IF ( diffKpT .NE. UNSET_RL ) pCoordInputData = .TRUE.
312 IF ( diffKrT .NE. UNSET_RL ) rCoordInputData = .TRUE.
313 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKzT
314 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKpT
315 IF ( diffKrT .EQ. UNSET_RL ) diffKrT = diffKrTDefault
316
317 IF ( diffKzS .NE. UNSET_RL ) zCoordInputData = .TRUE.
318 IF ( diffKpS .NE. UNSET_RL ) pCoordInputData = .TRUE.
319 IF ( diffKrS .NE. UNSET_RL ) rCoordInputData = .TRUE.
320 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKzS
321 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKpS
322 IF ( diffKrS .EQ. UNSET_RL ) diffKrS = diffKrSDefault
323
324 IF ( hFacMinDz .NE. UNSET_RL ) zCoordInputData = .TRUE.
325 IF ( hFacMinDp .NE. UNSET_RL ) pCoordInputData = .TRUE.
326 IF ( hFacMinDr .NE. UNSET_RL ) rCoordInputData = .TRUE.
327 IF ( hFacMinDz .EQ. UNSET_RL ) hFacMinDr = hFacMinDz
328 IF ( hFacMinDp .EQ. UNSET_RL ) hFacMinDr = hFacMinDp
329 IF ( hFacMinDr .EQ. UNSET_RL ) hFacMinDr = hFacMinDrDefault
330
331 IF ( implicitFreeSurface .AND. rigidLid ) THEN
332 WRITE(msgBuf,'(A)')
333 & 'S/R INI_PARMS: Cannot select both implicitFreeSurface and rigidLid.'
334 CALL PRINT_ERROR( msgBuf , myThid)
335 STOP 'ABNORMAL END: S/R INI_PARMS'
336 ENDIF
337 coordsSet = 0
338 IF ( zCoordInputData ) coordsSet = coordsSet + 1
339 IF ( pCoordInputData ) coordsSet = coordsSet + 1
340 IF ( rCoordInputData ) coordsSet = coordsSet + 1
341 IF ( coordsSet .GT. 1 ) THEN
342 WRITE(msgBuf,'(A)')
343 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
344 CALL PRINT_ERROR( msgBuf , myThid)
345 STOP 'ABNORMAL END: S/R INI_PARMS'
346 ENDIF
347 IF ( rhoConst .LE. 0. ) THEN
348 WRITE(msgBuf,'(A)')
349 & 'S/R INI_PARMS: rhoConst must be greater than 0.'
350 CALL PRINT_ERROR( msgBuf , myThid)
351 STOP 'ABNORMAL END: S/R INI_PARMS'
352 ELSE
353 recip_rhoConst = 1.D0 / rhoConst
354 ENDIF
355
356 C-- Elliptic solver parameters
357 cg2dMaxIters = 150
358 cg2dTargetResidual = 1.D-7
359 cg2dChkResFreq = 1
360 cg2dpcOffDFac = 0.51D0
361 READ(UNIT=iUnit,NML=PARM02,IOSTAT=errIO,err=5)
362 IF ( errIO .GE. 0 ) GOTO 6
363 5 CONTINUE
364 WRITE(msgBuf,'(A)')
365 & 'S/R INI_PARMS'
366 CALL PRINT_ERROR( msgBuf , 1)
367 WRITE(msgBuf,'(A)')
368 & 'Error reading numerical model '
369 CALL PRINT_ERROR( msgBuf , 1)
370 WRITE(msgBuf,'(A)')
371 & 'parameter file "data".'
372 CALL PRINT_ERROR( msgBuf , 1)
373 WRITE(msgBuf,'(A)')
374 & 'Problem in namelist PARM02'
375 CALL PRINT_ERROR( msgBuf , 1)
376 CALL MODELDATA_EXAMPLE( myThid )
377 STOP 'ABNORMAL END: S/R INI_PARMS'
378 6 CONTINUE
379
380 C-- Time stepping parameters
381 startTime = 0.
382 nTimeSteps = 0
383 endTime = 0.
384 nIter0 = 0
385 deltaT = 0.
386 deltaTClock = 0.
387 deltaTtracer = 0.
388 deltaTMom = 0.
389 abEps = 0.01
390 pchkPtFreq = 0.
391 chkPtFreq = 3600.*25
392 dumpFreq = 3600.*100
393 taveFreq = 0.
394 writeStatePrec = precFloat32
395 nCheckLev = 1
396 checkPtSuff(1) = 'ckptA'
397 checkPtSuff(2) = 'ckptB'
398 cAdjFreq = -1.D0
399 rCD = -1.D0
400 tauCD = 0.D0
401 tauThetaClimRelax = 0.D0
402 doThetaClimRelax = .FALSE.
403 tauSaltClimRelax = 0.D0
404 doSaltClimRelax = .FALSE.
405 periodicExternalForcing = .FALSE.
406 externForcingPeriod = 0.
407 externForcingCycle = 0.
408 READ(UNIT=iUnit,NML=PARM03,IOSTAT=errIO,err=7)
409 IF ( errIO .GE. 0 ) GOTO 8
410 7 CONTINUE
411 WRITE(msgBuf,'(A)')
412 & 'S/R INI_PARMS'
413 CALL PRINT_ERROR( msgBuf , 1)
414 WRITE(msgBuf,'(A)')
415 & 'Error reading numerical model '
416 CALL PRINT_ERROR( msgBuf , 1)
417 WRITE(msgBuf,'(A)')
418 & 'parameter file "data"'
419 CALL PRINT_ERROR( msgBuf , 1)
420 WRITE(msgBuf,'(A)')
421 & 'Problem in namelist PARM03'
422 CALL PRINT_ERROR( msgBuf , 1)
423 CALL MODELDATA_EXAMPLE( myThid )
424 STOP 'ABNORMAL END: S/R INI_PARMS'
425 8 CONTINUE
426 C Process "timestepping" params
427 C o Time step size
428 IF ( deltaT .EQ. 0. ) deltaT = deltaTmom
429 IF ( deltaT .EQ. 0. ) deltaT = deltaTtracer
430 IF ( deltaTmom .EQ. 0. ) deltaTmom = deltaT
431 IF ( deltaTtracer .EQ. 0. ) deltaTtracer = deltaT
432 IF ( deltaTClock .EQ. 0. ) deltaTClock = deltaT
433 IF ( periodicExternalForcing ) THEN
434 IF ( externForcingCycle*externForcingPeriod .EQ. 0. ) THEN
435 WRITE(msgBuf,'(A)')
436 & 'S/R INI_PARMS: externForcingCycle,externForcingPeriod =0'
437 CALL PRINT_ERROR( msgBuf , 1)
438 STOP 'ABNORMAL END: S/R INI_PARMS'
439 ENDIF
440 IF ( INT(externForcingCycle/externForcingPeriod) .NE.
441 & externForcingCycle/externForcingPeriod ) THEN
442 WRITE(msgBuf,'(A)')
443 & 'S/R INI_PARMS: externForcingCycle <> N*externForcingPeriod'
444 CALL PRINT_ERROR( msgBuf , 1)
445 STOP 'ABNORMAL END: S/R INI_PARMS'
446 ENDIF
447 IF ( externForcingCycle.le.externForcingPeriod ) THEN
448 WRITE(msgBuf,'(A)')
449 & 'S/R INI_PARMS: externForcingCycle < externForcingPeriod'
450 CALL PRINT_ERROR( msgBuf , 1)
451 STOP 'ABNORMAL END: S/R INI_PARMS'
452 ENDIF
453 IF ( externForcingPeriod.lt.deltaTclock ) THEN
454 WRITE(msgBuf,'(A)')
455 & 'S/R INI_PARMS: externForcingPeriod < deltaTclock'
456 CALL PRINT_ERROR( msgBuf , 1)
457 STOP 'ABNORMAL END: S/R INI_PARMS'
458 ENDIF
459 ENDIF
460 C o Convection frequency
461 IF ( cAdjFreq .LT. 0. ) THEN
462 cAdjFreq = deltaTClock
463 ENDIF
464 C o CD coupling
465 IF ( tauCD .EQ. 0.D0 ) THEN
466 tauCD = deltaTmom
467 ENDIF
468 IF ( rCD .LT. 0. ) THEN
469 rCD = 1. - deltaTMom/tauCD
470 ENDIF
471 C o Temperature climatology relaxation time scale
472 IF ( tauThetaClimRelax .EQ. 0.D0 ) THEN
473 doThetaClimRelax = .FALSE.
474 lambdaThetaClimRelax = 0.D0
475 ELSE
476 doThetaClimRelax = .TRUE.
477 lambdaThetaClimRelax = 1./tauThetaClimRelax
478 ENDIF
479 C o Salinity climatology relaxation time scale
480 IF ( tauSaltClimRelax .EQ. 0.D0 ) THEN
481 doSaltClimRelax = .FALSE.
482 lambdaSaltClimRelax = 0.D0
483 ELSE
484 doSaltClimRelax = .TRUE.
485 lambdaSaltClimRelax = 1./tauSaltClimRelax
486 ENDIF
487 C o Time step count
488 IF ( endTime .NE. 0 ) THEN
489 IF ( deltaTClock .NE. 0 ) nTimeSteps =
490 & INT((endTime-startTime)/deltaTClock)
491 ENDIF
492 C o Finish time
493 IF ( endTime .EQ. 0. ) endTime = FLOAT(nTimeSteps)*deltaTClock
494
495 C o If taveFreq is finite, then we must make sure the diagnostics
496 C code is being compiled
497 #ifndef ALLOW_DIAGNOSTICS
498 IF (taveFreq.NE.0.) THEN
499 WRITE(msgBuf,'(A)')
500 & 'S/R INI_PARMS: taveFreq <> 0 but you have'
501 CALL PRINT_ERROR( msgBuf , 1)
502 WRITE(msgBuf,'(A)')
503 & 'not compiled the model with the diagnostics routines.'
504 CALL PRINT_ERROR( msgBuf , 1)
505 WRITE(msgBuf,'(A)')
506 & 'Re-compile with: #define ALLOW_DIAGNOSTICS or -DALLOW_DIAGNOSTICS'
507 CALL PRINT_ERROR( msgBuf , 1)
508 STOP 'ABNORMAL END: S/R INI_PARMS'
509 ENDIF
510 #endif
511
512 C-- Grid parameters
513 C In cartesian coords distances are in metres
514 rkFac = UNSET_I
515 usingCartesianGrid = .TRUE.
516 delRDefault = 1.D2
517 DO K =1,Nr
518 delZ(K) = UNSET_RL
519 delP(K) = UNSET_RL
520 delR(K) = UNSET_RL
521 ENDDO
522 dxSpacing = 20.D0 * 1000.D0
523 dySpacing = 20.D0 * 1000.D0
524 DO i=1,Nx
525 delX(i) = dxSpacing
526 ENDDO
527 DO j=1,Ny
528 delY(j) = dySpacing
529 ENDDO
530 C In spherical polar distances are in degrees
531 usingSphericalPolarGrid = .FALSE.
532 phiMin = -5.0
533 thetaMin = 0.
534 rSphere = 6370. * 1.D3
535 recip_rSphere = 1.D0/rSphere
536 IF ( usingSphericalPolarGrid ) THEN
537 dxSpacing = 1.
538 dySpacing = 1.
539 DO I=1,Nx
540 delX(I) = dxSpacing
541 ENDDO
542 DO J=1,Ny
543 delY(J) = dySpacing
544 ENDDO
545 ENDIF
546
547 READ(UNIT=iUnit,NML=PARM04,IOSTAT=errIO,err=9)
548 IF ( errIO .GE. 0 ) GOTO 10
549 9 CONTINUE
550 WRITE(msgBuf,'(A)')
551 & 'S/R INI_PARMS'
552 CALL PRINT_ERROR( msgBuf , 1)
553 WRITE(msgBuf,'(A)')
554 & 'Error reading numerical model '
555 CALL PRINT_ERROR( msgBuf , 1)
556 WRITE(msgBuf,'(A)')
557 & 'parameter file "data"'
558 CALL PRINT_ERROR( msgBuf , 1)
559 WRITE(msgBuf,'(A)')
560 & 'Problem in namelist PARM04'
561 CALL PRINT_ERROR( msgBuf , 1)
562 CALL MODELDATA_EXAMPLE( myThid )
563 STOP 'ABNORMAL END: S/R INI_PARMS'
564 10 CONTINUE
565 C
566 IF ( rSphere .NE. 0 ) THEN
567 recip_rSphere = 1.D0/rSphere
568 ELSE
569 recip_rSphere = 0.
570 ENDIF
571 C-- Initialize EOS coefficients (3rd order polynomial)
572 IF (eostype.eq.'POLY3') THEN
573 OPEN(37,FILE='POLY3.COEFFS',STATUS='OLD',FORM='FORMATTED')
574 READ(37,*) I
575 IF (I.NE.Nr) THEN
576 WRITE(msgBuf,'(A)')
577 & 'ini_parms: attempt to read POLY3.COEFFS failed'
578 CALL PRINT_ERROR( msgBuf , 1)
579 WRITE(msgBuf,'(A)')
580 & ' because bad # of levels in data'
581 CALL PRINT_ERROR( msgBuf , 1)
582 STOP 'Bad data in POLY3.COEFFS'
583 ENDIF
584 READ(37,*) (eosRefT(K),eosRefS(K),eosSig0(K),K=1,Nr)
585 DO K=1,Nr
586 READ(37,*) (eosC(I,K),I=1,9)
587 ENDDO
588 CLOSE(37)
589 ENDIF
590 C-- Check for conflicting grid definitions.
591 goptCount = 0
592 IF ( usingCartesianGrid ) goptCount = goptCount+1
593 IF ( usingSphericalPolarGrid ) goptCount = goptCount+1
594 IF ( goptCount .NE. 1 ) THEN
595 WRITE(msgBuf,'(A)')
596 & 'S/R INI_PARMS: More than one coordinate system requested'
597 CALL PRINT_ERROR( msgBuf , myThid)
598 STOP 'ABNORMAL END: S/R INI_PARMS'
599 ENDIF
600 C-- Make metric term settings consistent with underlying grid.
601 IF ( usingCartesianGrid ) THEN
602 usingSphericalPolarMterms = .FALSE.
603 metricTerms = .FALSE.
604 mTFacMom = 0
605 useBetaPlaneF = .TRUE.
606 ENDIF
607 IF ( usingSphericalPolarGrid ) THEN
608 useConstantF = .FALSE.
609 useBetaPlaneF = .FALSE.
610 useSphereF = .TRUE.
611 omega = 2.D0 * PI / ( 3600.D0 * 24.D0 )
612 usingSphericalPolarMterms = .TRUE.
613 metricTerms = .TRUE.
614 mTFacMom = 1
615 ENDIF
616 C-- p, z, r coord parameters
617 DO K = 1, Nr
618 IF ( delZ(K) .NE. UNSET_RL ) zCoordInputData = .TRUE.
619 IF ( delP(K) .NE. UNSET_RL ) pCoordInputData = .TRUE.
620 IF ( delR(K) .NE. UNSET_RL ) rCoordInputData = .TRUE.
621 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delZ(K)
622 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delP(K)
623 IF ( delR(K) .EQ. UNSET_RL ) delR(K) = delRDefault
624 ENDDO
625 C Check for multiple coordinate systems
626 coordsSet = 0
627 IF ( zCoordInputData ) coordsSet = coordsSet + 1
628 IF ( pCoordInputData ) coordsSet = coordsSet + 1
629 IF ( rCoordInputData ) coordsSet = coordsSet + 1
630 IF ( coordsSet .GT. 1 ) THEN
631 WRITE(msgBuf,'(A)')
632 & 'S/R INI_PARMS: Cannot mix z, p and r in the input data.'
633 CALL PRINT_ERROR( msgBuf , myThid)
634 STOP 'ABNORMAL END: S/R INI_PARMS'
635 ENDIF
636
637 C-- Input files
638 bathyFile = ' '
639 hydrogSaltFile = ' '
640 hydrogThetaFile = ' '
641 zonalWindFile = ' '
642 meridWindFile = ' '
643 thetaClimFile = ' '
644 saltClimFile = ' '
645 READ(UNIT=iUnit,NML=PARM05,IOSTAT=errIO,err=11)
646 IF ( errIO .GE. 0 ) GOTO 12
647 11 CONTINUE
648 WRITE(msgBuf,'(A)')
649 & 'S/R INI_PARMS'
650 CALL PRINT_ERROR( msgBuf , 1)
651 WRITE(msgBuf,'(A)')
652 & 'Error reading numerical model '
653 CALL PRINT_ERROR( msgBuf , 1)
654 WRITE(msgBuf,'(A)')
655 & 'parameter file "data"'
656 CALL PRINT_ERROR( msgBuf , 1)
657 WRITE(msgBuf,'(A)')
658 & 'Problem in namelist PARM05'
659 CALL PRINT_ERROR( msgBuf , 1)
660 CALL MODELDATA_EXAMPLE( myThid )
661 STOP 'ABNORMAL END: S/R INI_PARMS'
662 12 CONTINUE
663
664 C
665 IF ( zCoordInputData .AND. rkFac .EQ. UNSET_I ) rkFac = 1.D0
666 IF ( pCoordInputData .AND. rkFac .EQ. UNSET_I ) rkFac = -1.D0
667 IF ( rCoordInputData .AND. rkFac .EQ. UNSET_I ) rkFac = 1.D0
668 recip_rkFac = 1.D0 / rkFac
669 IF ( zCoordInputData ) usingZCoords = .TRUE.
670 IF ( pCoordInputData ) usingPCoords = .TRUE.
671 C
672 CLOSE(iUnit)
673
674 _END_MASTER(myThid)
675
676 C-- Everyone else must wait for the parameters to be loaded
677 _BARRIER
678 C
679
680 RETURN
681 END
682

  ViewVC Help
Powered by ViewVC 1.1.22