ROMS
Loading...
Searching...
No Matches
npzd_Franks_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 Franks et al. (1986) ecosystem model input !
11! parameters. They are specified in input script "npzd_Franks.in". !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_parallel
17 USE mod_biology
18 USE mod_ncparam
19 USE mod_scalars
20!
21 USE inp_decode_mod
22!
23 implicit none
24!
25! Imported variable declarations
26!
27 logical, intent(in) :: Lwrite
28 integer, intent(in) :: model, inp, out
29!
30! Local variable declarations.
31!
32 integer :: Npts, Nval
33 integer :: iTrcStr, iTrcEnd
34 integer :: i, ifield, igrid, itracer, itrc, ng, nline, status
35
36 logical, dimension(NBT,Ngrids) :: Ltrc
37
38 real(r8), dimension(NBT,Ngrids) :: Rbio
39
40 real(dp), dimension(nRval) :: Rval
41
42 character (len=40 ) :: KeyWord
43 character (len=256) :: line
44 character (len=256), dimension(nCval) :: Cval
45!
46!-----------------------------------------------------------------------
47! Initialize.
48!-----------------------------------------------------------------------
49!
50 igrid=1 ! nested grid counter
51 itracer=0 ! LBC tracer counter
52 itrcstr=1 ! first LBC tracer to process
53 itrcend=nbt ! last LBC tracer to process
54 nline=0 ! LBC multi-line counter
55!
56!-----------------------------------------------------------------------
57! Read in NPZD biological model (Franks et al., 1986) parameters.
58!-----------------------------------------------------------------------
59!
60#ifdef ANA_BIOLOGY
61 IF (.not.allocated(bioini)) allocate ( bioini(mt,ngrids) )
62#endif
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#ifdef ANA_BIOLOGY
73 CASE ('BioIni(iNO3_)')
74 npts=load_r(nval, rval, ngrids, bioini(ino3_,:))
75 CASE ('BioIni(iPhyt)')
76 npts=load_r(nval, rval, ngrids, bioini(iphyt,:))
77 CASE ('BioIni(iZoop)')
78 npts=load_r(nval, rval, ngrids, bioini(izoop,:))
79 CASE ('BioIni(iSDet)')
80 npts=load_r(nval, rval, ngrids, bioini(isdet,:))
81#endif
82 CASE ('K_ext')
83 npts=load_r(nval, rval, ngrids, k_ext)
84 CASE ('K_NO3')
85 npts=load_r(nval, rval, ngrids, k_no3)
86 CASE ('K_Phy')
87 npts=load_r(nval, rval, ngrids, k_phy)
88 CASE ('Vm_NO3')
89 npts=load_r(nval, rval, ngrids, vm_no3)
90 CASE ('PhyMR')
91 npts=load_r(nval, rval, ngrids, phymr)
92 CASE ('ZooGR')
93 npts=load_r(nval, rval, ngrids, zoogr)
94 CASE ('ZooMR')
95 npts=load_r(nval, rval, ngrids, zoomr)
96 CASE ('ZooMD')
97 npts=load_r(nval, rval, ngrids, zoomd)
98 CASE ('ZooGA')
99 npts=load_r(nval, rval, ngrids, zooga)
100 CASE ('ZooEC')
101 npts=load_r(nval, rval, ngrids, zooec)
102 CASE ('DetRR')
103 npts=load_r(nval, rval, ngrids, detrr)
104 CASE ('wDet')
105 npts=load_r(nval, rval, ngrids, wdet)
106 CASE ('TNU2')
107 npts=load_r(nval, rval, nbt, ngrids, rbio)
108 DO ng=1,ngrids
109 DO itrc=1,nbt
110 i=idbio(itrc)
111 nl_tnu2(i,ng)=rbio(itrc,ng)
112 END DO
113 END DO
114 CASE ('TNU4')
115 npts=load_r(nval, rval, nbt, ngrids, rbio)
116 DO ng=1,ngrids
117 DO itrc=1,nbt
118 i=idbio(itrc)
119 nl_tnu4(i,ng)=rbio(itrc,ng)
120 END DO
121 END DO
122 CASE ('ad_TNU2')
123 npts=load_r(nval, rval, nbt, ngrids, rbio)
124 DO ng=1,ngrids
125 DO itrc=1,nbt
126 i=idbio(itrc)
127 ad_tnu2(i,ng)=rbio(itrc,ng)
128 tl_tnu2(i,ng)=rbio(itrc,ng)
129 END DO
130 END DO
131 CASE ('ad_TNU4')
132 npts=load_r(nval, rval, nbt, ngrids, rbio)
133 DO ng=1,ngrids
134 DO itrc=1,nbt
135 i=idbio(itrc)
136 ad_tnu4(i,ng)=rbio(itrc,ng)
137 tl_tnu4(i,ng)=rbio(itrc,ng)
138 END DO
139 END DO
140 CASE ('LtracerSponge')
141 npts=load_l(nval, cval, nbt, ngrids, ltrc)
142 DO ng=1,ngrids
143 DO itrc=1,nbt
144 i=idbio(itrc)
145 ltracersponge(i,ng)=ltrc(itrc,ng)
146 END DO
147 END DO
148 CASE ('AKT_BAK')
149 npts=load_r(nval, rval, nbt, ngrids, rbio)
150 DO ng=1,ngrids
151 DO itrc=1,nbt
152 i=idbio(itrc)
153 akt_bak(i,ng)=rbio(itrc,ng)
154 END DO
155 END DO
156 CASE ('ad_AKT_fac')
157 npts=load_r(nval, rval, nbt, ngrids, rbio)
158 DO ng=1,ngrids
159 DO itrc=1,nbt
160 i=idbio(itrc)
161 ad_akt_fac(i,ng)=rbio(itrc,ng)
162 tl_akt_fac(i,ng)=rbio(itrc,ng)
163 END DO
164 END DO
165 CASE ('TNUDG')
166 npts=load_r(nval, rval, nbt, ngrids, rbio)
167 DO ng=1,ngrids
168 DO itrc=1,nbt
169 i=idbio(itrc)
170 tnudg(i,ng)=rbio(itrc,ng)
171 END DO
172 END DO
173 CASE ('Hadvection')
174 IF (itracer.lt.nbt) THEN
175 itracer=itracer+1
176 ELSE
177 itracer=1 ! next nested grid
178 END IF
179 itrc=idbio(itracer)
180 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
181 & itracer, idbio(itrcstr), idbio(itrcend), &
182 & vname(1,idtvar(itrc)), &
183 & hadvection)
184 CASE ('Vadvection')
185 IF (itracer.lt.nbt) THEN
186 itracer=itracer+1
187 ELSE
188 itracer=1 ! next nested grid
189 END IF
190 itrc=idbio(itracer)
191 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
192 & itracer, idbio(itrcstr), idbio(itrcend), &
193 & vname(1,idtvar(itrc)), &
194 & vadvection)
195#if defined ADJOINT || defined TANGENT || defined TL_IOMS
196 CASE ('ad_Hadvection')
197 IF (itracer.lt.nbt) THEN
198 itracer=itracer+1
199 ELSE
200 itracer=1 ! next nested grid
201 END IF
202 itrc=idbio(itracer)
203 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
204 & itracer, idbio(itrcstr), idbio(itrcend), &
205 & vname(1,idtvar(itrc)), &
206 & ad_hadvection)
207 CASE ('Vadvection')
208 IF (itracer.lt.(nbt) THEN
209 itracer=itracer+1
210 ELSE
211 itracer=1 ! next nested grid
212 END IF
213 itrc=idbio(itracer)
214 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
215 & itracer, idbio(itrcstr), idbio(itrcend), &
216 & vname(1,idtvar(itrc)), &
217 & ad_vadvection)
218#endif
219 CASE ('LBC(isTvar)')
220 IF (itracer.lt.nbt) THEN
221 itracer=itracer+1
222 ELSE
223 itracer=1 ! next nested grid
224 END IF
225 ifield=istvar(idbio(itracer))
226 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
227 & idbio(itrcstr), idbio(itrcend), &
228 & vname(1,idtvar(idbio(itracer))), lbc)
229#if defined ADJOINT || defined TANGENT || defined TL_IOMS
230 CASE ('ad_LBC(isTvar)')
231 IF (itracer.lt.nbt) THEN
232 itracer=itracer+1
233 ELSE
234 itracer=1 ! next nested grid
235 END IF
236 ifield=istvar(idbio(itracer))
237 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
238 & idbio(itrcstr), idbio(itrcend), &
239 & vname(1,idtvar(idbio(itracer))), ad_lbc)
240#endif
241 CASE ('LtracerSrc')
242 npts=load_l(nval, cval, nbt, ngrids, ltrc)
243 DO ng=1,ngrids
244 DO itrc=1,nbt
245 i=idbio(itrc)
246 ltracersrc(i,ng)=ltrc(itrc,ng)
247 END DO
248 END DO
249 CASE ('LtracerCLM')
250 npts=load_l(nval, cval, nbt, ngrids, ltrc)
251 DO ng=1,ngrids
252 DO itrc=1,nbt
253 i=idbio(itrc)
254 ltracerclm(i,ng)=ltrc(itrc,ng)
255 END DO
256 END DO
257 CASE ('LnudgeTCLM')
258 npts=load_l(nval, cval, nbt, ngrids, ltrc)
259 DO ng=1,ngrids
260 DO itrc=1,nbt
261 i=idbio(itrc)
262 lnudgetclm(i,ng)=ltrc(itrc,ng)
263 END DO
264 END DO
265 CASE ('Hout(idTvar)')
266 npts=load_l(nval, cval, nbt, ngrids, ltrc)
267 DO ng=1,ngrids
268 DO itrc=1,nbt
269 i=idtvar(idbio(itrc))
270 IF (i.eq.0) THEN
271 IF (master) WRITE (out,30) &
272 & 'idTvar(idbio(', itrc, '))'
273 exit_flag=5
274 RETURN
275 END IF
276 hout(i,ng)=ltrc(itrc,ng)
277 END DO
278 END DO
279 CASE ('Hout(idTsur)')
280 npts=load_l(nval, cval, nbt, ngrids, ltrc)
281 DO ng=1,ngrids
282 DO itrc=1,nbt
283 i=idtsur(idbio(itrc))
284 IF (i.eq.0) THEN
285 IF (master) WRITE (out,30) &
286 & 'idTsur(idbio(', itrc, '))'
287 exit_flag=5
288 RETURN
289 END IF
290 hout(i,ng)=ltrc(itrc,ng)
291 END DO
292 END DO
293 CASE ('Qout(idTvar)')
294 npts=load_l(nval, cval, nbt, ngrids, ltrc)
295 DO ng=1,ngrids
296 DO itrc=1,nbt
297 i=idtvar(idbio(itrc))
298 qout(i,ng)=ltrc(itrc,ng)
299 END DO
300 END DO
301 CASE ('Qout(idsurT)')
302 npts=load_l(nval, cval, nbt, ngrids, ltrc)
303 DO ng=1,ngrids
304 DO itrc=1,nbt
305 i=idsurt(idbio(itrc))
306 IF (i.eq.0) THEN
307 IF (master) WRITE (out,30) &
308 & 'idsurT(idbio(', itrc, '))'
309 exit_flag=5
310 RETURN
311 END IF
312 qout(i,ng)=ltrc(itrc,ng)
313 END DO
314 END DO
315 CASE ('Qout(idTsur)')
316 npts=load_l(nval, cval, nbt, ngrids, ltrc)
317 DO ng=1,ngrids
318 DO itrc=1,nbt
319 i=idtsur(idbio(itrc))
320 qout(i,ng)=ltrc(itrc,ng)
321 END DO
322 END DO
323#if defined AVERAGES || \
324 (defined ad_averages && defined adjoint) || \
325 (defined rp_averages && defined tl_ioms) || \
326 (defined tl_averages && defined tangent)
327 CASE ('Aout(idTvar)')
328 npts=load_l(nval, cval, nbt, ngrids, ltrc)
329 DO ng=1,ngrids
330 DO itrc=1,nbt
331 i=idtvar(idbio(itrc))
332 aout(i,ng)=ltrc(itrc,ng)
333 END DO
334 END DO
335 CASE ('Aout(idTTav)')
336 npts=load_l(nval, cval, nbt, ngrids, ltrc)
337 DO ng=1,ngrids
338 DO itrc=1,nbt
339 i=idttav(idbio(itrc))
340 aout(i,ng)=ltrc(itrc,ng)
341 END DO
342 END DO
343 CASE ('Aout(idUTav)')
344 npts=load_l(nval, cval, nbt, ngrids, ltrc)
345 DO ng=1,ngrids
346 DO itrc=1,nbt
347 i=idutav(idbio(itrc))
348 aout(i,ng)=ltrc(itrc,ng)
349 END DO
350 END DO
351 CASE ('Aout(idVTav)')
352 npts=load_l(nval, cval, nbt, ngrids, ltrc)
353 DO ng=1,ngrids
354 DO itrc=1,nbt
355 i=idvtav(idbio(itrc))
356 aout(i,ng)=ltrc(itrc,ng)
357 END DO
358 END DO
359 CASE ('Aout(iHUTav)')
360 npts=load_l(nval, cval, nbt, ngrids, ltrc)
361 DO ng=1,ngrids
362 DO itrc=1,nbt
363 i=ihutav(idbio(itrc))
364 aout(i,ng)=ltrc(itrc,ng)
365 END DO
366 END DO
367 CASE ('Aout(iHVTav)')
368 npts=load_l(nval, cval, nbt, ngrids, ltrc)
369 DO ng=1,ngrids
370 DO itrc=1,nbt
371 i=ihvtav(idbio(itrc))
372 aout(i,ng)=ltrc(itrc,ng)
373 END DO
374 END DO
375#endif
376#ifdef DIAGNOSTICS_TS
377 CASE ('Dout(iTrate)')
378 npts=load_l(nval, cval, nbt, ngrids, ltrc)
379 DO ng=1,ngrids
380 DO i=1,nbt
381 itrc=idbio(i)
382 dout(iddtrc(itrc,itrate),ng)=ltrc(i,ng)
383 END DO
384 END DO
385 CASE ('Dout(iThadv)')
386 npts=load_l(nval, cval, nbt, ngrids, ltrc)
387 DO ng=1,ngrids
388 DO i=1,nbt
389 itrc=idbio(i)
390 dout(iddtrc(itrc,ithadv),ng)=ltrc(i,ng)
391 END DO
392 END DO
393 CASE ('Dout(iTxadv)')
394 npts=load_l(nval, cval, nbt, ngrids, ltrc)
395 DO ng=1,ngrids
396 DO i=1,nbt
397 itrc=idbio(i)
398 dout(iddtrc(itrc,itxadv),ng)=ltrc(i,ng)
399 END DO
400 END DO
401 CASE ('Dout(iTyadv)')
402 npts=load_l(nval, cval, nbt, ngrids, ltrc)
403 DO ng=1,ngrids
404 DO i=1,nbt
405 itrc=idbio(i)
406 dout(iddtrc(itrc,ityadv),ng)=ltrc(i,ng)
407 END DO
408 END DO
409 CASE ('Dout(iTvadv)')
410 npts=load_l(nval, cval, nbt, ngrids, ltrc)
411 DO ng=1,ngrids
412 DO i=1,nbt
413 itrc=idbio(i)
414 dout(iddtrc(itrc,itvadv),ng)=ltrc(i,ng)
415 END DO
416 END DO
417# if defined TS_DIF2 || defined TS_DIF4
418 CASE ('Dout(iThdif)')
419 npts=load_l(nval, cval, nbt, ngrids, ltrc)
420 DO ng=1,ngrids
421 DO i=1,nbt
422 itrc=idbio(i)
423 dout(iddtrc(itrc,ithdif),ng)=ltrc(i,ng)
424 END DO
425 END DO
426 CASE ('Dout(iTxdif)')
427 npts=load_l(nval, cval, nbt, ngrids, ltrc)
428 DO ng=1,ngrids
429 DO i=1,nbt
430 itrc=idbio(i)
431 dout(iddtrc(itrc,itxdif),ng)=ltrc(i,ng)
432 END DO
433 END DO
434 CASE ('Dout(iTydif)')
435 npts=load_l(nval, cval, nbt, ngrids, ltrc)
436 DO ng=1,ngrids
437 DO i=1,nbt
438 itrc=idbio(i)
439 dout(iddtrc(itrc,itydif),ng)=ltrc(i,ng)
440 END DO
441 END DO
442# if defined MIX_GEO_TS || defined MIX_ISO_TS
443 CASE ('Dout(iTsdif)')
444 npts=load_l(nval, cval, nbt, ngrids, ltrc)
445 DO ng=1,ngrids
446 DO i=1,nbt
447 itrc=idbio(i)
448 dout(iddtrc(itrc,itsdif),ng)=ltrc(i,ng)
449 END DO
450 END DO
451# endif
452# endif
453 CASE ('Dout(iTvdif)')
454 npts=load_l(nval, cval, nbt, ngrids, ltrc)
455 DO ng=1,ngrids
456 DO i=1,nbt
457 itrc=idbio(i)
458 dout(iddtrc(itrc,itvdif),ng)=ltrc(i,ng)
459 END DO
460 END DO
461#endif
462 END SELECT
463 END IF
464 END DO
465 10 IF (master) WRITE (out,40) line
466 exit_flag=4
467 RETURN
468 20 CONTINUE
469!
470!-----------------------------------------------------------------------
471! Report input parameters.
472!-----------------------------------------------------------------------
473!
474 IF (master.and.lwrite) THEN
475 DO ng=1,ngrids
476 IF (lbiology(ng)) THEN
477 WRITE (out,50) ng
478 WRITE (out,60) bioiter(ng), 'BioIter', &
479 & 'Number of iterations for nonlinear convergence.'
480#ifdef ANA_BIOLOGY
481 WRITE (out,70) bioini(ino3_,ng), 'BioIni(iNO3_)', &
482 & 'Nitrate initial concentration (mmol/m3).'
483 WRITE (out,70) bioini(iphyt,ng), 'BioIni(iPhyt)', &
484 & 'Phytoplankton initial concentration (mmol/m3).'
485 WRITE (out,70) bioini(izoop,ng), 'BioIni(iZoop)', &
486 & 'Zooplankton initial concentration (mmol/m3).'
487 WRITE (out,70) bioini(isdet,ng), 'BioIni(iSDet)', &
488 & 'Small detritus initial concentration (mmol/m3).'
489#endif
490 WRITE (out,70) k_ext(ng), 'K_ext', &
491 & 'Light extinction coefficient (m-1).'
492 WRITE (out,80) k_no3(ng), 'K_NO3', &
493 & 'Inverse half-saturation for phytoplankton NO3', &
494 & 'uptake (1/(mmol m-3)).'
495 WRITE (out,80) k_phy(ng), 'K_Phy', &
496 & 'Phytoplankton saturation coefficient', &
497 & '(mmol/m3)^2.'
498 WRITE (out,70) vm_no3(ng), 'Vm_NO3', &
499 & 'Nitrate upatake rate (day-1).'
500 WRITE (out,70) phymr(ng), 'PhyMR', &
501 & 'Phytoplankton senescence/mortality rate (day-1)'
502 WRITE (out,70) zoogr(ng), 'ZooGR', &
503 & 'Zooplankton maximum growth rate (day-1).'
504 WRITE (out,70) zoomr(ng), 'ZooMR', &
505 & 'Zooplankton mortality rate (day-1).'
506 WRITE (out,70) zoomd(ng), 'ZooMD', &
507 & 'Zooplankton death bits rate (day-1).'
508 WRITE (out,70) zooga(ng), 'ZooGA', &
509 & 'Zooplankton grazing inefficiency (nondimensional).'
510 WRITE (out,70) zooec(ng), 'ZooEC', &
511 & 'Zooplankton excreted fraction (nondimensional).'
512 WRITE (out,70) detrr(ng), 'DetRR', &
513 & 'Detritus remineralization rate (day-1).'
514 WRITE (out,70) wdet(ng), 'wDet', &
515 & 'Detrital sinking rate (m/day).'
516#ifdef TS_DIF2
517 DO itrc=1,nbt
518 i=idbio(itrc)
519 WRITE (out,90) nl_tnu2(i,ng), 'nl_tnu2', i, &
520 & 'NLM Horizontal, harmonic mixing coefficient', &
521 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
522# ifdef ADJOINT
523 WRITE (out,90) ad_tnu2(i,ng), 'ad_tnu2', i, &
524 & 'ADM Horizontal, harmonic mixing coefficient', &
525 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
526# endif
527# if defined TANGENT || defined TL_IOMS
528 WRITE (out,90) tl_tnu2(i,ng), 'tl_tnu2', i, &
529 & 'TLM Horizontal, harmonic mixing coefficient', &
530 & '(m2/s) for tracer ', i, trim(vname(1,idtvar(i)))
531# endif
532 END DO
533#endif
534#ifdef TS_DIF4
535 DO itrc=1,nbt
536 i=idbio(itrc)
537 WRITE (out,90) nl_tnu4(i,ng), 'nl_tnu4', i, &
538 & 'NLM Horizontal, biharmonic mixing coefficient', &
539 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
540# ifdef ADJOINT
541 WRITE (out,90) ad_tnu4(i,ng), 'ad_tnu4', i, &
542 & 'ADM Horizontal, biharmonic mixing coefficient', &
543 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
544# endif
545# if defined TANGENT || defined TL_IOMS
546 WRITE (out,90) tl_tnu4(i,ng), 'tl_tnu4', i, &
547 & 'TLM Horizontal, biharmonic mixing coefficient', &
548 & '(m4/s) for tracer ', i, trim(vname(1,idtvar(i)))
549# endif
550 END DO
551#endif
552 DO itrc=1,nbt
553 i=idbio(itrc)
554 IF (ltracersponge(i,ng)) THEN
555 WRITE (out,100) ltracersponge(i,ng), 'LtracerSponge', &
556 & i, 'Turning ON sponge on tracer ', i, &
557 & trim(vname(1,idtvar(i)))
558 ELSE
559 WRITE (out,100) ltracersponge(i,ng), 'LtracerSponge', &
560 & i, 'Turning OFF sponge on tracer ', i, &
561 & trim(vname(1,idtvar(i)))
562 END IF
563 END DO
564 DO itrc=1,nbt
565 i=idbio(itrc)
566 WRITE(out,90) akt_bak(i,ng), 'Akt_bak', i, &
567 & 'Background vertical mixing coefficient (m2/s)', &
568 & 'for tracer ', i, trim(vname(1,idtvar(i)))
569 END DO
570#ifdef FORWARD_MIXING
571 DO itrc=1,nbt
572 i=idbio(itrc)
573# ifdef ADJOINT
574 WRITE (out,90) ad_akt_fac(i,ng), 'ad_Akt_fac', i, &
575 & 'ADM basic state vertical mixing scale factor', &
576 & 'for tracer ', i, trim(vname(1,idtvar(i)))
577# endif
578# if defined TANGENT || defined TL_IOMS
579 WRITE (out,90) tl_akt_fac(i,ng), 'tl_Akt_fac', i, &
580 & 'TLM basic state vertical mixing scale factor', &
581 & 'for tracer ', i, trim(vname(1,idtvar(i)))
582# endif
583 END DO
584#endif
585 DO itrc=1,nbt
586 i=idbio(itrc)
587 WRITE (out,90) tnudg(i,ng), 'Tnudg', i, &
588 & 'Nudging/relaxation time scale (days)', &
589 & 'for tracer ', i, trim(vname(1,idtvar(i)))
590 END DO
591 DO itrc=1,nbt
592 i=idbio(itrc)
593 IF (ltracersrc(i,ng)) THEN
594 WRITE (out,100) ltracersrc(i,ng), 'LtracerSrc', &
595 & i, 'Turning ON point sources/Sink on tracer ', i, &
596 & trim(vname(1,idtvar(i)))
597 ELSE
598 WRITE (out,100) ltracersrc(i,ng), 'LtracerSrc', &
599 & i, 'Turning OFF point sources/Sink on tracer ', i, &
600 & trim(vname(1,idtvar(i)))
601 END IF
602 END DO
603 DO itrc=1,nbt
604 i=idbio(itrc)
605 IF (ltracerclm(i,ng)) THEN
606 WRITE (out,100) ltracerclm(i,ng), 'LtracerCLM', i, &
607 & 'Turning ON processing of climatology tracer ', i, &
608 & trim(vname(1,idtvar(i)))
609 ELSE
610 WRITE (out,100) ltracerclm(i,ng), 'LtracerCLM', i, &
611 & 'Turning OFF processing of climatology tracer ', i, &
612 & trim(vname(1,idtvar(i)))
613 END IF
614 END DO
615 DO itrc=1,nbt
616 i=idbio(itrc)
617 IF (lnudgetclm(i,ng)) THEN
618 WRITE (out,100) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
619 & 'Turning ON nudging of climatology tracer ', i, &
620 & trim(vname(1,idtvar(i)))
621 ELSE
622 WRITE (out,100) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
623 & 'Turning OFF nudging of climatology tracer ', i, &
624 & trim(vname(1,idtvar(i)))
625 END IF
626 END DO
627 IF ((nhis(ng).gt.0).and.any(hout(:,ng))) THEN
628 WRITE (out,'(1x)')
629 DO itrc=1,nbt
630 i=idbio(itrc)
631 IF (hout(idtvar(i),ng)) WRITE (out,110) &
632 & hout(idtvar(i),ng), 'Hout(idTvar)', &
633 & 'Write out tracer ', i, trim(vname(1,idtvar(i)))
634 END DO
635 DO itrc=1,nbt
636 i=idbio(itrc)
637 IF (hout(idtsur(i),ng)) WRITE (out,110) &
638 & hout(idtsur(i),ng), 'Hout(idTsur)', &
639 & 'Write out tracer flux ', i, &
640 & trim(vname(1,idtvar(i)))
641 END DO
642 END IF
643 IF ((nqck(ng).gt.0).and.any(qout(:,ng))) THEN
644 WRITE (out,'(1x)')
645 DO itrc=1,nbt
646 i=idbio(itrc)
647 IF (qout(idtvar(i),ng)) WRITE (out,110) &
648 & qout(idtvar(i),ng), 'Qout(idTvar)', &
649 & 'Write out tracer ', i, trim(vname(1,idtvar(i)))
650 END DO
651 DO itrc=1,nbt
652 i=idbio(itrc)
653 IF (qout(idsurt(i),ng)) WRITE (out,110) &
654 & qout(idsurt(i),ng), 'Qout(idsurT)', &
655 & 'Write out surface tracer ', i, &
656 & trim(vname(1,idtvar(i)))
657 END DO
658 DO itrc=1,nbt
659 i=idbio(itrc)
660 IF (qout(idtsur(i),ng)) WRITE (out,110) &
661 & qout(idtsur(i),ng), 'Qout(idTsur)', &
662 & 'Write out tracer flux ', i, &
663 & trim(vname(1,idtvar(i)))
664 END DO
665 END IF
666#if defined AVERAGES || \
667 (defined ad_averages && defined adjoint) || \
668 (defined rp_averages && defined tl_ioms) || \
669 (defined tl_averages && defined tangent)
670 IF ((navg(ng).gt.0).and.any(aout(:,ng))) THEN
671 WRITE (out,'(1x)')
672 DO itrc=1,nbt
673 i=idbio(itrc)
674 IF (aout(idtvar(i),ng)) WRITE (out,110) &
675 & aout(idtvar(i),ng), 'Aout(idTvar)', &
676 & 'Write out averaged tracer ', i, &
677 & trim(vname(1,idtvar(i)))
678 END DO
679 DO itrc=1,nbt
680 i=idbio(itrc)
681 IF (aout(idttav(i),ng)) WRITE (out,110) &
682 & aout(idttav(i),ng), 'Aout(idTTav)', &
683 & 'Write out averaged <t*t> for tracer ', i, &
684 & trim(vname(1,idtvar(i)))
685 END DO
686 DO itrc=1,nbt
687 i=idbio(itrc)
688 IF (aout(idutav(i),ng)) WRITE (out,110) &
689 & aout(idutav(i),ng), 'Aout(idUTav)', &
690 & 'Write out averaged <u*t> for tracer ', i, &
691 & trim(vname(1,idtvar(i)))
692 END DO
693 DO itrc=1,nbt
694 i=idbio(itrc)
695 IF (aout(idvtav(i),ng)) WRITE (out,110) &
696 & aout(idvtav(i),ng), 'Aout(idVTav)', &
697 & 'Write out averaged <v*t> for tracer ', i, &
698 & trim(vname(1,idtvar(i)))
699 END DO
700 DO itrc=1,nbt
701 i=idbio(itrc)
702 IF (aout(ihutav(i),ng)) WRITE (out,110) &
703 & aout(ihutav(i),ng), 'Aout(iHUTav)', &
704 & 'Write out averaged <Huon*t> for tracer ', i, &
705 & trim(vname(1,idtvar(i)))
706 END DO
707 DO itrc=1,nbt
708 i=idbio(itrc)
709 IF (aout(ihvtav(i),ng)) WRITE (out,110) &
710 & aout(ihvtav(i),ng), 'Aout(iHVTav)', &
711 & 'Write out averaged <Hvom*t> for tracer ', i, &
712 & trim(vname(1,idtvar(i)))
713 END DO
714 END IF
715#endif
716#ifdef DIAGNOSTICS_TS
717 IF ((ndia(ng).gt.0).and.any(dout(:,ng))) THEN
718 WRITE (out,'(1x)')
719 DO i=1,nbt
720 itrc=idbio(i)
721 IF (dout(iddtrc(itrc,itrate),ng)) &
722 & WRITE (out,110) .true., 'Dout(iTrate)', &
723 & 'Write out rate of change of tracer ', itrc, &
724 & trim(vname(1,idtvar(itrc)))
725 END DO
726 DO i=1,nbt
727 itrc=idbio(i)
728 IF (dout(iddtrc(itrc,ithadv),ng)) &
729 & WRITE (out,110) .true., 'Dout(iThadv)', &
730 & 'Write out horizontal advection, tracer ', itrc, &
731 & trim(vname(1,idtvar(itrc)))
732 END DO
733 DO i=1,nbt
734 itrc=idbio(i)
735 IF (dout(iddtrc(itrc,itxadv),ng)) &
736 & WRITE (out,110) .true., 'Dout(iTxadv)', &
737 & 'Write out horizontal X-advection, tracer ', itrc, &
738 & trim(vname(1,idtvar(itrc)))
739 END DO
740 DO i=1,nbt
741 itrc=idbio(i)
742 IF (dout(iddtrc(itrc,ityadv),ng)) &
743 & WRITE (out,110) .true., 'Dout(iTyadv)', &
744 & 'Write out horizontal Y-advection, tracer ', itrc, &
745 & trim(vname(1,idtvar(itrc)))
746 END DO
747 DO i=1,nbt
748 itrc=idbio(i)
749 IF (dout(iddtrc(itrc,itvadv),ng)) &
750 & WRITE (out,110) .true., 'Dout(iTvadv)', &
751 & 'Write out vertical advection, tracer ', itrc, &
752 & trim(vname(1,idtvar(itrc)))
753 END DO
754# if defined TS_DIF2 || defined TS_DIF4
755 DO i=1,nbt
756 itrc=idbio(i)
757 IF (dout(iddtrc(itrc,ithdif),ng)) &
758 & WRITE (out,110) .true., 'Dout(iThdif)', &
759 & 'Write out horizontal diffusion, tracer ', itrc, &
760 & trim(vname(1,idtvar(itrc)))
761 END DO
762 DO i=1,nbt
763 itrc=idbio(i)
764 IF (dout(iddtrc(i,itxdif),ng)) &
765 & WRITE (out,110) .true., 'Dout(iTxdif)', &
766 & 'Write out horizontal X-diffusion, tracer ', itrc, &
767 & trim(vname(1,idtvar(itrc)))
768 END DO
769 DO i=1,nbt
770 itrc=idbio(i)
771 IF (dout(iddtrc(itrc,itydif),ng)) &
772 & WRITE (out,110) .true., 'Dout(iTydif)', &
773 & 'Write out horizontal Y-diffusion, tracer ', itrc, &
774 & trim(vname(1,idtvar(itrc)))
775 END DO
776# if defined MIX_GEO_TS || defined MIX_ISO_TS
777 DO i=1,nbt
778 itrc=idbio(i)
779 IF (dout(iddtrc(itrc,itsdif),ng)) &
780 & WRITE (out,110) .true., 'Dout(iTsdif)', &
781 & 'Write out horizontal S-diffusion, tracer ', itrc, &
782 & trim(vname(1,idtvar(itrc)))
783 END DO
784# endif
785# endif
786 DO i=1,nbt
787 itrc=idbio(i)
788 IF (dout(iddtrc(itrc,itvdif),ng)) &
789 & WRITE (out,110) .true., 'Dout(iTvdif)', &
790 & 'Write out vertical diffusion, tracer ', itrc, &
791 & trim(vname(1,idtvar(itrc)))
792 END DO
793 END IF
794#endif
795 END IF
796 END DO
797 END IF
798!
799!-----------------------------------------------------------------------
800! Rescale biological tracer parameters.
801!-----------------------------------------------------------------------
802!
803! Take the square root of the biharmonic coefficients so it can
804! be applied to each harmonic operator.
805!
806 DO ng=1,ngrids
807 DO itrc=1,nbt
808 i=idbio(itrc)
809 nl_tnu4(i,ng)=sqrt(abs(nl_tnu4(i,ng)))
810#ifdef ADJOINT
811 ad_tnu4(i,ng)=sqrt(abs(ad_tnu4(i,ng)))
812#endif
813#if defined TANGENT || defined TL_IOMS
814 tl_tnu4(i,ng)=sqrt(abs(tl_tnu4(i,ng)))
815#endif
816!
817! Compute inverse nudging coefficients (1/s) used in various tasks.
818!
819 IF (tnudg(i,ng).gt.0.0_r8) THEN
820 tnudg(i,ng)=1.0_r8/(tnudg(i,ng)*86400.0_r8)
821 ELSE
822 tnudg(i,ng)=0.0_r8
823 END IF
824 END DO
825 END DO
826
827 30 FORMAT (/,' read_BioPar - variable info not yet loaded, ', &
828 & a,i2.2,a)
829 40 FORMAT (/,' read_BioPar - Error while processing line: ',/,a)
830 50 FORMAT (/,/,' NPZD Model Parameters, Grid: ',i2.2, &
831 & /, ' ===============================',/)
832 60 FORMAT (1x,i10,2x,a,t32,a)
833 70 FORMAT (1p,e11.4,2x,a,t32,a)
834 80 FORMAT (1p,e11.4,2x,a,t32,a,/,t34,a)
835 90 FORMAT (1p,e11.4,2x,a,'(',i2.2,')',t32,a,/,t34,a,i2.2,':',1x,a)
836 100 FORMAT (10x,l1,2x,a,'(',i2.2,')',t32,a,i2.2,':',1x,a)
837 110 FORMAT (10x,l1,2x,a,t32,a,i2.2,':',1x,a)
838
839 RETURN
840 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_biology::bioini
real(r8), dimension(:,:), allocatable bioini
Definition npzd_Franks_mod.h:49
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_param::ngrids
integer ngrids
Definition mod_param.F:113
mod_param::mt
integer mt
Definition mod_param.F:490
mod_scalars
Definition mod_scalars.F:2