/[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.39 - (show annotations) (download)
Tue Dec 15 00:20:34 1998 UTC (25 years, 5 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint19
Changes since 1.38: +35 -113 lines
 o Added "natural BCs" as alternative to "virtual salt flux"
 o Re-difined precFloat32 and precFloat64 to be 32 and 64
   so that their values can be meaningfuly set in the data file
 o Modified read_write.F to create an exception if readBinaryPrec
   is not set
 o Replaced CPP control of viscous BCs with run-time control
 o Tidied up input-data precision (ie. ini_depths cnh_dbg...)
 o ini_forcing.F now initialises *all* forcing arrays to zero
 o Definitively tested verification experiments 0,1,2 and 4
   (3 is atmospheric set-up which is in a state of flux)

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

  ViewVC Help
Powered by ViewVC 1.1.22