/[MITgcm]/MITgcm/model/src/ini_parms.F
ViewVC logotype

Annotation of /MITgcm/model/src/ini_parms.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.51 - (hide annotations) (download)
Wed Jun 21 19:06:36 2000 UTC (23 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint29, checkpoint30
Changes since 1.50: +5 -129 lines
Removed all mention of KPP and GM/Redi parameters from ini_parms().
Initialization of these parameters is done by kpp_init() and gmredi_init().

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

  ViewVC Help
Powered by ViewVC 1.1.22