/[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.42 - (show annotations) (download)
Wed May 5 18:32:34 1999 UTC (25 years, 1 month ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint21
Changes since 1.41: +9 -2 lines
Implemented new I/O package (mdsio.F). This package does parallel
I/O in much the same way as dfile.F used to except it uses "direct
access" rather than (f77) unformatted sequential access.

Problems with dfile.F package included:
  o unnecessary memory use (each process had two global sized buffers)
  o inability to read the files it had written without post-processing
  o "tiled" files were tiled by process/thread rather than actual tiles
  o created huge numbers of files with no alternatives

Features of the mdsio.F package:
  o direct-access binary writes
  o no excessive memory use
  o ability to read/write from multiple record files
  o "tiled" files are based on "WRAPPER" tiles so that the number
    and content of files is independent of the number of threads
    and/or processes
  o option to create single "global" files rather than "tiled" files
  o ability to read both "global" and "tiled" files
    [Caveat: the tiling of files must match the model tiles]
  o checkpoints now use a single file per model section
    ie.  one file for the hydrostatic model core, one file
    for the non-hydrostatic extensions and one file for the C-D
    extensions
  o the mid-level I/O routines now is broken into more source files
    read_write_fld.F supplies basic I/O routines with the same interface
                     as the original I/O package
    read_write_rec.F supplies I/O routines which allow multiple records
    write_state.F    writes the model state
    checkpoint.F     supplies the read/write checkpoint routines

All the example input data has had to be modified to be direct-access.
Otherwise only routines that used I/O have been affected and not
all of those have been due to the continuity of arguments in
the read_write_fld.F routines.

What needs to be done?  We have to create a suite of conversion
utilities for users with old-style data. Also supply the option
for using old-style I/O, not just for die-hards but for reading
data too extensive to be converted. And more...

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

  ViewVC Help
Powered by ViewVC 1.1.22