ROMS
Loading...
Searching...
No Matches
ecosim_inp.h
Go to the documentation of this file.
1 SUBROUTINE read_biopar (model, inp, out, Lwrite)
2!
3!git $Id$
4!================================================== Hernan G. Arango ===
5! Copyright (c) 2002-2025 The ROMS Group !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! This routine reads in EcoSim bio-optical model input parameters. !
11! They are specified in input script "ecosim.in". !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_parallel
17 USE mod_biology
18 USE mod_eclight
19 USE mod_ncparam
20 USE mod_scalars
21!
22 USE inp_decode_mod
23!
24 implicit none
25!
26! Imported variable declarations
27!
28 logical, intent(in) :: Lwrite
29 integer, intent(in) :: model, inp, out
30!
31! Local variable declarations.
32!
33 integer :: Npts, Nval
34 integer :: iTrcStr, iTrcEnd
35 integer :: i, ifield, igrid, is, itracer, itrc, ng, nline, status
36 integer :: ibac, iband, ifec, iphy
37
38 logical, dimension(Ngrids) :: Lbio
39 logical, dimension(NBT,Ngrids) :: Ltrc
40
41 real(r8), dimension(NBT,Ngrids) :: Rbio
42
43 real(dp), dimension(nRval) :: Rval
44
45 character (len=40 ) :: KeyWord
46 character (len=256) :: line
47 character (len=256), dimension(nCval) :: Cval
48!
49!-----------------------------------------------------------------------
50! Initialize.
51!-----------------------------------------------------------------------
52!
53 igrid=1 ! nested grid counter
54 itracer=0 ! LBC tracer counter
55 itrcstr=1 ! first LBC tracer to process
56 itrcend=nbt ! last LBC tracer to process
57 nline=0 ! LBC multi-line counter
58!
59!-----------------------------------------------------------------------
60! Read in EcoSim bio-optical model parameters.
61!-----------------------------------------------------------------------
62!
63 DO WHILE (.true.)
64 READ (inp,'(a)',err=10,END=20) line
65 status=decode_line(line, keyword, nval, cval, rval)
66 IF (status.gt.0) THEN
67 SELECT CASE (trim(keyword))
68 CASE ('Lbiology')
69 npts=load_l(nval, cval, ngrids, lbiology)
70 CASE ('BioIter')
71 npts=load_i(nval, rval, ngrids, bioiter)
72 CASE ('RtUVR_flag')
73 npts=load_l(nval, cval, ngrids, rtuvr_flag)
74 CASE ('NFIX_flag')
75 npts=load_l(nval, cval, ngrids, nfix_flag)
76 CASE ('Regen_flag')
77 npts=load_l(nval, cval, ngrids, regen_flag)
78 CASE ('HsNO3')
79 npts=load_r(nval, rval, nphy, ngrids, hsno3)
80 CASE ('HsNH4')
81 npts=load_r(nval, rval, nphy, ngrids, hsnh4)
82 CASE ('HsSiO')
83 npts=load_r(nval, rval, nphy, ngrids, hssio)
84 CASE ('HsPO4')
85 npts=load_r(nval, rval, nphy, ngrids, hspo4)
86 CASE ('HsFe')
87 npts=load_r(nval, rval, nphy, ngrids, hsfe)
88 CASE ('GtALG_max')
89 npts=load_r(nval, rval, nphy, ngrids, gtalg_max)
90 CASE ('PhyTbase')
91 npts=load_r(nval, rval, nphy, ngrids, phytbase)
92 CASE ('PhyTfac')
93 npts=load_r(nval, rval, nphy, ngrids, phytfac)
94 CASE ('BET_')
95 npts=load_r(nval, rval, nphy, ngrids, bet_)
96 CASE ('maxC2nALG')
97 npts=load_r(nval, rval, nphy, ngrids, maxc2nalg)
98 CASE ('minC2nALG')
99 npts=load_r(nval, rval, nphy, ngrids, minc2nalg)
100 CASE ('C2nALGminABS')
101 npts=load_r(nval, rval, nphy, ngrids, c2nalgminabs)
102 CASE ('maxC2SiALG')
103 npts=load_r(nval, rval, nphy, ngrids, maxc2sialg)
104 CASE ('minC2SiALG')
105 npts=load_r(nval, rval, nphy, ngrids, minc2sialg)
106 CASE ('C2SiALGminABS')
107 npts=load_r(nval, rval, nphy, ngrids, c2sialgminabs)
108 CASE ('maxC2pALG')
109 npts=load_r(nval, rval, nphy, ngrids, maxc2palg)
110 CASE ('minC2pALG')
111 npts=load_r(nval, rval, nphy, ngrids, minc2palg)
112 CASE ('C2pALGminABS')
113 npts=load_r(nval, rval, nphy, ngrids, c2palgminabs)
114 CASE ('maxC2FeALG')
115 npts=load_r(nval, rval, nphy, ngrids, maxc2fealg)
116 CASE ('minC2FeALG')
117 npts=load_r(nval, rval, nphy, ngrids, minc2fealg)
118 CASE ('C2FeALGminABS')
119 npts=load_r(nval, rval, nphy, ngrids, c2fealgminabs)
120 CASE ('qu_yld')
121 npts=load_r(nval, rval, nphy, ngrids, qu_yld)
122 CASE ('E0_comp')
123 npts=load_r(nval, rval, nphy, ngrids, e0_comp)
124 CASE ('E0_inhib')
125 npts=load_r(nval, rval, nphy, ngrids, e0_inhib)
126 CASE ('inhib_fac')
127 npts=load_r(nval, rval, nphy, ngrids, inhib_fac)
128 CASE ('C2CHL_max')
129 npts=load_r(nval, rval, nphy, ngrids, c2chl_max)
130 CASE ('mxC2Cl')
131 npts=load_r(nval, rval, nphy, ngrids, mxc2cl)
132 CASE ('b_C2Cl')
133 npts=load_r(nval, rval, nphy, ngrids, b_c2cl)
134 CASE ('mxC2Cn')
135 npts=load_r(nval, rval, nphy, ngrids, mxc2cn)
136 CASE ('b_C2Cn')
137 npts=load_r(nval, rval, nphy, ngrids, b_c2cn)
138 CASE ('mxPacEff')
139 npts=load_r(nval, rval, nphy, ngrids, mxpaceff)
140 CASE ('b_PacEff')
141 npts=load_r(nval, rval, nphy, ngrids, b_paceff)
142 CASE ('mxChlB')
143 npts=load_r(nval, rval, nphy, ngrids, mxchlb)
144 CASE ('b_ChlB')
145 npts=load_r(nval, rval, nphy, ngrids, b_chlb)
146 CASE ('mxChlC')
147 npts=load_r(nval, rval, nphy, ngrids, mxchlc)
148 CASE ('b_ChlC')
149 npts=load_r(nval, rval, nphy, ngrids, b_chlc)
150 CASE ('mxPSC')
151 npts=load_r(nval, rval, nphy, ngrids, mxpsc)
152 CASE ('b_PSC')
153 npts=load_r(nval, rval, nphy, ngrids, b_psc)
154 CASE ('mxPPC')
155 npts=load_r(nval, rval, nphy, ngrids, mxppc)
156 CASE ('b_PPC')
157 npts=load_r(nval, rval, nphy, ngrids, b_ppc)
158 CASE ('mxLPUb')
159 npts=load_r(nval, rval, nphy, ngrids, mxlpub)
160 CASE ('b_LPUb')
161 npts=load_r(nval, rval, nphy, ngrids, b_lpub)
162 CASE ('mxHPUb')
163 npts=load_r(nval, rval, nphy, ngrids, mxhpub)
164 CASE ('b_HPUb')
165 npts=load_r(nval, rval, nphy, ngrids, b_hpub)
166 CASE ('FecDOC')
167 npts=load_r(nval, rval, nphy, ngrids, fecdoc)
168 CASE ('FecPEL')
169 npts=load_r(nval, rval, nphy, nfec, ngrids, fecpel)
170 CASE ('FecCYC')
171 npts=load_r(nval, rval, nphy, ngrids, feccyc)
172 CASE ('ExALG')
173 npts=load_r(nval, rval, nphy, ngrids, exalg)
174 CASE ('WS')
175 npts=load_r(nval, rval, nphy, ngrids, ws)
176 CASE ('HsGRZ')
177 npts=load_r(nval, rval, nphy, ngrids, hsgrz)
178 CASE ('MinRefuge')
179 npts=load_r(nval, rval, nphy, ngrids, minrefuge)
180 CASE ('RefugeDep')
181 npts=load_r(nval, rval, nphy, ngrids, refugedep)
182 CASE ('Norm_Vol')
183 npts=load_r(nval, rval, nphy, ngrids, norm_vol)
184 CASE ('Norm_Surf')
185 npts=load_r(nval, rval, nphy, ngrids, norm_surf)
186 CASE ('HsDOP')
187 npts=load_r(nval, rval, nphy, ngrids, hsdop)
188 CASE ('C2pALKPHOS')
189 npts=load_r(nval, rval, nphy, ngrids, c2palkphos)
190 CASE ('HsDON')
191 npts=load_r(nval, rval, nphy, ngrids, hsdon)
192 CASE ('C2nNupDON')
193 npts=load_r(nval, rval, nphy, ngrids, c2nnupdon)
194 CASE ('C2nBAC')
195 npts=load_r(nval, rval, ngrids, c2nbac)
196 CASE ('C2pBAC')
197 npts=load_r(nval, rval, ngrids, c2pbac)
198 CASE ('C2FeBAC')
199 npts=load_r(nval, rval, ngrids, c2febac)
200 CASE ('HsDOC_ba')
201 npts=load_r(nval, rval, nbac, ngrids, hsdoc_ba)
202 CASE ('GtBAC_max')
203 npts=load_r(nval, rval, nbac, ngrids, gtbac_max)
204 CASE ('BacTbase')
205 npts=load_r(nval, rval, nbac, ngrids, bactbase)
206 CASE ('BacTfac')
207 npts=load_r(nval, rval, nbac, ngrids, bactfac)
208 CASE ('BacDOC')
209 npts=load_r(nval, rval, ngrids, bacdoc)
210 CASE ('BacPEL')
211 npts=load_r(nval, rval, ngrids, bacpel)
212 CASE ('BacCYC')
213 npts=load_r(nval, rval, ngrids, baccyc)
214 CASE ('ExBAC_c')
215 npts=load_r(nval, rval, ngrids, exbac_c)
216 CASE ('ExBacC2N')
217 npts=load_r(nval, rval, ngrids, exbacc2n)
218 CASE ('Bac_Ceff')
219 npts=load_r(nval, rval, ngrids, bac_ceff)
220 CASE ('RtNIT')
221 npts=load_r(nval, rval, ngrids, rtnit)
222 CASE ('HsNIT')
223 npts=load_r(nval, rval, ngrids, hsnit)
224 CASE ('cDOCfrac_c')
225 npts=load_r(nval, rval, ndom, ngrids, cdocfrac_c)
226 CASE ('RtUVR_DIC')
227 npts=load_r(nval, rval, ngrids, rtuvr_dic)
228 CASE ('RtUVR_DOC')
229 npts=load_r(nval, rval, ngrids, rtuvr_doc)
230 CASE ('WF')
231 npts=load_r(nval, rval, nfec, ngrids, wf)
232 CASE ('RegTbase')
233 npts=load_r(nval, rval, nfec, ngrids, regtbase)
234 CASE ('RegTfac')
235 npts=load_r(nval, rval, nfec, ngrids, regtfac)
236 CASE ('RegCR')
237 npts=load_r(nval, rval, nfec, ngrids, regcr)
238 CASE ('RegNR')
239 npts=load_r(nval, rval, nfec, ngrids, regnr)
240 CASE ('RegSR')
241 npts=load_r(nval, rval, nfec, ngrids, regsr)
242 CASE ('RegPR')
243 npts=load_r(nval, rval, nfec, ngrids, regpr)
244 CASE ('RegFR')
245 npts=load_r(nval, rval, nfec, ngrids, regfr)
246 CASE ('TNU2')
247 npts=load_r(nval, rval, nbt, ngrids, rbio)
248 DO ng=1,ngrids
249 DO itrc=1,nbt
250 i=idbio(itrc)
251 nl_tnu2(i,ng)=rbio(itrc,ng)
252 END DO
253 END DO
254 CASE ('TNU4')
255 npts=load_r(nval, rval, nbt, ngrids, rbio)
256 DO ng=1,ngrids
257 DO itrc=1,nbt
258 i=idbio(itrc)
259 nl_tnu4(i,ng)=rbio(itrc,ng)
260 END DO
261 END DO
262 CASE ('ad_TNU2')
263 npts=load_r(nval, rval, nbt, ngrids, rbio)
264 DO ng=1,ngrids
265 DO itrc=1,nbt
266 i=idbio(itrc)
267 ad_tnu2(i,ng)=rbio(itrc,ng)
268 tl_tnu2(i,ng)=rbio(itrc,ng)
269 END DO
270 END DO
271 CASE ('ad_TNU4')
272 npts=load_r(nval, rval, nbt, ngrids, rbio)
273 DO ng=1,ngrids
274 DO itrc=1,nbt
275 i=idbio(itrc)
276 ad_tnu4(i,ng)=rbio(itrc,ng)
277 tl_tnu4(i,ng)=rbio(itrc,ng)
278 END DO
279 END DO
280 CASE ('LtracerSponge')
281 npts=load_l(nval, cval, nbt, ngrids, ltrc)
282 DO ng=1,ngrids
283 DO itrc=1,nbt
284 i=idbio(itrc)
285 ltracersponge(i,ng)=ltrc(itrc,ng)
286 END DO
287 END DO
288 CASE ('AKT_BAK')
289 npts=load_r(nval, rval, nbt, ngrids, rbio)
290 DO ng=1,ngrids
291 DO itrc=1,nbt
292 i=idbio(itrc)
293 akt_bak(i,ng)=rbio(itrc,ng)
294 END DO
295 END DO
296 CASE ('ad_AKT_fac')
297 npts=load_r(nval, rval, nbt, ngrids, rbio)
298 DO ng=1,ngrids
299 DO itrc=1,nbt
300 i=idbio(itrc)
301 ad_akt_fac(i,ng)=rbio(itrc,ng)
302 tl_akt_fac(i,ng)=rbio(itrc,ng)
303 END DO
304 END DO
305 CASE ('TNUDG')
306 npts=load_r(nval, rval, nbt, ngrids, rbio)
307 DO ng=1,ngrids
308 DO itrc=1,nbt
309 i=idbio(itrc)
310 tnudg(i,ng)=rbio(itrc,ng)
311 END DO
312 END DO
313 CASE ('Hadvection')
314 IF (itracer.lt.nbt) THEN
315 itracer=itracer+1
316 ELSE
317 itracer=1 ! next nested grid
318 END IF
319 itrc=idbio(itracer)
320 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
321 & itracer, idbio(itrcstr), idbio(itrcend), &
322 & vname(1,idtvar(itrc)), &
323 & hadvection)
324 CASE ('Vadvection')
325 IF (itracer.lt.nbt) THEN
326 itracer=itracer+1
327 ELSE
328 itracer=1 ! next nested grid
329 END IF
330 itrc=idbio(itracer)
331 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
332 & itracer, idbio(itrcstr), idbio(itrcend), &
333 & vname(1,idtvar(itrc)), &
334 & vadvection)
335#if defined ADJOINT || defined TANGENT || defined TL_IOMS
336 CASE ('ad_Hadvection')
337 IF (itracer.lt.nbt) THEN
338 itracer=itracer+1
339 ELSE
340 itracer=1 ! next nested grid
341 END IF
342 itrc=idbio(itracer)
343 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
344 & itracer, idbio(itrcstr), idbio(itrcend), &
345 & vname(1,idtvar(itrc)), &
346 & ad_hadvection)
347 CASE ('Vadvection')
348 IF (itracer.lt.(nbt) THEN
349 itracer=itracer+1
350 ELSE
351 itracer=1 ! next nested grid
352 END IF
353 itrc=idbio(itracer)
354 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
355 & itracer, idbio(itrcstr), idbio(itrcend), &
356 & vname(1,idtvar(itrc)), &
357 & ad_vadvection)
358#endif
359
360 CASE ('LBC(isTvar)')
361 IF (itracer.lt.nbt) THEN
362 itracer=itracer+1
363 ELSE
364 itracer=1 ! next nested grid
365 END IF
366 ifield=istvar(idbio(itracer))
367 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
368 & idbio(itrcstr), idbio(itrcend), &
369 & vname(1,idtvar(idbio(itracer))), lbc)
370#if defined ADJOINT || defined TANGENT || defined TL_IOMS
371 CASE ('ad_LBC(isTvar)')
372 IF (itracer.lt.nbt) THEN
373 itracer=itracer+1
374 ELSE
375 itracer=1 ! next nested grid
376 END IF
377 ifield=istvar(idbio(itracer))
378 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
379 & idbio(itrcstr), idbio(itrcend), &
380 & vname(1,idtvar(idbio(itracer))), ad_lbc)
381#endif
382 CASE ('LtracerSrc')
383 npts=load_l(nval, cval, nbt, ngrids, ltrc)
384 DO ng=1,ngrids
385 DO itrc=1,nbt
386 i=idbio(itrc)
387 ltracersrc(i,ng)=ltrc(itrc,ng)
388 END DO
389 END DO
390 CASE ('LtracerCLM')
391 npts=load_l(nval, cval, nbt, ngrids, ltrc)
392 DO ng=1,ngrids
393 DO itrc=1,nbt
394 i=idbio(itrc)
395 ltracerclm(i,ng)=ltrc(itrc,ng)
396 END DO
397 END DO
398 CASE ('LnudgeTCLM')
399 npts=load_l(nval, cval, nbt, ngrids, ltrc)
400 DO ng=1,ngrids
401 DO itrc=1,nbt
402 i=idbio(itrc)
403 lnudgetclm(i,ng)=ltrc(itrc,ng)
404 END DO
405 END DO
406 CASE ('Hout(idTvar)')
407 npts=load_l(nval, cval, nbt, ngrids, ltrc)
408 DO ng=1,ngrids
409 DO itrc=1,nbt
410 i=idtvar(idbio(itrc))
411 IF (i.eq.0) THEN
412 IF (master) WRITE (out,30) &
413 & 'idTvar(idbio(', itrc, '))'
414 exit_flag=5
415 RETURN
416 END IF
417 hout(i,ng)=ltrc(itrc,ng)
418 END DO
419 END DO
420 CASE ('Hout(idTsur)')
421 npts=load_l(nval, cval, nbt, ngrids, ltrc)
422 DO ng=1,ngrids
423 DO itrc=1,nbt
424 i=idtsur(idbio(itrc))
425 IF (i.eq.0) THEN
426 IF (master) WRITE (out,30) &
427 & 'idTsur(idbio(', itrc, '))'
428 exit_flag=5
429 RETURN
430 END IF
431 hout(i,ng)=ltrc(itrc,ng)
432 END DO
433 END DO
434 CASE ('Qout(idTvar)')
435 npts=load_l(nval, cval, nbt, ngrids, ltrc)
436 DO ng=1,ngrids
437 DO itrc=1,nbt
438 i=idtvar(idbio(itrc))
439 qout(i,ng)=ltrc(itrc,ng)
440 END DO
441 END DO
442 CASE ('Qout(idsurT)')
443 npts=load_l(nval, cval, nbt, ngrids, ltrc)
444 DO ng=1,ngrids
445 DO itrc=1,nbt
446 i=idsurt(idbio(itrc))
447 IF (i.eq.0) THEN
448 IF (master) WRITE (out,30) &
449 & 'idsurT(idbio(', itrc, '))'
450 exit_flag=5
451 RETURN
452 END IF
453 qout(i,ng)=ltrc(itrc,ng)
454 END DO
455 END DO
456 CASE ('Qout(idTsur)')
457 npts=load_l(nval, cval, nbt, ngrids, ltrc)
458 DO ng=1,ngrids
459 DO itrc=1,nbt
460 i=idtsur(idbio(itrc))
461 qout(i,ng)=ltrc(itrc,ng)
462 END DO
463 END DO
464#if defined AVERAGES || \
465 (defined ad_averages && defined adjoint) || \
466 (defined rp_averages && defined tl_ioms) || \
467 (defined tl_averages && defined tangent)
468 CASE ('Aout(idTvar)')
469 npts=load_l(nval, cval, nbt, ngrids, ltrc)
470 DO ng=1,ngrids
471 DO itrc=1,nbt
472 i=idtvar(idbio(itrc))
473 aout(i,ng)=ltrc(itrc,ng)
474 END DO
475 END DO
476 CASE ('Aout(idTTav)')
477 npts=load_l(nval, cval, nbt, ngrids, ltrc)
478 DO ng=1,ngrids
479 DO itrc=1,nbt
480 i=idttav(idbio(itrc))
481 aout(i,ng)=ltrc(itrc,ng)
482 END DO
483 END DO
484 CASE ('Aout(idUTav)')
485 npts=load_l(nval, cval, nbt, ngrids, ltrc)
486 DO ng=1,ngrids
487 DO itrc=1,nbt
488 i=idutav(idbio(itrc))
489 aout(i,ng)=ltrc(itrc,ng)
490 END DO
491 END DO
492 CASE ('Aout(idVTav)')
493 npts=load_l(nval, cval, nbt, ngrids, ltrc)
494 DO ng=1,ngrids
495 DO itrc=1,nbt
496 i=idvtav(idbio(itrc))
497 aout(i,ng)=ltrc(itrc,ng)
498 END DO
499 END DO
500 CASE ('Aout(iHUTav)')
501 npts=load_l(nval, cval, nbt, ngrids, ltrc)
502 DO ng=1,ngrids
503 DO itrc=1,nbt
504 i=ihutav(idbio(itrc))
505 aout(i,ng)=ltrc(itrc,ng)
506 END DO
507 END DO
508 CASE ('Aout(iHVTav)')
509 npts=load_l(nval, cval, nbt, ngrids, ltrc)
510 DO ng=1,ngrids
511 DO itrc=1,nbt
512 i=ihvtav(idbio(itrc))
513 aout(i,ng)=ltrc(itrc,ng)
514 END DO
515 END DO
516#endif
517#ifdef DIAGNOSTICS_TS
518 CASE ('Dout(iTrate)')
519 npts=load_l(nval, cval, nbt, ngrids, ltrc)
520 DO ng=1,ngrids
521 DO i=1,nbt
522 itrc=idbio(i)
523 dout(iddtrc(itrc,itrate),ng)=ltrc(i,ng)
524 END DO
525 END DO
526 CASE ('Dout(iThadv)')
527 npts=load_l(nval, cval, nbt, ngrids, ltrc)
528 DO ng=1,ngrids
529 DO i=1,nbt
530 itrc=idbio(i)
531 dout(iddtrc(itrc,ithadv),ng)=ltrc(i,ng)
532 END DO
533 END DO
534 CASE ('Dout(iTxadv)')
535 npts=load_l(nval, cval, nbt, ngrids, ltrc)
536 DO ng=1,ngrids
537 DO i=1,nbt
538 itrc=idbio(i)
539 dout(iddtrc(itrc,itxadv),ng)=ltrc(i,ng)
540 END DO
541 END DO
542 CASE ('Dout(iTyadv)')
543 npts=load_l(nval, cval, nbt, ngrids, ltrc)
544 DO ng=1,ngrids
545 DO i=1,nbt
546 itrc=idbio(i)
547 dout(iddtrc(itrc,ityadv),ng)=ltrc(i,ng)
548 END DO
549 END DO
550 CASE ('Dout(iTvadv)')
551 npts=load_l(nval, cval, nbt, ngrids, ltrc)
552 DO ng=1,ngrids
553 DO i=1,nbt
554 itrc=idbio(i)
555 dout(iddtrc(itrc,itvadv),ng)=ltrc(i,ng)
556 END DO
557 END DO
558# if defined TS_DIF2 || defined TS_DIF4
559 CASE ('Dout(iThdif)')
560 npts=load_l(nval, cval, nbt, ngrids, ltrc)
561 DO ng=1,ngrids
562 DO i=1,nbt
563 itrc=idbio(i)
564 dout(iddtrc(itrc,ithdif),ng)=ltrc(i,ng)
565 END DO
566 END DO
567 CASE ('Dout(iTxdif)')
568 npts=load_l(nval, cval, nbt, ngrids, ltrc)
569 DO ng=1,ngrids
570 DO i=1,nbt
571 itrc=idbio(i)
572 dout(iddtrc(itrc,itxdif),ng)=ltrc(i,ng)
573 END DO
574 END DO
575 CASE ('Dout(iTydif)')
576 npts=load_l(nval, cval, nbt, ngrids, ltrc)
577 DO ng=1,ngrids
578 DO i=1,nbt
579 itrc=idbio(i)
580 dout(iddtrc(itrc,itydif),ng)=ltrc(i,ng)
581 END DO
582 END DO
583# if defined MIX_GEO_TS || defined MIX_ISO_TS
584 CASE ('Dout(iTsdif)')
585 npts=load_l(nval, cval, nbt, ngrids, ltrc)
586 DO ng=1,ngrids
587 DO i=1,nbt
588 itrc=idbio(i)
589 dout(iddtrc(itrc,itsdif),ng)=ltrc(i,ng)
590 END DO
591 END DO
592# endif
593# endif
594 CASE ('Dout(iTvdif)')
595 npts=load_l(nval, cval, nbt, ngrids, ltrc)
596 DO ng=1,ngrids
597 DO i=1,nbt
598 itrc=idbio(i)
599 dout(iddtrc(itrc,itvdif),ng)=ltrc(i,ng)
600 END DO
601 END DO
602#endif
603#ifdef DIAGNOSTICS_BIO
604 CASE ('Dout(idSpIr)')
605 IF (idbio3(idspir).eq.0) THEN
606 IF (master) WRITE (out,40) 'iDbio3(idSpIr)'
607 exit_flag=5
608 RETURN
609 END IF
610 npts=load_l(nval, cval, ngrids, lbio)
611 i=idbio3(idspir)
612 DO ng=1,ngrids
613 dout(i,ng)=lbio(ng)
614 END DO
615 CASE ('Dout(iddIrr)')
616 IF (idbio4(iddirr).eq.0) THEN
617 IF (master) WRITE (out,40) 'iDbio4(iddIrr)'
618 exit_flag=5
619 RETURN
620 END IF
621 npts=load_l(nval, cval, ngrids, lbio)
622 i=idbio4(iddirr)
623 DO ng=1,ngrids
624 dout(i,ng)=lbio(ng)
625 END DO
626 CASE ('Dout(idsIrr)')
627 IF (idbio4(idsirr).eq.0) THEN
628 IF (master) WRITE (out,40) 'iDbio4(idsIrr)'
629 exit_flag=5
630 RETURN
631 END IF
632 npts=load_l(nval, cval, ngrids, lbio)
633 i=idbio4(idsirr)
634 DO ng=1,ngrids
635 dout(i,ng)=lbio(ng)
636 END DO
637 CASE ('Dout(idLatt)')
638 IF (idbio4(idlatt).eq.0) THEN
639 IF (master) WRITE (out,40) 'iDbio4(idLatt)'
640 exit_flag=5
641 RETURN
642 END IF
643 npts=load_l(nval, cval, ngrids, lbio)
644 i=idbio4(idlatt)
645 DO ng=1,ngrids
646 dout(i,ng)=lbio(ng)
647 END DO
648 CASE ('Dout(idaPHY)')
649 IF (idbio4(idaphy).eq.0) THEN
650 IF (master) WRITE (out,40) 'iDbio4(idaPHY)'
651 exit_flag=5
652 RETURN
653 END IF
654 npts=load_l(nval, cval, ngrids, lbio)
655 i=idbio4(idaphy)
656 DO ng=1,ngrids
657 dout(i,ng)=lbio(ng)
658 END DO
659 CASE ('Dout(idaDET)')
660 IF (idbio4(idadet).eq.0) THEN
661 IF (master) WRITE (out,40) 'iDbio4(idaDET)'
662 exit_flag=5
663 RETURN
664 END IF
665 npts=load_l(nval, cval, ngrids, lbio)
666 i=idbio4(idadet)
667 DO ng=1,ngrids
668 dout(i,ng)=lbio(ng)
669 END DO
670 CASE ('Dout(idaCDC)')
671 IF (idbio4(idacdc).eq.0) THEN
672 IF (master) WRITE (out,40) 'iDbio4(idaCDC)'
673 exit_flag=5
674 RETURN
675 END IF
676 npts=load_l(nval, cval, ngrids, lbio)
677 i=idbio4(idacdc)
678 DO ng=1,ngrids
679 dout(i,ng)=lbio(ng)
680 END DO
681 CASE ('Dout(idAcos)')
682 IF (idbio4(idacos).eq.0) THEN
683 IF (master) WRITE (out,40) 'iDbio4(idAcos)'
684 exit_flag=5
685 RETURN
686 END IF
687 npts=load_l(nval, cval, ngrids, lbio)
688 i=idbio4(idacos)
689 DO ng=1,ngrids
690 dout(i,ng)=lbio(ng)
691 END DO
692 CASE ('Dout(idbPHY)')
693 IF (idbio4(idbphy).eq.0) THEN
694 IF (master) WRITE (out,40) 'iDbio4(idbPHY)'
695 exit_flag=5
696 RETURN
697 END IF
698 npts=load_l(nval, cval, ngrids, lbio)
699 i=idbio4(idbphy)
700 DO ng=1,ngrids
701 dout(i,ng)=lbio(ng)
702 END DO
703 CASE ('Dout(idsPHY)')
704 IF (idbio4(idsphy).eq.0) THEN
705 IF (master) WRITE (out,40) 'iDbio4(idsPHY)'
706 exit_flag=5
707 RETURN
708 END IF
709 npts=load_l(nval, cval, ngrids, lbio)
710 i=idbio4(idsphy)
711 DO ng=1,ngrids
712 dout(i,ng)=lbio(ng)
713 END DO
714 CASE ('Dout(idbTOT)')
715 IF (idbio4(idbtot).eq.0) THEN
716 IF (master) WRITE (out,40) 'iDbio4(idbTOT)'
717 exit_flag=5
718 RETURN
719 END IF
720 npts=load_l(nval, cval, ngrids, lbio)
721 i=idbio4(idbtot)
722 DO ng=1,ngrids
723 dout(i,ng)=lbio(ng)
724 END DO
725 CASE ('Dout(idsTOT)')
726 IF (idbio4(idstot).eq.0) THEN
727 IF (master) WRITE (out,40) 'iDbio4(idsTOT)'
728 exit_flag=5
729 RETURN
730 END IF
731 npts=load_l(nval, cval, ngrids, lbio)
732 i=idbio4(idstot)
733 DO ng=1,ngrids
734 dout(i,ng)=lbio(ng)
735 END DO
736#endif
737 END SELECT
738 END IF
739 END DO
740 10 IF (master) WRITE (out,40) line
741 exit_flag=4
742 RETURN
743 20 CONTINUE
744!
745!-----------------------------------------------------------------------
746! Initialize secondary parameters.
747!-----------------------------------------------------------------------
748!
749! Convert rates from day-1 to second-1.
750!
751 DO ng=1,ngrids
752 DO iphy=1,nphy
753 gtalg_max(iphy,ng)=gtalg_max(iphy,ng)*sec2day
754 exalg(iphy,ng)=exalg(iphy,ng)*sec2day
755 hsgrz(iphy,ng)=hsgrz(iphy,ng)*sec2day
756 ws(iphy,ng)=ws(iphy,ng)*sec2day
757 END DO
758 DO ibac=1,nbac
759 gtbac_max(ibac,ng)=gtbac_max(ibac,ng)*sec2day
760 END DO
761 DO ifec=1,nfec
762 wf(ifec,ng)=wf(ifec,ng)*sec2day
763 END DO
764 rtnit(ng)=rtnit(ng)*sec2day
765 END DO
766!
767! Calculated reciprocal phytoplankton parameters.
768!
769 DO ng=1,ngrids
770 DO iphy=1,nphy
771 IF (maxc2nalg(iphy,ng).gt.small) THEN
772 imaxc2nalg(iphy,ng)=1.0_r8/maxc2nalg(iphy,ng)
773 ELSE
774 imaxc2nalg(iphy,ng)=0.0_r8
775 END IF
776 IF (maxc2sialg(iphy,ng).gt.small) THEN
777 imaxc2sialg(iphy,ng)=1.0_r8/maxc2sialg(iphy,ng)
778 ELSE
779 imaxc2sialg(iphy,ng)=0.0_r8
780 END IF
781 IF (maxc2palg(iphy,ng).gt.small) THEN
782 imaxc2palg(iphy,ng)=1.0_r8/maxc2palg(iphy,ng)
783 ELSE
784 imaxc2palg(iphy,ng)=0.0_r8
785 END IF
786 IF (maxc2fealg(iphy,ng).gt.small) THEN
787 imaxc2fealg(iphy,ng)=1.0_r8/maxc2fealg(iphy,ng)
788 ELSE
789 imaxc2fealg(iphy,ng)=0.0_r8
790 END IF
791 END DO
792 END DO
793!
794! Calculated bacterial parameters.
795!
796 DO ng=1,ngrids
797 DO ibac=1,nbac
798 hsnh4_ba(ibac,ng)=hsdoc_ba(ibac,ng)/c2nbac(ng)
799 hspo4_ba(ibac,ng)=hsdoc_ba(ibac,ng)/c2pbac(ng)
800 hsfe_ba(ibac,ng)=hsdoc_ba(ibac,ng)/c2febac(ng)
801 END DO
802 END DO
803!
804! Inverse parameters for computational efficiency.
805!
806 DO ng=1,ngrids
807 n2cbac(ng)=1.0_r8/c2nbac(ng)
808 p2cbac(ng)=1.0_r8/c2pbac(ng)
809 fe2cbac(ng)=1.0_r8/c2febac(ng)
810 i_bac_ceff(ng)=1.0_r8/bac_ceff(ng)
811 END DO
812!
813! Reciprocal of non baterial recalcitran carbon excretion.
814!
815 DO ng=1,ngrids
816 r_exbac_c(ng)=1.0_r8/(1.0_r8-exbac_c(ng))
817 END DO
818!
819! Bacterial recalcitrant nitrogen excretion as a function of uptake.
820!
821 DO ng=1,ngrids
822 exbac_n(ng)=exbac_c(ng)*c2nbac(ng)/exbacc2n(ng)
823 frac_exbac_n(ng)=1.0_r8-exbac_n(ng)
824 END DO
825!
826! Scale UV degradation parameters.
827!
828 DO ng=1,ngrids
829 rtuvr_dic(ng)=rtuvr_dic(ng)/3600.0_r8
830 rtuvr_doc(ng)=rtuvr_doc(ng)/3600.0_r8
831 END DO
832!
833! If applicable, zero-out fecal regeneration parameters.
834!
835 DO ng=1,ngrids
836 IF (regen_flag(ng)) THEN
837 DO ifec=1,nfec
838 regcr(ifec,ng)=regcr(ifec,ng)*sec2day
839 regnr(ifec,ng)=regnr(ifec,ng)*sec2day
840 regpr(ifec,ng)=regpr(ifec,ng)*sec2day
841 regfr(ifec,ng)=regfr(ifec,ng)*sec2day
842 regsr(ifec,ng)=regsr(ifec,ng)*sec2day
843 END DO
844 ELSE
845 DO ifec=1,nfec
846 regcr(ifec,ng)=0.0_r8
847 regnr(ifec,ng)=0.0_r8
848 regpr(ifec,ng)=0.0_r8
849 regfr(ifec,ng)=0.0_r8
850 regsr(ifec,ng)=0.0_r8
851 END DO
852 END IF
853 END DO
854!
855! Spectral dependency for scattering and backscattering.
856!
857 DO iband=1,nbands
858 wavedp(iband)=(550.0_r8/(397.0_r8+real(iband,r8)*dlam))
859 END DO
860!
861! Calculated IOP parameter values.
862!
863 adoc410(ilab)=adoc(ilab,1)*exp(0.014_r8*(ec_wave_ab(1)-410.0_r8))
864 adoc410(irct)=adoc(irct,1)*exp(0.025_r8*(ec_wave_ab(1)-410.0_r8))
865 adoc300(ilab)=exp(0.0145_r8*(410.0_r8-300.0_r8))
866 adoc300(irct)=exp(0.0145_r8*(410.0_r8-300.0_r8))
867
868#if defined DIAGNOSTICS && defined DIAGNOSTICS_BIO
869!
870! Allocate center wavelenght of spectral irradiance bands for diagnostic
871! terms.
872!
873 IF (.not.allocated(dia_light)) THEN
874 allocate ( dia_light(ndbands) )
875 dmem(1)=dmem(1)+real(ndbands,r8)
876 END IF
877!
878 DO iband=1,nbands
879 dia_light(iband)=ec_wave_ab(iband)
880 END DO
881#endif
882!
883!-----------------------------------------------------------------------
884! Report input parameters.
885!-----------------------------------------------------------------------
886!
887 IF (master.and.lwrite) THEN
888 DO ng=1,ngrids
889 IF (lbiology(ng)) THEN
890 WRITE (out,50) ng
891 WRITE (out,60) bioiter(ng), 'BioIter', &
892 & 'Number of iterations for nonlinear convergence.'
893 WRITE (out,70) rtuvr_flag(ng), 'RtUVR_flag', &
894 & 'Switch to calculate CDOC UV photolysis.'
895 WRITE (out,70) nfix_flag(ng), 'NFIX_flag', &
896 & 'Switch to calculate temperature based N fixation.'
897 WRITE (out,70) regen_flag(ng), 'Regen_flag', &
898 & 'Switch to calculate fecal matter regeneration.'
899 WRITE (out,80) 'HsNO3', &
900 & 'Half-saturation for phytoplankton NO3 uptake', &
901 & '(micromole_NO3/liter):'
902 DO is=1,nphy
903 WRITE (out,90) hsno3(is,ng), trim(phyname(is))
904 END DO
905 WRITE (out,80) 'HsNH4', &
906 & 'Half-saturation for phytoplankton NH4 uptake', &
907 & '(micromole_NH4/liter):'
908 DO is=1,nphy
909 WRITE (out,90) hsnh4(is,ng), trim(phyname(is))
910 END DO
911 WRITE (out,80) 'HsSiO', &
912 & 'Half-saturation for phytoplankton SiO uptake', &
913 & '(micromole_SiO/liter):'
914 DO is=1,nphy
915 WRITE (out,90) hssio(is,ng), trim(phyname(is))
916 END DO
917 WRITE (out,80) 'HsPO4', &
918 & 'Half-saturation for phytoplankton PO4 uptake', &
919 & '(micromole_PO4/liter):'
920 DO is=1,nphy
921 WRITE (out,90) hspo4(is,ng), trim(phyname(is))
922 END DO
923 WRITE (out,80) 'HsFe', &
924 & 'Half-saturation for phytoplankton Fe uptake', &
925 & '(micromole_Fe/liter):'
926 DO is=1,nphy
927 WRITE (out,90) hsfe(is,ng), trim(phyname(is))
928 END DO
929 WRITE (out,100) 'GtALG_max', &
930 & 'Maximum 24 hour growth rate (1/day):'
931 DO is=1,nphy
932 WRITE (out,90) gtalg_max(is,ng), trim(phyname(is))
933 END DO
934 WRITE (out,80) 'PhyTbase', &
935 & 'Temperature base for exponential response to', &
936 & 'temperature (Celsius):'
937 DO is=1,nphy
938 WRITE (out,90) phytbase(is,ng), trim(phyname(is))
939 END DO
940 WRITE (out,80) 'PhyTfac', &
941 & 'Phytoplankton exponential temperature factor', &
942 & '(1/Celsius):'
943 DO is=1,nphy
944 WRITE (out,90) phytfac(is,ng), trim(phyname(is))
945 END DO
946 WRITE (out,100) 'BET_', &
947 & 'Nitrate uptake inhibition for NH4 (l/micromole):'
948 DO is=1,nphy
949 WRITE (out,90) bet_(is,ng), trim(phyname(is))
950 END DO
951 WRITE (out,80) 'maxC2nALG', &
952 & 'Maximum phytoplankton C:N ratio', &
953 & '(micromole_C/micromole_N):'
954 DO is=1,nphy
955 WRITE (out,90) maxc2nalg(is,ng), trim(phyname(is))
956 END DO
957 WRITE (out,80) 'minC2nALG', &
958 & 'Balanced phytoplankton C:N ratio', &
959 & '(micromole_C/micromole_N):'
960 DO is=1,nphy
961 WRITE (out,90) minc2nalg(is,ng), trim(phyname(is))
962 END DO
963 WRITE (out,80) 'C2nALGminABS', &
964 & 'Absolute minimum phytoplankton C:N ratio', &
965 & '(micromole_C/micromole_N):'
966 DO is=1,nphy
967 WRITE (out,90) c2nalgminabs(is,ng), trim(phyname(is))
968 END DO
969 WRITE (out,80) 'maxC2SiALG', &
970 & 'Maximum phytoplankton C:Si ratio', &
971 & '(micromole_C/micromole_Si)'
972 DO is=1,nphy
973 WRITE (out,90) maxc2sialg(is,ng), trim(phyname(is))
974 END DO
975 WRITE (out,80) 'minC2SiALG', &
976 & 'Balanced phytoplankton C:Si ratio', &
977 & '(micromole_C/micromole_Si):'
978 DO is=1,nphy
979 WRITE (out,90) minc2sialg(is,ng), trim(phyname(is))
980 END DO
981 WRITE (out,80) 'C2SiALGminABS', &
982 & 'Absolute minimum phytoplankton C:Si ratio', &
983 & '(micromole_C/micromole_Si):'
984 DO is=1,nphy
985 WRITE (out,90) c2sialgminabs(is,ng), trim(phyname(is))
986 END DO
987 WRITE (out,80) 'maxC2pALG', &
988 & 'Maximum phytoplankton C:P ratio', &
989 & '(micromole_C/micromole_P):'
990 DO is=1,nphy
991 WRITE (out,90) maxc2palg(is,ng), trim(phyname(is))
992 END DO
993 WRITE (out,80) 'minC2pALG', &
994 & 'Balanced phytoplankton C:P ratio', &
995 & '(micromole_C/micromole_P):'
996 DO is=1,nphy
997 WRITE (out,90) minc2palg(is,ng), trim(phyname(is))
998 END DO
999 WRITE (out,80) 'C2pALGminABS', &
1000 & 'Absolute minimum phytoplankton C:P ratio', &
1001 & '(micromole_C/micromole_P)'
1002 DO is=1,nphy
1003 WRITE (out,90) c2palgminabs(is,ng), trim(phyname(is))
1004 END DO
1005 WRITE (out,80) 'maxC2FeALG', &
1006 & 'Maximum phytoplankton C:Fe ratio', &
1007 & '(micromole_C/micromole_Fe):'
1008 DO is=1,nphy
1009 WRITE (out,90) maxc2fealg(is,ng), trim(phyname(is))
1010 END DO
1011 WRITE (out,80) 'minC2FeALG', &
1012 & 'Balanced phytoplankton C:Fe ratio', &
1013 & '(micromole_C/micromole_Fe):'
1014 DO is=1,nphy
1015 WRITE (out,90) minc2fealg(is,ng), trim(phyname(is))
1016 END DO
1017 WRITE (out,80) 'C2FeALGminABS', &
1018 & 'Absolute minimum phytoplankton C:Fe ratio', &
1019 & '(micromole_C/micromole_Fe):'
1020 DO is=1,nphy
1021 WRITE (out,90) c2fealgminabs(is,ng), trim(phyname(is))
1022 END DO
1023 WRITE (out,80) 'qu_yld', &
1024 & 'Maximum quantum yield', &
1025 & '(micromole_C/micromole_quanta):'
1026 DO is=1,nphy
1027 WRITE (out,90) qu_yld(is,ng), trim(phyname(is))
1028 END DO
1029 WRITE (out,100) 'E0_comp', &
1030 & 'Compensation light level (micromole_quanta):'
1031 DO is=1,nphy
1032 WRITE (out,90) e0_comp(is,ng), trim(phyname(is))
1033 END DO
1034 WRITE (out,80) 'E0_inhib', &
1035 & 'Light level for onset of photoinhibition', &
1036 & '(micromole_quanta):'
1037 DO is=1,nphy
1038 WRITE (out,90) e0_inhib(is,ng), trim(phyname(is))
1039 END DO
1040 WRITE (out,80) 'inhib_fac', &
1041 & 'Exponential decay factor for light limited growth', &
1042 & '(1/micromole_quanta):'
1043 DO is=1,nphy
1044 WRITE (out,90) inhib_fac(is,ng), trim(phyname(is))
1045 END DO
1046 WRITE (out,80) 'C2CHL_max', &
1047 & 'Maximum lighted limited C:Chl ratio', &
1048 & '(microgram_C/microgram_Chl):'
1049 DO is=1,nphy
1050 WRITE (out,90) c2chl_max(is,ng), trim(phyname(is))
1051 END DO
1052 WRITE (out,80) 'mxC2Cl', &
1053 & 'Rate of change in light limited C:Chl ratio', &
1054 & '(microgram_C/microgram_Chl/micromole_quanta):'
1055 DO is=1,nphy
1056 WRITE (out,90) mxc2cl(is,ng), trim(phyname(is))
1057 END DO
1058 WRITE (out,80) 'b_C2Cl', &
1059 & 'Minimum lighted limited C:Chl ratio', &
1060 & '(microgram_C/microgram_Chl):'
1061 DO is=1,nphy
1062 WRITE (out,90) b_c2cl(is,ng), trim(phyname(is))
1063 END DO
1064 WRITE (out,80) 'mxC2Cn', &
1065 & 'Rate of change in nutient limited C:Chl ratio', &
1066 & '[(ug_C/ug_Chl)/(umole_C/umole_N)]:'
1067 DO is=1,nphy
1068 WRITE (out,90) mxc2cn(is,ng), trim(phyname(is))
1069 END DO
1070 WRITE (out,80) 'b_C2Cn', &
1071 & 'Minimum nutrient limited C:Chl ratio', &
1072 & '(microgram_C/microgram_Chl):'
1073 DO is=1,nphy
1074 WRITE (out,90) b_c2cn(is,ng), trim(phyname(is))
1075 END DO
1076 WRITE (out,80) 'mxPacEff', &
1077 & 'Rate of change in package effect', &
1078 & '[1/(microgram_C/microgram_Chl)]:'
1079 DO is=1,nphy
1080 WRITE (out,90) mxpaceff(is,ng), trim(phyname(is))
1081 END DO
1082 WRITE (out,80) 'b_PacEff', &
1083 & 'Maximum package effect', &
1084 & '[1/(microgram_C/microgram_Chl)]:'
1085 DO is=1,nphy
1086 WRITE (out,90) b_paceff(is,ng), trim(phyname(is))
1087 END DO
1088 WRITE (out,80) 'mxChlB', &
1089 & 'Rate of change in the Chl_b:Chl_a ratio', &
1090 & '[(ug_Chl_b/ug_Chl_a)/(ug_C/ug_Chl_a)]:'
1091 DO is=1,nphy
1092 WRITE (out,90) mxchlb(is,ng), trim(phyname(is))
1093 END DO
1094 WRITE (out,80) 'b_ChlB', &
1095 & 'Maximum Chl_b:Chl_a ratio', &
1096 & '(microgram_Chl_b/microgram_Chl_a):'
1097 DO is=1,nphy
1098 WRITE (out,90) b_chlb(is,ng), trim(phyname(is))
1099 END DO
1100 WRITE (out,80) 'mxChlC', &
1101 & 'Rate of change in the Chl_c:Chl_a ratio', &
1102 & '[(ug_Chl_c/ug_Chl_a)/(ug_C/ug_Chl_a)]:'
1103 DO is=1,nphy
1104 WRITE (out,90) mxchlc(is,ng), trim(phyname(is))
1105 END DO
1106 WRITE (out,80) 'b_ChlC', &
1107 & 'Maximum Chl_c:Chl_a ratio', &
1108 & '(microgram_Chl_c/microgram_Chl_a):'
1109 DO is=1,nphy
1110 WRITE (out,90) b_chlc(is,ng), trim(phyname(is))
1111 END DO
1112 WRITE (out,80) 'mxPSC', &
1113 & 'Rate of change in the PSC:Chl_a ratio', &
1114 & '[(ug_PSC/ug_Chl_a)/ug_C/ug_Chl_a)]:'
1115 DO is=1,nphy
1116 WRITE (out,90) mxpsc(is,ng), trim(phyname(is))
1117 END DO
1118 WRITE (out,80) 'b_PSC', &
1119 & 'Maximum PSC:Chl_a ratio', &
1120 & '(microgram_PSC/microgram_Chl_a):'
1121 DO is=1,nphy
1122 WRITE (out,90) b_psc(is,ng), trim(phyname(is))
1123 END DO
1124 WRITE (out,80) 'mxPPC', &
1125 & 'Rate of change in the PPC:Chl_a ratio', &
1126 & '[(ug_PPC/ug_Chl_a)/(ug_C/ug_Chl_ a)]:'
1127 DO is=1,nphy
1128 WRITE (out,90) mxppc(is,ng), trim(phyname(is))
1129 END DO
1130 WRITE (out,80) 'b_PPC', &
1131 & 'Maximum PPC:Chl_a ratio', &
1132 & '(microgram_Chl_c/microgram_Chl_a):'
1133 DO is=1,nphy
1134 WRITE (out,90) b_ppc(is,ng), trim(phyname(is))
1135 END DO
1136 WRITE (out,80) 'mxLPUb', &
1137 & 'Rate of change in the LPUb:Chl_a ratio', &
1138 & '[(ug_LPUb/ug_Chl_a)/(ug_C/ug_Chl_a)]:'
1139 DO is=1,nphy
1140 WRITE (out,90) mxlpub(is,ng), trim(phyname(is))
1141 END DO
1142 WRITE (out,80) 'b_LPUb', &
1143 & 'Maximum LPUb:Chl_a ratio', &
1144 & '(migrogram_HPUb/microgram_Chl_a):'
1145 DO is=1,nphy
1146 WRITE (out,90) b_lpub(is,ng), trim(phyname(is))
1147 END DO
1148 WRITE (out,80) 'mxHPUb', &
1149 & 'Rate of change in the HPUb:Chl_a ratio', &
1150 & '[(ug_HPUb/ug_Chl_a)/(ug_C/ug_Chl_a)]:'
1151 DO is=1,nphy
1152 WRITE (out,90) mxhpub(is,ng), trim(phyname(is))
1153 END DO
1154 WRITE (out,80)'b_HPUb', &
1155 & 'Maximum HPUb:Chl_a ratio', &
1156 & '(microgram_HPUb/microgram_Chl_a):'
1157 DO is=1,nphy
1158 WRITE (out,90) b_hpub(is,ng), trim(phyname(is))
1159 END DO
1160 WRITE (out,80) 'FecDOC', &
1161 & 'Proportion of grazing stress apportioned to DOM', &
1162 & '(nondimensional):'
1163 DO is=1,nphy
1164 WRITE (out,90) fecdoc(is,ng), trim(phyname(is))
1165 END DO
1166 WRITE (out,80) 'FecPEL', &
1167 & 'Proportion of grazing stress apportioned to fecal', &
1168 & '(nondimensional):'
1169 DO i=1,nfec
1170 DO is=1,nphy
1171 WRITE (out,110) fecpel(is,i,ng), i, trim(phyname(is))
1172 END DO
1173 END DO
1174 WRITE (out,80) 'FecCYC', &
1175 & 'Proportion of grazing stress that is recycled', &
1176 & '(nondimensional):'
1177 DO is=1,nphy
1178 WRITE (out,90) feccyc(is,ng), trim(phyname(is))
1179 END DO
1180 WRITE (out,80) 'ExALG', &
1181 & 'Proportion of daily production lost to excretion', &
1182 & '(nondimensional):'
1183 DO is=1,nphy
1184 WRITE (out,90) exalg(is,ng), trim(phyname(is))
1185 END DO
1186 WRITE (out,100) 'WS', &
1187 & 'Phytoplankton sinking speed (meters/day):'
1188 DO is=1,nphy
1189 WRITE (out,90) ws(is,ng), trim(phyname(is))
1190 END DO
1191 WRITE (out,100) 'HsGRZ', &
1192 & 'Phytoplankton grazing parameter (nondimensional):'
1193 DO is=1,nphy
1194 WRITE (out,90) hsgrz(is,ng), trim(phyname(is))
1195 END DO
1196 WRITE (out,100) 'MinRefuge', &
1197 & 'Refuge Phytoplankton population (micromole_C/liter):'
1198 DO is=1,nphy
1199 WRITE (out,90) minrefuge(is,ng), trim(phyname(is))
1200 END DO
1201 WRITE (out,100) 'RefugeDep', &
1202 & 'Maximum Refuge Phytoplankton depth (meters):'
1203 DO is=1,nphy
1204 WRITE (out,90) refugedep(is,ng), trim(phyname(is))
1205 END DO
1206 WRITE (out,100) 'Norm_Vol', &
1207 & 'Normalized Volume factor (nondimensional):'
1208 DO is=1,nphy
1209 WRITE (out,90) norm_vol(is,ng), trim(phyname(is))
1210 END DO
1211 WRITE (out,100) 'Norm_Surf', &
1212 & 'Normalized Surface Area factor (nondimensional):'
1213 DO is=1,nphy
1214 WRITE (out,90) norm_surf(is,ng), trim(phyname(is))
1215 END DO
1216 WRITE (out,80) 'HsDOP', &
1217 & 'Half Saturation Constant for DOP uptake', &
1218 & '(micromole_DOP/liter):'
1219 DO is=1,nphy
1220 WRITE (out,90) hsdop(is,ng), trim(phyname(is))
1221 END DO
1222 WRITE (out,80) 'C2pALKPHOS', &
1223 & 'C:P ratio where DOP uptake begins', &
1224 & '(micromole_C/micromole_P):'
1225 DO is=1,nphy
1226 WRITE (out,90) c2palkphos(is,ng), trim(phyname(is))
1227 END DO
1228 WRITE (out,80) 'HsDON', &
1229 & 'Half Saturation Constant for DON uptake', &
1230 & '(micromole_DON/liter):'
1231 DO is=1,nphy
1232 WRITE (out,90) hsdon(is,ng), trim(phyname(is))
1233 END DO
1234 WRITE (out,80) 'C2nNupDON', &
1235 & 'C:N ratio where DON uptake begins', &
1236 & '(micromole_C/micromole_N):'
1237 DO is=1,nphy
1238 WRITE (out,90) c2nnupdon(is,ng), trim(phyname(is))
1239 END DO
1240 WRITE (out,80) 'HsDOC_ba', &
1241 & 'Half saturation constant for bacteria DOC uptake', &
1242 & '(micromole_DOC/liter):'
1243 DO is=1,nbac
1244 WRITE (out,90) hsdoc_ba(is,ng), trim(bacname(is))
1245 END DO
1246 WRITE (out,100) 'GtBAC_max', &
1247 & 'Maximum 24 hour bacterial growth rate (1/day):'
1248 DO is=1,nbac
1249 WRITE (out,90) gtbac_max(is,ng), trim(bacname(is))
1250 END DO
1251 WRITE (out,80) 'BacTbase', &
1252 & 'Temperature base for exponetial response to', &
1253 & 'temperature (Celsius):'
1254 DO is=1,nbac
1255 WRITE (out,90) bactbase(is,ng), trim(bacname(is))
1256 END DO
1257 WRITE (out,80) 'BacTfac', &
1258 & 'Bacteria exponential temperature factor', &
1259 & '(1/Celsius):'
1260 DO is=1,nbac
1261 WRITE (out,90) bactfac(is,ng), trim(bacname(is))
1262 END DO
1263 WRITE (out,120) c2nbac(ng), 'C2nBAC', &
1264 & 'Carbon to Nitrogen ratio of Bacteria', &
1265 & '(micromole_C/micromole_N).'
1266 WRITE (out,120) c2pbac(ng), 'C2pBAC', &
1267 & 'Carbon to Phosphorus ratio of Bacteria', &
1268 & '(micromole_C/micromole_P).'
1269 WRITE (out,120) c2febac(ng), 'C2FeBAC', &
1270 & 'Carbon to Iron ratio of Bacteria', &
1271 & '(micromole_C/micromole_Fe).'
1272 WRITE (out,120) bacdoc(ng), 'BacDOC', &
1273 & 'Proportion of bacteria grazing stress apportioned', &
1274 & 'to DOM (nondimensional).'
1275 WRITE (out,120) bacpel(ng), 'BacPEL', &
1276 & 'Proportion of bacteria grazing stress apportioned', &
1277 & 'to fecal (nondimensional).'
1278 WRITE (out,120) baccyc(ng), 'BacCYC', &
1279 & 'Proportion of bacteria grazing stress recycled', &
1280 & '(nondimensional).'
1281 WRITE (out,120) exbac_c(ng), 'ExBAC_c', &
1282 & 'Bacterial recalcitrant C excretion as proportion', &
1283 & 'of uptake (nondimensional).'
1284 WRITE (out,120) exbacc2n(ng), 'ExBacC2N', &
1285 & 'Bacterial recalcitrant excretion carbon:nitrogen', &
1286 & 'ratio (micromole_C/micromole_N).'
1287 WRITE (out,120) bac_ceff(ng), 'Bac_Ceff', &
1288 & 'Bacterial gross growth carbon efficiency', &
1289 & '(nondimensional).'
1290 WRITE (out,130) rtnit(ng), 'RtNIT', &
1291 & 'Maximum nitrification rate (1/day).'
1292 WRITE (out,120) hsnit(ng), 'HsNIT', &
1293 & 'Half saturation constant for bacteria nitrification',&
1294 & '(micromole_NH4/liter).'
1295 WRITE (out,80) 'cDOCfrac_c', &
1296 & 'Colored fraction of DOC from phytoplakton and', &
1297 & 'bacterial losses (nondimensional):'
1298 DO is=1,ndom
1299 WRITE (out,90) cdocfrac_c(is,ng), trim(domname(is))
1300 END DO
1301 WRITE (out,120) rtuvr_dic(ng), 'RtUVR_DIC', &
1302 & 'UV degradation of DOC into DIC at 410 nm', &
1303 & '(micromole/meter/liter/hour).'
1304 WRITE (out,120) rtuvr_doc(ng), 'RtUVR_DOC', &
1305 & 'UV degradation of DOC to colorless labile DOC', &
1306 & 'at 410 nm (micromole/meter/liter/hour).'
1307 WRITE (out,100) 'WF', &
1308 & 'Fecal sinking flux (meters/day):'
1309 DO is=1,nfec
1310 WRITE (out,90) wf(is,ng), trim(fecname(is))
1311 END DO
1312 WRITE (out,80) 'RegTbase', &
1313 & 'Fecal regeneration temperature base for exponential',&
1314 & 'response to temperature (Celsius):'
1315 DO is=1,nfec
1316 WRITE (out,90) regtbase(is,ng), trim(fecname(is))
1317 END DO
1318 WRITE (out,80) 'RegTfac', &
1319 & 'Fecal regeneration exponential temperature factor', &
1320 & '(1/Celsius):'
1321 DO is=1,nfec
1322 WRITE (out,90) regtfac(is,ng), trim(fecname(is))
1323 END DO
1324 WRITE (out,100) 'RegCR', &
1325 & 'Fecal carbon regeneration rate (1/day):'
1326 DO is=1,nfec
1327 WRITE (out,90) regcr(is,ng), trim(fecname(is))
1328 END DO
1329 WRITE (out,100) 'RegNR', &
1330 & 'Fecal nitrogen regeneration rate (1/day)'
1331 DO is=1,nfec
1332 WRITE (out,90) regnr(is,ng), trim(fecname(is))
1333 END DO
1334 WRITE (out,100) 'RegSR', &
1335 & 'Fecal silica regeneration rate (1/day):'
1336 DO is=1,nfec
1337 WRITE (out,90) regsr(is,ng), trim(fecname(is))
1338 END DO
1339 WRITE (out,100) 'RegPR', &
1340 & 'Fecal phosphorus regeneration rate (1/day):'
1341 DO is=1,nfec
1342 WRITE (out,90) regpr(is,ng), trim(fecname(is))
1343 END DO
1344 WRITE (out,100) 'RegFR', &
1345 & 'Fecal iron regeneration rate (1/day)'
1346 DO is=1,nfec
1347 WRITE (out,90) regfr(is,ng), trim(fecname(is))
1348 END DO
1349#ifdef TS_DIF2
1350 DO itrc=1,nbt
1351 i=idbio(itrc)
1352 WRITE (out,140) nl_tnu2(i,ng), 'nl_tnu2', i, &
1353 & 'NLM Horizontal, harmonic mixing coefficient', &
1354 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
1355# ifdef ADJOINT
1356 WRITE (out,140) ad_tnu2(i,ng), 'ad_tnu2', i, &
1357 & 'ADM Horizontal, harmonic mixing coefficient', &
1358 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
1359# endif
1360# if defined TANGENT || defined TL_IOMS
1361 WRITE (out,140) tl_tnu2(i,ng), 'tl_tnu2', i, &
1362 & 'TLM Horizontal, harmonic mixing coefficient', &
1363 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
1364# endif
1365 END DO
1366#endif
1367#ifdef TS_DIF4
1368 DO itrc=1,nbt
1369 i=idbio(itrc)
1370 WRITE (out,140) nl_tnu4(i,ng), 'nl_tnu4', i, &
1371 & 'NLM Horizontal, biharmonic mixing coefficient', &
1372 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
1373# ifdef ADJOINT
1374 WRITE (out,140) ad_tnu4(i,ng), 'ad_tnu4', i, &
1375 & 'ADM Horizontal, biharmonic mixing coefficient', &
1376 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
1377# endif
1378# if defined TANGENT || defined TL_IOMS
1379 WRITE (out,140) tl_tnu4(i,ng), 'tl_tnu4', i, &
1380 & 'TLM Horizontal, biharmonic mixing coefficient', &
1381 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
1382# endif
1383 END DO
1384#endif
1385 DO itrc=1,nbt
1386 i=idbio(itrc)
1387 IF (ltracersponge(i,ng)) THEN
1388 WRITE (out,150) ltracersponge(i,ng), 'LtracerSponge', &
1389 & i, 'Turning ON sponge on tracer ', i, &
1390 & trim(vname(1,idtvar(i)))
1391 ELSE
1392 WRITE (out,150) ltracersponge(i,ng), 'LtracerSponge', &
1393 & i, 'Turning OFF sponge on tracer ', i, &
1394 & trim(vname(1,idtvar(i)))
1395 END IF
1396 END DO
1397 DO itrc=1,nbt
1398 i=idbio(itrc)
1399 WRITE (out,140) akt_bak(i,ng), 'Akt_bak', i, &
1400 & 'Background vertical mixing coefficient (m2/s)', &
1401 & 'for tracer ', i, trim(vname(1,idtvar(i)))
1402 END DO
1403#ifdef FORWARD_MIXING
1404 DO itrc=1,nbt
1405 i=idbio(itrc)
1406# ifdef ADJOINT
1407 WRITE (out,140) ad_akt_fac(i,ng), 'ad_Akt_fac', i, &
1408 & 'ADM basic state vertical mixing scale factor', &
1409 & 'for tracer ', i, trim(vname(1,idtvar(i)))
1410# endif
1411# if defined TANGENT || defined TL_IOMS
1412 WRITE (out,140) tl_akt_fac(i,ng), 'tl_Akt_fac', i, &
1413 & 'TLM basic state vertical mixing scale factor', &
1414 & 'for tracer ', i, trim(vname(1,idtvar(i)))
1415# endif
1416 END DO
1417#endif
1418 DO itrc=1,nbt
1419 i=idbio(itrc)
1420 WRITE (out,140) tnudg(i,ng), 'Tnudg', i, &
1421 & 'Nudging/relaxation time scale (days)', &
1422 & 'for tracer ', i, trim(vname(1,idtvar(i)))
1423 END DO
1424 DO itrc=1,nbt
1425 i=idbio(itrc)
1426 IF (ltracersrc(i,ng)) THEN
1427 WRITE (out,150) ltracersrc(i,ng), 'LtracerSrc', &
1428 & i, 'Turning ON point sources/Sink on tracer ', i, &
1429 & trim(vname(1,idtvar(i)))
1430 ELSE
1431 WRITE (out,150) ltracersrc(i,ng), 'LtracerSrc', &
1432 & i, 'Turning OFF point sources/Sink on tracer ', i, &
1433 & trim(vname(1,idtvar(i)))
1434 END IF
1435 END DO
1436 DO itrc=1,nbt
1437 i=idbio(itrc)
1438 IF (ltracerclm(i,ng)) THEN
1439 WRITE (out,150) ltracerclm(i,ng), 'LtracerCLM', i, &
1440 & 'Turning ON processing of climatology tracer ', i, &
1441 & trim(vname(1,idtvar(i)))
1442 ELSE
1443 WRITE (out,150) ltracerclm(i,ng), 'LtracerCLM', i, &
1444 & 'Turning OFF processing of climatology tracer ', i, &
1445 & trim(vname(1,idtvar(i)))
1446 END IF
1447 END DO
1448 DO itrc=1,nbt
1449 i=idbio(itrc)
1450 IF (lnudgetclm(i,ng)) THEN
1451 WRITE (out,150) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
1452 & 'Turning ON nudging of climatology tracer ', i, &
1453 & trim(vname(1,idtvar(i)))
1454 ELSE
1455 WRITE (out,150) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
1456 & 'Turning OFF nudging of climatology tracer ', i, &
1457 & trim(vname(1,idtvar(i)))
1458 END IF
1459 END DO
1460 IF ((nhis(ng).gt.0).and.any(hout(:,ng))) THEN
1461 WRITE (out,'(1x)')
1462 DO itrc=1,nbt
1463 i=idbio(itrc)
1464 IF (hout(idtvar(i),ng)) WRITE (out,160) &
1465 & hout(idtvar(i),ng), 'Hout(idTvar)', &
1466 & 'Write out tracer ', i, trim(vname(1,idtvar(i)))
1467 END DO
1468 DO itrc=1,nbt
1469 i=idbio(itrc)
1470 IF (hout(idtsur(i),ng)) WRITE (out,160) &
1471 & hout(idtsur(i),ng), 'Hout(idTsur)', &
1472 & 'Write out tracer flux ', i, &
1473 & trim(vname(1,idtvar(i)))
1474 END DO
1475 END IF
1476 IF ((nqck(ng).gt.0).and.any(qout(:,ng))) THEN
1477 WRITE (out,'(1x)')
1478 DO itrc=1,nbt
1479 i=idbio(itrc)
1480 IF (qout(idtvar(i),ng)) WRITE (out,160) &
1481 & qout(idtvar(i),ng), 'Qout(idTvar)', &
1482 & 'Write out tracer ', i, trim(vname(1,idtvar(i)))
1483 END DO
1484 DO itrc=1,nbt
1485 i=idbio(itrc)
1486 IF (qout(idsurt(i),ng)) WRITE (out,160) &
1487 & qout(idsurt(i),ng), 'Qout(idsurT)', &
1488 & 'Write out surface tracer ', i, &
1489 & trim(vname(1,idtvar(i)))
1490 END DO
1491 DO itrc=1,nbt
1492 i=idbio(itrc)
1493 IF (qout(idtsur(i),ng)) WRITE (out,160) &
1494 & qout(idtsur(i),ng), 'Qout(idTsur)', &
1495 & 'Write out tracer flux ', i, &
1496 & trim(vname(1,idtvar(i)))
1497 END DO
1498 END IF
1499#if defined AVERAGES || \
1500 (defined ad_averages && defined adjoint) || \
1501 (defined rp_averages && defined tl_ioms) || \
1502 (defined tl_averages && defined tangent)
1503 IF ((navg(ng).gt.0).and.any(aout(:,ng))) THEN
1504 WRITE (out,'(1x)')
1505 DO itrc=1,nbt
1506 i=idbio(itrc)
1507 IF (aout(idtvar(i),ng)) WRITE (out,160) &
1508 & aout(idtvar(i),ng), 'Aout(idTvar)', &
1509 & 'Write out averaged tracer ', i, &
1510 & trim(vname(1,idtvar(i)))
1511 END DO
1512 DO itrc=1,nbt
1513 i=idbio(itrc)
1514 IF (aout(idttav(i),ng)) WRITE (out,160) &
1515 & aout(idttav(i),ng), 'Aout(idTTav)', &
1516 & 'Write out averaged <t*t> for tracer ', i, &
1517 & trim(vname(1,idtvar(i)))
1518 END DO
1519 DO itrc=1,nbt
1520 i=idbio(itrc)
1521 IF (aout(idutav(i),ng)) WRITE (out,160) &
1522 & aout(idutav(i),ng), 'Aout(idUTav)', &
1523 & 'Write out averaged <u*t> for tracer ', i, &
1524 & trim(vname(1,idtvar(i)))
1525 END DO
1526 DO itrc=1,nbt
1527 i=idbio(itrc)
1528 IF (aout(idvtav(i),ng)) WRITE (out,160) &
1529 & aout(idvtav(i),ng), 'Aout(idVTav)', &
1530 & 'Write out averaged <v*t> for tracer ', i, &
1531 & trim(vname(1,idtvar(i)))
1532 END DO
1533 DO itrc=1,nbt
1534 i=idbio(itrc)
1535 IF (aout(ihutav(i),ng)) WRITE (out,160) &
1536 & aout(ihutav(i),ng), 'Aout(iHUTav)', &
1537 & 'Write out averaged <Huon*t> for tracer ', i, &
1538 & trim(vname(1,idtvar(i)))
1539 END DO
1540 DO itrc=1,nbt
1541 i=idbio(itrc)
1542 IF (aout(ihvtav(i),ng)) WRITE (out,160) &
1543 & aout(ihvtav(i),ng), 'Aout(iHVTav)', &
1544 & 'Write out averaged <Hvom*t> for tracer ', i, &
1545 & trim(vname(1,idtvar(i)))
1546 END DO
1547 END IF
1548#endif
1549#ifdef DIAGNOSTICS_TS
1550 IF ((ndia(ng).gt.0).and.any(dout(:,ng))) THEN
1551 WRITE (out,'(1x)')
1552 DO i=1,nbt
1553 itrc=idbio(i)
1554 IF (dout(iddtrc(itrc,itrate),ng)) &
1555 & WRITE (out,160) .true., 'Dout(iTrate)', &
1556 & 'Write out rate of change of tracer ', itrc, &
1557 & trim(vname(1,idtvar(itrc)))
1558 END DO
1559 DO i=1,nbt
1560 itrc=idbio(i)
1561 IF (dout(iddtrc(itrc,ithadv),ng)) &
1562 & WRITE (out,160) .true., 'Dout(iThadv)', &
1563 & 'Write out horizontal advection, tracer ', itrc, &
1564 & trim(vname(1,idtvar(itrc)))
1565 END DO
1566 DO i=1,nbt
1567 itrc=idbio(i)
1568 IF (dout(iddtrc(itrc,itxadv),ng)) &
1569 & WRITE (out,160) .true., 'Dout(iTxadv)', &
1570 & 'Write out horizontal X-advection, tracer ', itrc, &
1571 & trim(vname(1,idtvar(itrc)))
1572 END DO
1573 DO i=1,nbt
1574 itrc=idbio(i)
1575 IF (dout(iddtrc(itrc,ityadv),ng)) &
1576 & WRITE (out,160) .true., 'Dout(iTyadv)', &
1577 & 'Write out horizontal Y-advection, tracer ', itrc, &
1578 & trim(vname(1,idtvar(itrc)))
1579 END DO
1580 DO i=1,nbt
1581 itrc=idbio(i)
1582 IF (dout(iddtrc(itrc,itvadv),ng)) &
1583 & WRITE (out,160) .true., 'Dout(iTvadv)', &
1584 & 'Write out vertical advection, tracer ', itrc, &
1585 & trim(vname(1,idtvar(itrc)))
1586 END DO
1587# if defined TS_DIF2 || defined TS_DIF4
1588 DO i=1,nbt
1589 itrc=idbio(i)
1590 IF (dout(iddtrc(itrc,ithdif),ng)) &
1591 & WRITE (out,160) .true., 'Dout(iThdif)', &
1592 & 'Write out horizontal diffusion, tracer ', itrc, &
1593 & trim(vname(1,idtvar(itrc)))
1594 END DO
1595 DO i=1,nbt
1596 itrc=idbio(i)
1597 IF (dout(iddtrc(i,itxdif),ng)) &
1598 & WRITE (out,160) .true., 'Dout(iTxdif)', &
1599 & 'Write out horizontal X-diffusion, tracer ', itrc, &
1600 & trim(vname(1,idtvar(itrc)))
1601 END DO
1602 DO i=1,nbt
1603 itrc=idbio(i)
1604 IF (dout(iddtrc(itrc,itydif),ng)) &
1605 & WRITE (out,160) .true., 'Dout(iTydif)', &
1606 & 'Write out horizontal Y-diffusion, tracer ', itrc, &
1607 & trim(vname(1,idtvar(itrc)))
1608 END DO
1609# if defined MIX_GEO_TS || defined MIX_ISO_TS
1610 DO i=1,nbt
1611 itrc=idbio(i)
1612 IF (dout(iddtrc(itrc,itsdif),ng)) &
1613 & WRITE (out,160) .true., 'Dout(iTsdif)', &
1614 & 'Write out horizontal S-diffusion, tracer ', itrc, &
1615 & trim(vname(1,idtvar(itrc)))
1616 END DO
1617# endif
1618# endif
1619 DO i=1,nbt
1620 itrc=idbio(i)
1621 IF (dout(iddtrc(itrc,itvdif),ng)) &
1622 & WRITE (out,160) .true., 'Dout(iTvdif)', &
1623 & 'Write out vertical diffusion, tracer ', itrc, &
1624 & trim(vname(1,idtvar(itrc)))
1625 END DO
1626 END IF
1627#endif
1628#ifdef DIAGNOSTICS_BIO
1629 IF (ndia(ng).gt.0) THEN
1630 DO itrc=1,ndbio3d
1631 i=idbio3(itrc)
1632 IF (dout(i,ng)) WRITE (out,170) &
1633 & dout(i,ng), 'Dout(iDbio3)', &
1634 & 'Write out diagnostics for', trim(vname(1,i))
1635 END DO
1636 DO itrc=1,ndbio4d
1637 i=idbio4(itrc)
1638 IF (dout(i,ng)) WRITE (out,170) &
1639 & dout(i,ng), 'Dout(iDbio4)', &
1640 & 'Write out diagnostics for', trim(vname(1,i))
1641 END DO
1642 END IF
1643#endif
1644 END IF
1645 END DO
1646 END IF
1647!
1648!-----------------------------------------------------------------------
1649! Rescale biological tracer parameters.
1650!-----------------------------------------------------------------------
1651!
1652! Take the square root of the biharmonic coefficients so it can
1653! be applied to each harmonic operator.
1654!
1655 DO ng=1,ngrids
1656 DO itrc=1,nbt
1657 i=idbio(itrc)
1658 nl_tnu4(i,ng)=sqrt(abs(nl_tnu4(i,ng)))
1659#ifdef ADJOINT
1660 ad_tnu4(i,ng)=sqrt(abs(ad_tnu4(i,ng)))
1661#endif
1662#if defined TANGENT || defined TL_IOMS
1663 tl_tnu4(i,ng)=sqrt(abs(tl_tnu4(i,ng)))
1664#endif
1665!
1666! Compute inverse nudging coefficients (1/s) used in various tasks.
1667!
1668 IF (tnudg(i,ng).gt.0.0_r8) THEN
1669 tnudg(i,ng)=1.0_r8/(tnudg(i,ng)*86400.0_r8)
1670 ELSE
1671 tnudg(i,ng)=0.0_r8
1672 END IF
1673 END DO
1674 END DO
1675
1676 30 FORMAT (/,' read_BioPar - variable info not yet loaded, ', &
1677 & a,i2.2,a)
1678 40 FORMAT (/,' read_BioPar - Error while processing line: ',/,a)
1679 50 FORMAT (/,/,' EcoSim Parameters, Grid: ',i2.2, &
1680 & /, ' ===========================',/)
1681 60 FORMAT (1x,i10,2x,a,t32,a)
1682 70 FORMAT (10x,l1,2x,a,t32,a)
1683 80 FORMAT ('...........',2x,a,t32,a,/,t34,a)
1684 90 FORMAT (1p,e11.4,t33,a)
1685 100 FORMAT ('...........',2x,a,t32,a)
1686 110 FORMAT (1p,e11.4,t33,'Fecal Group ',i1,', ',a)
1687 120 FORMAT (1p,e11.4,2x,a,t32,a,/,t34,a)
1688 130 FORMAT (1p,e11.4,2x,a,t32,a)
1689 140 FORMAT (1p,e11.4,2x,a,'(',i2.2,')',t32,a,/,t34,a,i2.2,':',1x,a)
1690 150 FORMAT (10x,l1,2x,a,'(',i2.2,')',t32,a,i2.2,':',1x,a)
1691 160 FORMAT (10x,l1,2x,a,t32,a,i2.2,':',1x,a)
1692 170 FORMAT (10x,l1,2x,a,t32,a,1x,a)
1693
1694 RETURN
1695 END SUBROUTINE read_biopar
read_biopar
subroutine read_biopar(model, inp, out, lwrite)
Definition ecosim_inp.h:2
inp_decode_mod
Definition inp_decode.F:2
mod_biology
Definition ecosim_mod.h:1
mod_eclight
Definition mod_eclight.F:2
mod_ncparam
Definition mod_ncparam.F:2
mod_parallel
Definition mod_parallel.F:2
mod_param
Definition mod_param.F:2
mod_param::nbt
integer nbt
Definition mod_param.F:509
mod_scalars
Definition mod_scalars.F:2