ROMS
Loading...
Searching...
No Matches
sediment_inp.h
Go to the documentation of this file.
1 SUBROUTINE read_sedpar (model, inp, out, Lwrite)
2!
3!git $Id$
4!=======================================================================
5! !
6! This routine reads in cohesive and non-cohesive sediment model !
7! parameters. !
8! !
9!=======================================================================
10!
11 USE mod_param
12 USE mod_parallel
13 USE mod_ncparam
14 USE mod_scalars
15 USE mod_sediment
16!
17 USE inp_decode_mod
18!
19 implicit none
20!
21! Imported variable declarations
22!
23 logical, intent(in) :: Lwrite
24 integer, intent(in) :: model, inp, out
25!
26! Local variable declarations.
27!
28 integer :: Npts, Nval
29 integer :: iTrcStr, iTrcEnd
30 integer :: i, ifield, igrid, itracer, itrc, ng, nline, status
31
32 logical, dimension(Ngrids) :: Lbed
33 logical, dimension(Ngrids) :: Lbottom
34 logical, dimension(NCS,Ngrids) :: Lmud
35 logical, dimension(NNS,Ngrids) :: Lsand
36
37 real(r8), dimension(Ngrids) :: Rbed
38 real(r8), dimension(NCS,Ngrids) :: Rmud
39 real(r8), dimension(NNS,Ngrids) :: Rsand
40
41 real(dp), dimension(nRval) :: Rval
42
43 character (len=40 ) :: KeyWord
44 character (len=256) :: line
45 character (len=256), dimension(nCval) :: Cval
46!
47!-----------------------------------------------------------------------
48! Initialize.
49!-----------------------------------------------------------------------
50!
51 igrid=1 ! nested grid counter
52 itracer=0 ! LBC tracer counter
53 itrcstr=1 ! first LBC tracer to process
54 itrcend=nst ! last LBC tracer to process
55 nline=0 ! LBC multi-line counter
56!
57!-----------------------------------------------------------------------
58! Read in cohesive and non-cohesive model parameters.
59!-----------------------------------------------------------------------
60!
61 DO WHILE (.true.)
62 READ (inp,'(a)',err=10,END=20) line
63 status=decode_line(line, keyword, nval, cval, rval)
64 IF (status.gt.0) THEN
65 SELECT CASE (trim(keyword))
66 CASE ('Lsediment')
67 npts=load_l(nval, cval, ngrids, lsediment)
68 CASE ('NEWLAYER_THICK')
69 npts=load_r(nval, rval, ngrids, rbed)
70 DO ng=1,ngrids
71 newlayer_thick(ng)=rbed(ng)
72 END DO
73 CASE ('MINLAYER_THICK')
74 npts=load_r(nval, rval, ngrids, rbed)
75 DO ng=1,ngrids
76 minlayer_thick(ng)=rbed(ng)
77 END DO
78#ifdef MIXED_BED
79 CASE ('TRANSC')
80 npts=load_r(nval, rval, ngrids, rbed)
81 DO ng=1,ngrids
82 transc(ng)=rbed(ng)
83 END DO
84 CASE ('TRANSN')
85 npts=load_r(nval, rval, ngrids, rbed)
86 DO ng=1,ngrids
87 transn(ng)=rbed(ng)
88 END DO
89#endif
90 CASE ('BEDLOAD_COEFF')
91 npts=load_r(nval, rval, ngrids, rbed)
92 DO ng=1,ngrids
93 bedload_coeff(ng)=rbed(ng)
94 END DO
95 CASE ('Hadvection')
96 IF (itracer.lt.nst) THEN
97 itracer=itracer+1
98 ELSE
99 itracer=1 ! next nested grid
100 END IF
101 itrc=idsed(itracer)
102 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
103 & itracer, idsed(itrcstr), idsed(itrcend), &
104 & vname(1,idtvar(itrc)), &
105 & hadvection)
106 CASE ('Vadvection')
107 IF (itracer.lt.nst) THEN
108 itracer=itracer+1
109 ELSE
110 itracer=1 ! next nested grid
111 END IF
112 itrc=idsed(itracer)
113 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
114 & itracer, idsed(itrcstr), idsed(itrcend), &
115 & vname(1,idtvar(itrc)), &
116 & vadvection)
117#if defined ADJOINT || defined TANGENT || defined TL_IOMS
118 CASE ('ad_Hadvection')
119 IF (itracer.lt.nst) THEN
120 itracer=itracer+1
121 ELSE
122 itracer=1 ! next nested grid
123 END IF
124 itrc=idsed(itracer)
125 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
126 & itracer, idsed(itrcstr), idsed(itrcend), &
127 & vname(1,idtvar(itrc)), &
128 & ad_hadvection)
129 CASE ('Vadvection')
130 IF (itracer.lt.(nst) THEN
131 itracer=itracer+1
132 ELSE
133 itracer=1 ! next nested grid
134 END IF
135 itrc=idsed(itracer)
136 npts=load_tadv(nval, cval, line, nline, itrc, igrid, &
137 & itracer, idsed(itrcstr), idsed(itrcend), &
138 & vname(1,idtvar(itrc)), &
139 & ad_vadvection)
140#endif
141 CASE ('LBC(isTvar)')
142 IF (itracer.lt.nst) THEN
143 itracer=itracer+1
144 ELSE
145 itracer=1 ! next nested grid
146 END IF
147 ifield=istvar(idsed(itracer))
148 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
149 & idsed(itrcstr), idsed(itrcend), &
150 & vname(1,idtvar(idsed(itracer))), lbc)
151#if defined ADJOINT || defined TANGENT || defined TL_IOMS
152 CASE ('ad_LBC(isTvar)')
153 IF (itracer.lt.nst) THEN
154 itracer=itracer+1
155 ELSE
156 itracer=1 ! next nested grid
157 END IF
158 ifield=istvar(idsed(itracer))
159 npts=load_lbc(nval, cval, line, nline, ifield, igrid, &
160 & idsed(itrcstr), idsed(itrcend), &
161 & vname(1,idtvar(idsed(itracer))), ad_lbc)
162#endif
163 CASE ('MUD_SD50')
164 IF (.not.allocated(sd50)) allocate (sd50(nst,ngrids))
165 npts=load_r(nval, rval, ncs, ngrids, rmud)
166 DO ng=1,ngrids
167 DO itrc=1,ncs
168 sd50(itrc,ng)=rmud(itrc,ng)
169 END DO
170 END DO
171 CASE ('MUD_CSED')
172 IF (.not.allocated(csed)) allocate (csed(nst,ngrids))
173 npts=load_r(nval, rval, ncs, ngrids, rmud )
174 DO ng=1,ngrids
175 DO itrc=1,ncs
176 csed(itrc,ng)=rmud(itrc,ng)
177 END DO
178 END DO
179 CASE ('MUD_SRHO')
180 IF (.not.allocated(srho)) allocate (srho(nst,ngrids))
181 npts=load_r(nval, rval, ncs, ngrids, rmud)
182 DO ng=1,ngrids
183 DO itrc=1,ncs
184 srho(itrc,ng)=rmud(itrc,ng)
185 END DO
186 END DO
187 CASE ('MUD_WSED')
188 IF (.not.allocated(wsed)) allocate (wsed(nst,ngrids))
189 npts=load_r(nval, rval, ncs, ngrids, rmud)
190 DO ng=1,ngrids
191 DO itrc=1,ncs
192 wsed(itrc,ng)=rmud(itrc,ng)
193 END DO
194 END DO
195 CASE ('MUD_ERATE')
196 IF (.not.allocated(erate)) allocate (erate(nst,ngrids))
197 npts=load_r(nval, rval, ncs, ngrids, rmud)
198 DO ng=1,ngrids
199 DO itrc=1,ncs
200 erate(itrc,ng)=rmud(itrc,ng)
201 END DO
202 END DO
203 CASE ('MUD_TAU_CE')
204 IF (.not.allocated(tau_ce)) allocate (tau_ce(nst,ngrids))
205 npts=load_r(nval, rval, ncs, ngrids, rmud)
206 DO ng=1,ngrids
207 DO itrc=1,ncs
208 tau_ce(itrc,ng)=rmud(itrc,ng)
209 END DO
210 END DO
211 CASE ('MUD_TAU_CD')
212 IF (.not.allocated(tau_cd)) allocate (tau_cd(nst,ngrids))
213 npts=load_r(nval, rval, ncs, ngrids, rmud)
214 DO ng=1,ngrids
215 DO itrc=1,ncs
216 tau_cd(itrc,ng)=rmud(itrc,ng)
217 END DO
218 END DO
219 CASE ('MUD_POROS')
220 IF (.not.allocated(poros)) allocate (poros(nst,ngrids))
221 npts=load_r(nval, rval, ncs, ngrids, rmud)
222 DO ng=1,ngrids
223 DO itrc=1,ncs
224 poros(itrc,ng)=rmud(itrc,ng)
225 END DO
226 END DO
227 CASE ('MUD_TNU2')
228 npts=load_r(nval, rval, ncs, ngrids, rmud)
229 DO ng=1,ngrids
230 DO itrc=1,ncs
231 i=idsed(itrc)
232 nl_tnu2(i,ng)=rmud(itrc,ng)
233 END DO
234 END DO
235 CASE ('MUD_TNU4')
236 npts=load_r(nval, rval, ncs, ngrids, rmud)
237 DO ng=1,ngrids
238 DO itrc=1,ncs
239 i=idsed(itrc)
240 nl_tnu4(i,ng)=rmud(itrc,ng)
241 END DO
242 END DO
243 CASE ('ad_MUD_TNU2')
244 npts=load_r(nval, rval, ncs, ngrids, rmud)
245 DO ng=1,ngrids
246 DO itrc=1,ncs
247 i=idsed(itrc)
248 ad_tnu2(i,ng)=rmud(itrc,ng)
249 tl_tnu2(i,ng)=rmud(itrc,ng)
250 END DO
251 END DO
252 CASE ('ad_MUD_TNU4')
253 npts=load_r(nval, rval, ncs, ngrids, rmud)
254 DO ng=1,ngrids
255 DO itrc=1,ncs
256 i=idsed(itrc)
257 ad_tnu4(i,ng)=rmud(itrc,ng)
258 tl_tnu4(i,ng)=rmud(itrc,ng)
259 END DO
260 END DO
261 CASE ('MUD_Sponge')
262 npts=load_l(nval, cval, ncs, ngrids, lmud)
263 DO ng=1,ngrids
264 DO itrc=1,ncs
265 i=idsed(itrc)
266 ltracersponge(i,ng)=lmud(itrc,ng)
267 END DO
268 END DO
269 CASE ('MUD_AKT_BAK')
270 npts=load_r(nval, rval, ncs, ngrids, rmud)
271 DO ng=1,ngrids
272 DO itrc=1,ncs
273 i=idsed(itrc)
274 akt_bak(i,ng)=rmud(itrc,ng)
275 END DO
276 END DO
277 CASE ('MUD_AKT_fac')
278 npts=load_r(nval, rval, ncs, ngrids, rmud)
279 DO ng=1,ngrids
280 DO itrc=1,ncs
281 i=idsed(itrc)
282 ad_akt_fac(i,ng)=rmud(itrc,ng)
283 tl_akt_fac(i,ng)=rmud(itrc,ng)
284 END DO
285 END DO
286 CASE ('MUD_TNUDG')
287 npts=load_r(nval, rval, ncs, ngrids, rmud)
288 DO ng=1,ngrids
289 DO itrc=1,ncs
290 i=idsed(itrc)
291 tnudg(i,ng)=rmud(itrc,ng)
292 END DO
293 END DO
294 CASE ('MUD_MORPH_FAC')
295 IF (.not.allocated(morph_fac)) THEN
296 allocate (morph_fac(nst,ngrids))
297 END IF
298 npts=load_r(nval, rval, ncs, ngrids, rmud)
299 DO ng=1,ngrids
300 DO itrc=1,ncs
301 morph_fac(itrc,ng)=rmud(itrc,ng)
302 END DO
303 END DO
304#if defined COHESIVE_BED || defined MIXED_BED
305 CASE ('MUD_TAUCR_MIN')
306 npts=load_r(nval, rval, ngrids, rbed)
307 DO ng=1,ngrids
308 tcr_min(ng)=rbed(ng)
309 END DO
310 CASE ('MUD_TAUCR_MAX')
311 npts=load_r(nval, rval, ngrids, rbed)
312 DO ng=1,ngrids
313 tcr_max(ng)=rbed(ng)
314 END DO
315 CASE ('MUD_TAUCR_SLOPE')
316 npts=load_r(nval, rval, ngrids, rbed)
317 DO ng=1,ngrids
318 tcr_slp(ng)=rbed(ng)
319 END DO
320 CASE ('MUD_TAUCR_OFF')
321 npts=load_r(nval, rval, ngrids, rbed)
322 DO ng=1,ngrids
323 tcr_off(ng)=rbed(ng)
324 END DO
325 CASE ('MUD_TAUCR_TIME')
326 npts=load_r(nval, rval, ngrids, rbed)
327 DO ng=1,ngrids
328 tcr_tim(ng)=rbed(ng)
329 END DO
330#endif
331 CASE ('MUD_Ltsrc', 'MUD_Ltracer')
332 npts=load_l(nval, cval, ncs, ngrids, lmud)
333 DO ng=1,ngrids
334 DO itrc=1,ncs
335 i=idsed(itrc)
336 ltracersrc(i,ng)=lmud(itrc,ng)
337 END DO
338 END DO
339 CASE ('MUD_Ltclm')
340 npts=load_l(nval, cval, ncs, ngrids, lmud)
341 DO ng=1,ngrids
342 DO itrc=1,ncs
343 i=idsed(itrc)
344 ltracerclm(i,ng)=lmud(itrc,ng)
345 END DO
346 END DO
347 CASE ('MUD_Tnudge')
348 npts=load_l(nval, cval, ncs, ngrids, lmud)
349 DO ng=1,ngrids
350 DO itrc=1,ncs
351 i=idsed(itrc)
352 lnudgetclm(i,ng)=lmud(itrc,ng)
353 END DO
354 END DO
355 CASE ('Hout(idmud)')
356 npts=load_l(nval, cval, ncs, ngrids, lmud)
357 DO ng=1,ngrids
358 DO itrc=1,ncs
359 i=idtvar(idsed(itrc))
360 hout(i,ng)=lmud(itrc,ng)
361 END DO
362 END DO
363 CASE ('Hout(iMfrac)')
364 npts=load_l(nval, cval, ncs, ngrids, lmud)
365 DO ng=1,ngrids
366 DO itrc=1,ncs
367 i=idfrac(itrc)
368 hout(i,ng)=lmud(itrc,ng)
369 END DO
370 END DO
371 CASE ('Hout(iMmass)')
372 npts=load_l(nval, cval, ncs, ngrids, lmud)
373 DO ng=1,ngrids
374 DO itrc=1,ncs
375 i=idbmas(itrc)
376 hout(i,ng)=lmud(itrc,ng)
377 END DO
378 END DO
379#ifdef BEDLOAD
380 CASE ('Hout(iMUbld)')
381 DO ng=1,ngrids
382 DO itrc=1,ncs
383 IF (idubld(itrc).eq.0) THEN
384 IF (master) WRITE (out,30) 'idUbld'
385 exit_flag=5
386 RETURN
387 END IF
388 END DO
389 END DO
390 npts=load_l(nval, cval, ncs, ngrids, lmud)
391 DO ng=1,ngrids
392 DO itrc=1,ncs
393 i=idubld(itrc)
394 hout(i,ng)=lmud(itrc,ng)
395 END DO
396 END DO
397 CASE ('Hout(iMVbld)')
398 DO ng=1,ngrids
399 DO itrc=1,ncs
400 IF (idvbld(itrc).eq.0) THEN
401 IF (master) WRITE (out,30) 'idVbld'
402 exit_flag=5
403 RETURN
404 END IF
405 END DO
406 END DO
407 npts=load_l(nval, cval, ncs, ngrids, lmud)
408 DO ng=1,ngrids
409 DO itrc=1,ncs
410 i=idvbld(itrc)
411 hout(i,ng)=lmud(itrc,ng)
412 END DO
413 END DO
414#endif
415 CASE ('Qout(idmud)')
416 npts=load_l(nval, cval, ncs, ngrids, lmud)
417 DO ng=1,ngrids
418 DO itrc=1,ncs
419 i=idtvar(idsed(itrc))
420 qout(i,ng)=lmud(itrc,ng)
421 END DO
422 END DO
423 CASE ('Qout(iSmud)')
424 npts=load_l(nval, cval, ncs, ngrids, lmud)
425 DO ng=1,ngrids
426 DO itrc=1,ncs
427 i=idsurt(idsed(itrc))
428 qout(i,ng)=lmud(itrc,ng)
429 END DO
430 END DO
431 CASE ('Qout(iMfrac)')
432 npts=load_l(nval, cval, ncs, ngrids, lmud)
433 DO ng=1,ngrids
434 DO itrc=1,ncs
435 i=idfrac(itrc)
436 qout(i,ng)=lmud(itrc,ng)
437 END DO
438 END DO
439 CASE ('Qout(iMmass)')
440 npts=load_l(nval, cval, ncs, ngrids, lmud)
441 DO ng=1,ngrids
442 DO itrc=1,ncs
443 i=idbmas(itrc)
444 qout(i,ng)=lmud(itrc,ng)
445 END DO
446 END DO
447#ifdef BEDLOAD
448 CASE ('Qout(iMUbld)')
449 npts=load_l(nval, cval, ncs, ngrids, lmud)
450 DO ng=1,ngrids
451 DO itrc=1,ncs
452 i=idubld(itrc)
453 qout(i,ng)=lmud(itrc,ng)
454 END DO
455 END DO
456 CASE ('Qout(iMVbld)')
457 npts=load_l(nval, cval, ncs, ngrids, lmud)
458 DO ng=1,ngrids
459 DO itrc=1,ncs
460 i=idvbld(itrc)
461 qout(i,ng)=lmud(itrc,ng)
462 END DO
463 END DO
464#endif
465#if defined AVERAGES || \
466 (defined ad_averages && defined adjoint) || \
467 (defined rp_averages && defined tl_ioms) || \
468 (defined tl_averages && defined tangent)
469 CASE ('Aout(idmud)')
470 npts=load_l(nval, cval, ncs, ngrids, lmud)
471 DO ng=1,ngrids
472 DO itrc=1,ncs
473 i=idtvar(idsed(itrc))
474 aout(i,ng)=lmud(itrc,ng)
475 END DO
476 END DO
477 CASE ('Aout(iMTTav)')
478 npts=load_l(nval, cval, ncs, ngrids, lmud)
479 DO ng=1,ngrids
480 DO itrc=1,ncs
481 i=idttav(idsed(itrc))
482 aout(i,ng)=lmud(itrc,ng)
483 END DO
484 END DO
485 CASE ('Aout(iMUTav)')
486 npts=load_l(nval, cval, ncs, ngrids, lmud)
487 DO ng=1,ngrids
488 DO itrc=1,ncs
489 i=idutav(idsed(itrc))
490 aout(i,ng)=lmud(itrc,ng)
491 END DO
492 END DO
493 CASE ('Aout(iMVTav)')
494 npts=load_l(nval, cval, ncs, ngrids, lmud)
495 DO ng=1,ngrids
496 DO itrc=1,ncs
497 i=idvtav(idsed(itrc))
498 aout(i,ng)=lmud(itrc,ng)
499 END DO
500 END DO
501 CASE ('Aout(MHUTav)')
502 npts=load_l(nval, cval, ncs, ngrids, lmud)
503 DO ng=1,ngrids
504 DO itrc=1,ncs
505 i=ihutav(idsed(itrc))
506 aout(i,ng)=lmud(itrc,ng)
507 END DO
508 END DO
509 CASE ('Aout(MHVTav)')
510 npts=load_l(nval, cval, ncs, ngrids, lmud)
511 DO ng=1,ngrids
512 DO itrc=1,ncs
513 i=ihvtav(idsed(itrc))
514 aout(i,ng)=lmud(itrc,ng)
515 END DO
516 END DO
517# ifdef BEDLOAD
518 CASE ('Aout(iMUbld)')
519 npts=load_l(nval, cval, ncs, ngrids, lmud)
520 DO ng=1,ngrids
521 DO itrc=1,ncs
522 i=idubld(itrc)
523 aout(i,ng)=lmud(itrc,ng)
524 END DO
525 END DO
526 CASE ('Aout(iMVbld)')
527 npts=load_l(nval, cval, ncs, ngrids, lmud)
528 DO ng=1,ngrids
529 DO itrc=1,ncs
530 i=idvbld(itrc)
531 aout(i,ng)=lmud(itrc,ng)
532 END DO
533 END DO
534# endif
535#endif
536#ifdef DIAGNOSTICS_TS
537 CASE ('Dout(MTrate)')
538 npts=load_l(nval, cval, ncs, ngrids, lmud)
539 DO ng=1,ngrids
540 DO i=1,ncs
541 itrc=idsed(i)
542 dout(iddtrc(itrc,itrate),ng)=lmud(i,ng)
543 END DO
544 END DO
545 CASE ('Dout(MThadv)')
546 npts=load_l(nval, cval, ncs, ngrids, lmud)
547 DO ng=1,ngrids
548 DO i=1,ncs
549 itrc=idsed(i)
550 dout(iddtrc(itrc,ithadv),ng)=lmud(i,ng)
551 END DO
552 END DO
553 CASE ('Dout(MTxadv)')
554 npts=load_l(nval, cval, ncs, ngrids, lmud)
555 DO ng=1,ngrids
556 DO i=1,ncs
557 itrc=idsed(i)
558 dout(iddtrc(itrc,itxadv),ng)=lmud(i,ng)
559 END DO
560 END DO
561 CASE ('Dout(MTyadv)')
562 npts=load_l(nval, cval, ncs, ngrids, lmud)
563 DO ng=1,ngrids
564 DO i=1,ncs
565 itrc=idsed(i)
566 dout(iddtrc(itrc,ityadv),ng)=lmud(i,ng)
567 END DO
568 END DO
569 CASE ('Dout(MTvadv)')
570 npts=load_l(nval, cval, ncs, ngrids, lmud)
571 DO ng=1,ngrids
572 DO i=1,ncs
573 itrc=idsed(i)
574 dout(iddtrc(itrc,itvadv),ng)=lmud(i,ng)
575 END DO
576 END DO
577# if defined TS_DIF2 || defined TS_DIF4
578 CASE ('Dout(MThdif)')
579 npts=load_l(nval, cval, ncs, ngrids, lmud)
580 DO ng=1,ngrids
581 DO i=1,ncs
582 itrc=idsed(i)
583 dout(iddtrc(itrc,ithdif),ng)=lmud(i,ng)
584 END DO
585 END DO
586 CASE ('Dout(MTxdif)')
587 npts=load_l(nval, cval, ncs, ngrids, lmud)
588 DO ng=1,ngrids
589 DO i=1,ncs
590 itrc=idsed(i)
591 dout(iddtrc(itrc,itxdif),ng)=lmud(i,ng)
592 END DO
593 END DO
594 CASE ('Dout(MTydif)')
595 npts=load_l(nval, cval, ncs, ngrids, lmud)
596 DO ng=1,ngrids
597 DO i=1,ncs
598 itrc=idsed(i)
599 dout(iddtrc(itrc,itydif),ng)=lmud(i,ng)
600 END DO
601 END DO
602# if defined MIX_GEO_TS || defined MIX_ISO_TS
603 CASE ('Dout(MTsdif)')
604 npts=load_l(nval, cval, ncs, ngrids, lmud)
605 DO ng=1,ngrids
606 DO i=1,ncs
607 itrc=idsed(i)
608 dout(iddtrc(itrc,itsdif),ng)=lmud(i,ng)
609 END DO
610 END DO
611# endif
612# endif
613 CASE ('Dout(MTvdif)')
614 npts=load_l(nval, cval, ncs, ngrids, lmud)
615 DO ng=1,ngrids
616 DO i=1,ncs
617 itrc=idsed(i)
618 dout(iddtrc(itrc,itvdif),ng)=lmud(i,ng)
619 END DO
620 END DO
621#endif
622 CASE ('SAND_SD50')
623 IF (.not.allocated(sd50)) allocate (sd50(nst,ngrids))
624 npts=load_r(nval, rval, nns, ngrids, rsand)
625 DO ng=1,ngrids
626 DO itrc=1,nns
627 i=ncs+itrc
628 sd50(i,ng)=rsand(itrc,ng)
629 END DO
630 END DO
631 CASE ('SAND_CSED')
632 IF (.not.allocated(csed)) allocate (csed(nst,ngrids))
633 npts=load_r(nval, rval, nns, ngrids, rsand )
634 DO ng=1,ngrids
635 DO itrc=1,nns
636 i=ncs+itrc
637 csed(i,ng)=rsand(itrc,ng)
638 END DO
639 END DO
640 CASE ('SAND_SRHO')
641 IF (.not.allocated(srho)) allocate (srho(nst,ngrids))
642 npts=load_r(nval, rval, nns, ngrids, rsand)
643 DO ng=1,ngrids
644 DO itrc=1,nns
645 i=ncs+itrc
646 srho(i,ng)=rsand(itrc,ng)
647 END DO
648 END DO
649 CASE ('SAND_WSED')
650 IF (.not.allocated(wsed)) allocate (wsed(nst,ngrids))
651 npts=load_r(nval, rval, nns, ngrids, rsand)
652 DO ng=1,ngrids
653 DO itrc=1,nns
654 i=ncs+itrc
655 wsed(i,ng)=rsand(itrc,ng)
656 END DO
657 END DO
658 CASE ('SAND_ERATE')
659 IF (.not.allocated(erate)) allocate (erate(nst,ngrids))
660 npts=load_r(nval, rval, nns, ngrids, rsand)
661 DO ng=1,ngrids
662 DO itrc=1,nns
663 i=ncs+itrc
664 erate(i,ng)=rsand(itrc,ng)
665 END DO
666 END DO
667 CASE ('SAND_TAU_CE')
668 IF (.not.allocated(tau_ce)) allocate (tau_ce(nst,ngrids))
669 npts=load_r(nval, rval, nns, ngrids, rsand)
670 DO ng=1,ngrids
671 DO itrc=1,nns
672 i=ncs+itrc
673 tau_ce(i,ng)=rsand(itrc,ng)
674 END DO
675 END DO
676 CASE ('SAND_TAU_CD')
677 IF (.not.allocated(tau_cd)) allocate (tau_cd(nst,ngrids))
678 npts=load_r(nval, rval, nns, ngrids, rsand)
679 DO ng=1,ngrids
680 DO itrc=1,nns
681 i=ncs+itrc
682 tau_cd(i,ng)=rsand(itrc,ng)
683 END DO
684 END DO
685 CASE ('SAND_POROS')
686 IF (.not.allocated(poros)) allocate (poros(nst,ngrids))
687 npts=load_r(nval, rval, nns, ngrids, rsand)
688 DO ng=1,ngrids
689 DO itrc=1,nns
690 i=ncs+itrc
691 poros(i,ng)=rsand(itrc,ng)
692 END DO
693 END DO
694 CASE ('SAND_TNU2')
695 npts=load_r(nval, rval, nns, ngrids, rsand)
696 DO ng=1,ngrids
697 DO itrc=1,nns
698 i=idsed(ncs+itrc)
699 nl_tnu2(i,ng)=rsand(itrc,ng)
700 END DO
701 END DO
702 CASE ('SAND_TNU4')
703 npts=load_r(nval, rval, nns, ngrids, rsand)
704 DO ng=1,ngrids
705 DO itrc=1,nns
706 i=idsed(ncs+itrc)
707 nl_tnu4(i,ng)=rsand(itrc,ng)
708 END DO
709 END DO
710 CASE ('ad_SAND_TNU2')
711 npts=load_r(nval, rval, nns, ngrids, rsand)
712 DO ng=1,ngrids
713 DO itrc=1,nns
714 i=idsed(ncs+itrc)
715 ad_tnu2(i,ng)=rsand(itrc,ng)
716 tl_tnu2(i,ng)=rsand(itrc,ng)
717 END DO
718 END DO
719 CASE ('ad_SAND_TNU4')
720 npts=load_r(nval, rval, nns, ngrids, rsand)
721 DO ng=1,ngrids
722 DO itrc=1,nns
723 i=idsed(ncs+itrc)
724 ad_tnu4(i,ng)=rsand(itrc,ng)
725 tl_tnu4(i,ng)=rsand(itrc,ng)
726 END DO
727 END DO
728 CASE ('SAND_Sponge')
729 npts=load_l(nval, cval, nns, ngrids, lsand)
730 DO ng=1,ngrids
731 DO itrc=1,nns
732 i=idsed(ncs+itrc)
733 ltracersponge(i,ng)=lsand(itrc,ng)
734 END DO
735 END DO
736 CASE ('SAND_AKT_BAK')
737 npts=load_r(nval, rval, nns, ngrids, rsand)
738 DO ng=1,ngrids
739 DO itrc=1,nns
740 i=idsed(ncs+itrc)
741 akt_bak(i,ng)=rsand(itrc,ng)
742 END DO
743 END DO
744 CASE ('SAND_AKT_fac')
745 npts=load_r(nval, rval, nns, ngrids, rsand)
746 DO ng=1,ngrids
747 DO itrc=1,nns
748 i=idsed(ncs+itrc)
749 ad_akt_fac(i,ng)=rsand(itrc,ng)
750 tl_akt_fac(i,ng)=rsand(itrc,ng)
751 END DO
752 END DO
753 CASE ('SAND_TNUDG')
754 npts=load_r(nval, rval, nns, ngrids, rsand)
755 DO ng=1,ngrids
756 DO itrc=1,nns
757 i=idsed(ncs+itrc)
758 tnudg(i,ng)=rsand(itrc,ng)
759 END DO
760 END DO
761 CASE ('SAND_MORPH_FAC')
762 IF (.not.allocated(morph_fac)) THEN
763 allocate (morph_fac(nst,ngrids))
764 END IF
765 npts=load_r(nval, rval, nns, ngrids, rsand)
766 DO ng=1,ngrids
767 DO itrc=1,nns
768 i=ncs+itrc
769 morph_fac(i,ng)=rsand(itrc,ng)
770 END DO
771 END DO
772 CASE ('SAND_Ltsrc', 'SAND_Ltracer')
773 npts=load_l(nval, cval, nns, ngrids, lsand)
774 DO ng=1,ngrids
775 DO itrc=1,nns
776 i=idsed(ncs+itrc)
777 ltracersrc(i,ng)=lsand(itrc,ng)
778 END DO
779 END DO
780 CASE ('SAND_Ltclm')
781 npts=load_l(nval, cval, nns, ngrids, lsand)
782 DO ng=1,ngrids
783 DO itrc=1,nns
784 i=idsed(ncs+itrc)
785 ltracerclm(i,ng)=lsand(itrc,ng)
786 END DO
787 END DO
788 CASE ('SAND_Tnudge')
789 npts=load_l(nval, cval, nns, ngrids, lsand)
790 DO ng=1,ngrids
791 DO itrc=1,nns
792 i=idsed(ncs+itrc)
793 lnudgetclm(i,ng)=lsand(itrc,ng)
794 END DO
795 END DO
796 CASE ('Hout(idsand)')
797 npts=load_l(nval, cval, nns, ngrids, lsand)
798 DO ng=1,ngrids
799 DO itrc=1,nns
800 i=idtvar(idsed(ncs+itrc))
801 hout(i,ng)=lsand(itrc,ng)
802 END DO
803 END DO
804 CASE ('Hout(iSfrac)')
805 npts=load_l(nval, cval, nns, ngrids, lsand)
806 DO ng=1,ngrids
807 DO itrc=1,nns
808 i=idfrac(ncs+itrc)
809 hout(i,ng)=lsand(itrc,ng)
810 END DO
811 END DO
812 CASE ('Hout(iSmass)')
813 npts=load_l(nval, cval, nns, ngrids, lsand)
814 DO ng=1,ngrids
815 DO itrc=1,nns
816 i=idbmas(ncs+itrc)
817 hout(i,ng)=lsand(itrc,ng)
818 END DO
819 END DO
820#ifdef BEDLOAD
821 CASE ('Hout(iSUbld)')
822 DO ng=1,ngrids
823 DO itrc=ncs+1,nst
824 IF (idubld(itrc).eq.0) THEN
825 IF (master) WRITE (out,30) 'idUbld'
826 exit_flag=5
827 RETURN
828 END IF
829 END DO
830 END DO
831 npts=load_l(nval, cval, nns, ngrids, lsand)
832 DO ng=1,ngrids
833 DO itrc=1,nns
834 i=idubld(ncs+itrc)
835 hout(i,ng)=lsand(itrc,ng)
836 END DO
837 END DO
838 CASE ('Hout(iSVbld)')
839 DO ng=1,ngrids
840 DO itrc=ncs+1,nst
841 IF (idvbld(itrc).eq.0) THEN
842 IF (master) WRITE (out,30) 'idVbld'
843 exit_flag=5
844 RETURN
845 END IF
846 END DO
847 END DO
848 npts=load_l(nval, cval, nns, ngrids, lsand)
849 DO ng=1,ngrids
850 DO itrc=1,nns
851 i=idvbld(ncs+itrc)
852 hout(i,ng)=lsand(itrc,ng)
853 END DO
854 END DO
855#endif
856 CASE ('Qout(idsand)')
857 npts=load_l(nval, cval, nns, ngrids, lsand)
858 DO ng=1,ngrids
859 DO itrc=1,nns
860 i=idtvar(idsed(ncs+itrc))
861 qout(i,ng)=lsand(itrc,ng)
862 END DO
863 END DO
864 CASE ('Qout(iSsand)')
865 npts=load_l(nval, cval, nns, ngrids, lsand)
866 DO ng=1,ngrids
867 DO itrc=1,nns
868 i=idsurt(idsed(ncs+itrc))
869 qout(i,ng)=lsand(itrc,ng)
870 END DO
871 END DO
872 CASE ('Qout(iSfrac)')
873 npts=load_l(nval, cval, nns, ngrids, lsand)
874 DO ng=1,ngrids
875 DO itrc=1,nns
876 i=idfrac(ncs+itrc)
877 qout(i,ng)=lsand(itrc,ng)
878 END DO
879 END DO
880 CASE ('Qout(iSmass)')
881 npts=load_l(nval, cval, nns, ngrids, lsand)
882 DO ng=1,ngrids
883 DO itrc=1,nns
884 i=idbmas(ncs+itrc)
885 qout(i,ng)=lsand(itrc,ng)
886 END DO
887 END DO
888#ifdef BEDLOAD
889 CASE ('Qout(iSUbld)')
890 npts=load_l(nval, cval, nns, ngrids, lsand)
891 DO ng=1,ngrids
892 DO itrc=1,nns
893 i=idubld(ncs+itrc)
894 qout(i,ng)=lsand(itrc,ng)
895 END DO
896 END DO
897 CASE ('Qout(iSVbld)')
898 npts=load_l(nval, cval, nns, ngrids, lsand)
899 DO ng=1,ngrids
900 DO itrc=1,nns
901 i=idvbld(ncs+itrc)
902 qout(i,ng)=lsand(itrc,ng)
903 END DO
904 END DO
905#endif
906#if defined AVERAGES || \
907 (defined ad_averages && defined adjoint) || \
908 (defined rp_averages && defined tl_ioms) || \
909 (defined tl_averages && defined tangent)
910 CASE ('Aout(idsand)')
911 npts=load_l(nval, cval, nns, ngrids, lsand)
912 DO ng=1,ngrids
913 DO itrc=1,nns
914 i=idtvar(idsed(ncs+itrc))
915 aout(i,ng)=lsand(itrc,ng)
916 END DO
917 END DO
918 CASE ('Aout(iSTTav)')
919 npts=load_l(nval, cval, nns, ngrids, lsand)
920 DO ng=1,ngrids
921 DO itrc=1,nns
922 i=idttav(idsed(ncs+itrc))
923 aout(i,ng)=lsand(itrc,ng)
924 END DO
925 END DO
926 CASE ('Aout(iSUTav)')
927 npts=load_l(nval, cval, nns, ngrids, lsand)
928 DO ng=1,ngrids
929 DO itrc=1,nns
930 i=idutav(idsed(ncs+itrc))
931 aout(i,ng)=lsand(itrc,ng)
932 END DO
933 END DO
934 CASE ('Aout(iSVTav)')
935 npts=load_l(nval, cval, nns, ngrids, lsand)
936 DO ng=1,ngrids
937 DO itrc=1,nns
938 i=idvtav(idsed(ncs+itrc))
939 aout(i,ng)=lsand(itrc,ng)
940 END DO
941 END DO
942 CASE ('Aout(SHUTav)')
943 npts=load_l(nval, cval, nns, ngrids, lsand)
944 DO ng=1,ngrids
945 DO itrc=1,nns
946 i=ihutav(idsed(ncs+itrc))
947 aout(i,ng)=lsand(itrc,ng)
948 END DO
949 END DO
950 CASE ('Aout(SHVTav)')
951 npts=load_l(nval, cval, nns, ngrids, lsand)
952 DO ng=1,ngrids
953 DO itrc=1,nns
954 i=ihvtav(idsed(ncs+itrc))
955 aout(i,ng)=lsand(itrc,ng)
956 END DO
957 END DO
958# ifdef BEDLOAD
959 CASE ('Aout(iSUbld)')
960 npts=load_l(nval, cval, nns, ngrids, lsand)
961 DO ng=1,ngrids
962 DO itrc=1,nns
963 i=idubld(ncs+itrc)
964 aout(i,ng)=lsand(itrc,ng)
965 END DO
966 END DO
967 CASE ('Aout(iSVbld)')
968 npts=load_l(nval, cval, nns, ngrids, lsand)
969 DO ng=1,ngrids
970 DO itrc=1,nns
971 i=idvbld(ncs+itrc)
972 aout(i,ng)=lsand(itrc,ng)
973 END DO
974 END DO
975# endif
976#endif
977#ifdef DIAGNOSTICS_TS
978 CASE ('Dout(STrate)')
979 npts=load_l(nval, cval, nns, ngrids, lsand)
980 DO ng=1,ngrids
981 DO i=1,nns
982 itrc=idsed(ncs+i)
983 dout(iddtrc(itrc,itrate),ng)=lsand(i,ng)
984 END DO
985 END DO
986 CASE ('Dout(SThadv)')
987 npts=load_l(nval, cval, nns, ngrids, lsand)
988 DO ng=1,ngrids
989 DO i=1,nns
990 itrc=idsed(ncs+i)
991 dout(iddtrc(itrc,ithadv),ng)=lsand(i,ng)
992 END DO
993 END DO
994 CASE ('Dout(STxadv)')
995 npts=load_l(nval, cval, nns, ngrids, lsand)
996 DO ng=1,ngrids
997 DO i=1,nns
998 itrc=idsed(ncs+i)
999 dout(iddtrc(itrc,itxadv),ng)=lsand(i,ng)
1000 END DO
1001 END DO
1002 CASE ('Dout(STyadv)')
1003 npts=load_l(nval, cval, nns, ngrids, lsand)
1004 DO ng=1,ngrids
1005 DO i=1,nns
1006 itrc=idsed(ncs+i)
1007 dout(iddtrc(itrc,ityadv),ng)=lsand(i,ng)
1008 END DO
1009 END DO
1010 CASE ('Dout(STvadv)')
1011 npts=load_l(nval, cval, nns, ngrids, lsand)
1012 DO ng=1,ngrids
1013 DO i=1,nns
1014 itrc=idsed(ncs+i)
1015 dout(iddtrc(itrc,itvadv),ng)=lsand(i,ng)
1016 END DO
1017 END DO
1018# if defined TS_DIF2 || defined TS_DIF4
1019 CASE ('Dout(SThdif)')
1020 npts=load_l(nval, cval, nns, ngrids, lsand)
1021 DO ng=1,ngrids
1022 DO i=1,nns
1023 itrc=idsed(ncs+i)
1024 dout(iddtrc(itrc,ithdif),ng)=lsand(i,ng)
1025 END DO
1026 END DO
1027 CASE ('Dout(STxdif)')
1028 npts=load_l(nval, cval, nns, ngrids, lsand)
1029 DO ng=1,ngrids
1030 DO i=1,nns
1031 itrc=idsed(ncs+i)
1032 dout(iddtrc(itrc,itxdif),ng)=lsand(i,ng)
1033 END DO
1034 END DO
1035 CASE ('Dout(STydif)')
1036 npts=load_l(nval, cval, nns, ngrids, lsand)
1037 DO ng=1,ngrids
1038 DO i=1,nns
1039 itrc=idsed(ncs+i)
1040 dout(iddtrc(itrc,itydif),ng)=lsand(i,ng)
1041 END DO
1042 END DO
1043# if defined MIX_GEO_TS || defined MIX_ISO_TS
1044 CASE ('Dout(STsdif)')
1045 npts=load_l(nval, cval, nns, ngrids, lsand)
1046 DO ng=1,ngrids
1047 DO i=1,nns
1048 itrc=idsed(ncs+i)
1049 dout(iddtrc(itrc,itsdif),ng)=lsand(i,ng)
1050 END DO
1051 END DO
1052# endif
1053# endif
1054 CASE ('Dout(STvdif)')
1055 npts=load_l(nval, cval, nns, ngrids, lsand)
1056 DO ng=1,ngrids
1057 DO i=1,nns
1058 itrc=idsed(ncs+i)
1059 dout(iddtrc(itrc,itvdif),ng)=lsand(i,ng)
1060 END DO
1061 END DO
1062#endif
1063 CASE ('Hout(ithck)')
1064 npts=load_l(nval, cval, ngrids, lbed)
1065 i=idsbed(ithck)
1066 DO ng=1,ngrids
1067 hout(i,ng)=lbed(ng)
1068 END DO
1069 CASE ('Hout(iaged)')
1070 npts=load_l(nval, cval, ngrids, lbed)
1071 i=idsbed(iaged)
1072 DO ng=1,ngrids
1073 hout(i,ng)=lbed(ng)
1074 END DO
1075 CASE ('Hout(iporo)')
1076 npts=load_l(nval, cval, ngrids, lbed)
1077 i=idsbed(iporo)
1078 DO ng=1,ngrids
1079 hout(i,ng)=lbed(ng)
1080 END DO
1081#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED
1082 CASE ('Hout(ibtcr)')
1083 npts=load_l(nval, cval, ngrids, lbed)
1084 i=idsbed(ibtcr)
1085 DO ng=1,ngrids
1086 hout(i,ng)=lbed(ng)
1087 END DO
1088#endif
1089 CASE ('Hout(idiff)')
1090 npts=load_l(nval, cval, ngrids, lbed)
1091 i=idsbed(idiff)
1092 DO ng=1,ngrids
1093 hout(i,ng)=lbed(ng)
1094 END DO
1095 CASE ('Hout(isd50)')
1096 npts=load_l(nval, cval, ngrids, lbottom)
1097 i=idbott(isd50)
1098 DO ng=1,ngrids
1099 hout(i,ng)=lbottom(ng)
1100 END DO
1101 CASE ('Hout(idens)')
1102 npts=load_l(nval, cval, ngrids, lbottom)
1103 i=idbott(idens)
1104 DO ng=1,ngrids
1105 hout(i,ng)=lbottom(ng)
1106 END DO
1107 CASE ('Hout(iwsed)')
1108 npts=load_l(nval, cval, ngrids, lbottom)
1109 i=idbott(iwsed)
1110 DO ng=1,ngrids
1111 hout(i,ng)=lbottom(ng)
1112 END DO
1113 CASE ('Hout(itauc)')
1114 npts=load_l(nval, cval, ngrids, lbottom)
1115 i=idbott(itauc)
1116 DO ng=1,ngrids
1117 hout(i,ng)=lbottom(ng)
1118 END DO
1119 CASE ('Hout(irlen)')
1120 npts=load_l(nval, cval, ngrids, lbottom)
1121 i=idbott(irlen)
1122 DO ng=1,ngrids
1123 hout(i,ng)=lbottom(ng)
1124 END DO
1125 CASE ('Hout(irhgt)')
1126 npts=load_l(nval, cval, ngrids, lbottom)
1127 i=idbott(irhgt)
1128 DO ng=1,ngrids
1129 hout(i,ng)=lbottom(ng)
1130 END DO
1131 CASE ('Hout(ibwav)')
1132 npts=load_l(nval, cval, ngrids, lbottom)
1133 i=idbott(ibwav)
1134 DO ng=1,ngrids
1135 hout(i,ng)=lbottom(ng)
1136 END DO
1137 CASE ('Hout(izdef)')
1138 npts=load_l(nval, cval, ngrids, lbottom)
1139 i=idbott(izdef)
1140 DO ng=1,ngrids
1141 hout(i,ng)=lbottom(ng)
1142 END DO
1143 CASE ('Hout(izapp)')
1144 npts=load_l(nval, cval, ngrids, lbottom)
1145 i=idbott(izapp)
1146 DO ng=1,ngrids
1147 hout(i,ng)=lbottom(ng)
1148 END DO
1149 CASE ('Hout(izNik)')
1150 npts=load_l(nval, cval, ngrids, lbottom)
1151 i=idbott(iznik)
1152 DO ng=1,ngrids
1153 hout(i,ng)=lbottom(ng)
1154 END DO
1155 CASE ('Hout(izbio)')
1156 npts=load_l(nval, cval, ngrids, lbottom)
1157 i=idbott(izbio)
1158 DO ng=1,ngrids
1159 hout(i,ng)=lbottom(ng)
1160 END DO
1161 CASE ('Hout(izbfm)')
1162 npts=load_l(nval, cval, ngrids, lbottom)
1163 i=idbott(izbfm)
1164 DO ng=1,ngrids
1165 hout(i,ng)=lbottom(ng)
1166 END DO
1167 CASE ('Hout(izbld)')
1168 npts=load_l(nval, cval, ngrids, lbottom)
1169 i=idbott(izbld)
1170 DO ng=1,ngrids
1171 hout(i,ng)=lbottom(ng)
1172 END DO
1173 CASE ('Hout(izwbl)')
1174 npts=load_l(nval, cval, ngrids, lbottom)
1175 i=idbott(izwbl)
1176 DO ng=1,ngrids
1177 hout(i,ng)=lbottom(ng)
1178 END DO
1179 CASE ('Hout(iactv)')
1180 npts=load_l(nval, cval, ngrids, lbottom)
1181 i=idbott(iactv)
1182 DO ng=1,ngrids
1183 hout(i,ng)=lbottom(ng)
1184 END DO
1185 CASE ('Hout(ishgt)')
1186 npts=load_l(nval, cval, ngrids, lbottom)
1187 i=idbott(ishgt)
1188 DO ng=1,ngrids
1189 hout(i,ng)=lbottom(ng)
1190 END DO
1191 CASE ('Qout(ithck)')
1192 npts=load_l(nval, cval, ngrids, lbed)
1193 i=idsbed(ithck)
1194 DO ng=1,ngrids
1195 qout(i,ng)=lbed(ng)
1196 END DO
1197 CASE ('Qout(iaged)')
1198 npts=load_l(nval, cval, ngrids, lbed)
1199 i=idsbed(iaged)
1200 DO ng=1,ngrids
1201 qout(i,ng)=lbed(ng)
1202 END DO
1203 CASE ('Qout(iporo)')
1204 npts=load_l(nval, cval, ngrids, lbed)
1205 i=idsbed(iporo)
1206 DO ng=1,ngrids
1207 qout(i,ng)=lbed(ng)
1208 END DO
1209#if defined COHESIVE_BED || defined SED_BIODIFF || defined MIXED_BED
1210 CASE ('Qout(ibtcr)')
1211 npts=load_l(nval, cval, ngrids, lbed)
1212 i=idsbed(ibtcr)
1213 DO ng=1,ngrids
1214 qout(i,ng)=lbed(ng)
1215 END DO
1216#endif
1217 CASE ('Qout(idiff)')
1218 npts=load_l(nval, cval, ngrids, lbed)
1219 i=idsbed(idiff)
1220 DO ng=1,ngrids
1221 qout(i,ng)=lbed(ng)
1222 END DO
1223 CASE ('Qout(isd50)')
1224 npts=load_l(nval, cval, ngrids, lbottom)
1225 i=idbott(isd50)
1226 DO ng=1,ngrids
1227 qout(i,ng)=lbottom(ng)
1228 END DO
1229 CASE ('Qout(idens)')
1230 npts=load_l(nval, cval, ngrids, lbottom)
1231 i=idbott(idens)
1232 DO ng=1,ngrids
1233 qout(i,ng)=lbottom(ng)
1234 END DO
1235 CASE ('Qout(iwsed)')
1236 npts=load_l(nval, cval, ngrids, lbottom)
1237 i=idbott(iwsed)
1238 DO ng=1,ngrids
1239 qout(i,ng)=lbottom(ng)
1240 END DO
1241 CASE ('Qout(itauc)')
1242 npts=load_l(nval, cval, ngrids, lbottom)
1243 i=idbott(itauc)
1244 DO ng=1,ngrids
1245 qout(i,ng)=lbottom(ng)
1246 END DO
1247 CASE ('Qout(irlen)')
1248 npts=load_l(nval, cval, ngrids, lbottom)
1249 i=idbott(irlen)
1250 DO ng=1,ngrids
1251 qout(i,ng)=lbottom(ng)
1252 END DO
1253 CASE ('Qout(irhgt)')
1254 npts=load_l(nval, cval, ngrids, lbottom)
1255 i=idbott(irhgt)
1256 DO ng=1,ngrids
1257 qout(i,ng)=lbottom(ng)
1258 END DO
1259 CASE ('Qout(ibwav)')
1260 npts=load_l(nval, cval, ngrids, lbottom)
1261 i=idbott(ibwav)
1262 DO ng=1,ngrids
1263 qout(i,ng)=lbottom(ng)
1264 END DO
1265 CASE ('Qout(izdef)')
1266 npts=load_l(nval, cval, ngrids, lbottom)
1267 i=idbott(izdef)
1268 DO ng=1,ngrids
1269 qout(i,ng)=lbottom(ng)
1270 END DO
1271 CASE ('Qout(izapp)')
1272 npts=load_l(nval, cval, ngrids, lbottom)
1273 i=idbott(izapp)
1274 DO ng=1,ngrids
1275 qout(i,ng)=lbottom(ng)
1276 END DO
1277 CASE ('Qout(izNik)')
1278 npts=load_l(nval, cval, ngrids, lbottom)
1279 i=idbott(iznik)
1280 DO ng=1,ngrids
1281 qout(i,ng)=lbottom(ng)
1282 END DO
1283 CASE ('Qout(izbio)')
1284 npts=load_l(nval, cval, ngrids, lbottom)
1285 i=idbott(izbio)
1286 DO ng=1,ngrids
1287 qout(i,ng)=lbottom(ng)
1288 END DO
1289 CASE ('Qout(izbfm)')
1290 npts=load_l(nval, cval, ngrids, lbottom)
1291 i=idbott(izbfm)
1292 DO ng=1,ngrids
1293 qout(i,ng)=lbottom(ng)
1294 END DO
1295 CASE ('Qout(izbld)')
1296 npts=load_l(nval, cval, ngrids, lbottom)
1297 i=idbott(izbld)
1298 DO ng=1,ngrids
1299 qout(i,ng)=lbottom(ng)
1300 END DO
1301 CASE ('Qout(izwbl)')
1302 npts=load_l(nval, cval, ngrids, lbottom)
1303 i=idbott(izwbl)
1304 DO ng=1,ngrids
1305 qout(i,ng)=lbottom(ng)
1306 END DO
1307 CASE ('Qout(iactv)')
1308 npts=load_l(nval, cval, ngrids, lbottom)
1309 i=idbott(iactv)
1310 DO ng=1,ngrids
1311 qout(i,ng)=lbottom(ng)
1312 END DO
1313 CASE ('Qout(ishgt)')
1314 npts=load_l(nval, cval, ngrids, lbottom)
1315 i=idbott(ishgt)
1316 DO ng=1,ngrids
1317 qout(i,ng)=lbottom(ng)
1318 END DO
1319 END SELECT
1320 END IF
1321 END DO
1322 10 IF (master) WRITE (out,40) line
1323 exit_flag=4
1324 RETURN
1325 20 CONTINUE
1326!
1327!-----------------------------------------------------------------------
1328! Report input parameters.
1329!-----------------------------------------------------------------------
1330!
1331 IF (master.and.lwrite) THEN
1332 DO ng=1,ngrids
1333 IF (lsediment(ng)) THEN
1334 WRITE (out,50) ng
1335 WRITE (out,60)
1336 DO itrc=1,nst
1337 WRITE (out,70) itrc, sd50(itrc,ng), csed(itrc,ng), &
1338 & srho(itrc,ng), wsed(itrc,ng), &
1339 & erate(itrc,ng), poros(itrc,ng)
1340 END DO
1341 WRITE (out,80)
1342 DO itrc=1,nst
1343 i=idsed(itrc)
1344 WRITE (out,70) itrc, tau_ce(itrc,ng), tau_cd(itrc,ng), &
1345 & nl_tnu2(i,ng), nl_tnu4(i,ng), &
1346 & akt_bak(i,ng), tnudg(i,ng)
1347 END DO
1348 WRITE (out,90)
1349 DO itrc=1,nst
1350 WRITE (out,70) itrc, morph_fac(itrc,ng)
1351 END DO
1352 WRITE (out,100) newlayer_thick(ng)
1353 WRITE (out,110) minlayer_thick(ng)
1354 WRITE (out,120) bedload_coeff(ng)
1355#ifdef MIXED_BED
1356 WRITE (out,130) transc(ng)
1357 WRITE (out,140) transn(ng)
1358#endif
1359 DO itrc=1,nst
1360 i=idsed(itrc)
1361 IF (ltracersponge(i,ng)) THEN
1362 WRITE (out,150) ltracersponge(i,ng), 'LtracerSponge', &
1363 & i, 'Turning ON sponge on tracer ', i, &
1364 & trim(vname(1,idtvar(i)))
1365 ELSE
1366 WRITE (out,150) ltracersponge(i,ng), 'LtracerSponge', &
1367 & i, 'Turning OFF sponge on tracer ', i, &
1368 & trim(vname(1,idtvar(i)))
1369 END IF
1370 END DO
1371 DO itrc=1,nst
1372 i=idsed(itrc)
1373 IF (ltracersrc(i,ng)) THEN
1374 WRITE (out,150) ltracersrc(i,ng), 'LtracerSrc', i, &
1375 & 'Turning ON point sources/Sink on tracer ', i, &
1376 & trim(vname(1,idtvar(i)))
1377 ELSE
1378 WRITE (out,150) ltracersrc(i,ng), 'LtracerSrc', i, &
1379 & 'Turning OFF point sources/Sink on tracer ', i, &
1380 & trim(vname(1,idtvar(i)))
1381 END IF
1382 END DO
1383 DO itrc=1,nst
1384 i=idsed(itrc)
1385 IF (ltracerclm(i,ng)) THEN
1386 WRITE (out,150) ltracerclm(i,ng), 'LtracerCLM', i, &
1387 & 'Turning ON processing of climatology tracer ', i, &
1388 & trim(vname(1,idtvar(i)))
1389 ELSE
1390 WRITE (out,150) ltracerclm(i,ng), 'LtracerCLM', i, &
1391 & 'Turning OFF processing of climatology tracer ', i, &
1392 & trim(vname(1,idtvar(i)))
1393 END IF
1394 END DO
1395 DO itrc=1,nst
1396 i=idsed(itrc)
1397 IF (lnudgetclm(i,ng)) THEN
1398 WRITE (out,150) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
1399 & 'Turning ON nudging of climatology tracer ', i, &
1400 & trim(vname(1,idtvar(i)))
1401 ELSE
1402 WRITE (out,150) lnudgetclm(i,ng), 'LnudgeTCLM', i, &
1403 & 'Turning OFF nudging of climatology tracer ', i, &
1404 & trim(vname(1,idtvar(i)))
1405 END IF
1406 END DO
1407 IF ((nhis(ng).gt.0).and.any(hout(:,ng))) THEN
1408 WRITE (out,'(1x)')
1409 DO itrc=1,nst
1410 i=idtvar(idsed(itrc))
1411 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1412 & 'Hout(idTvar)', &
1413 & 'Write out sediment', itrc, trim(vname(1,i))
1414 END DO
1415 DO itrc=1,nst
1416 i=idfrac(itrc)
1417 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1418 & 'Hout(idfrac)', &
1419 & 'Write out bed fraction, sediment ', itrc, &
1420 & trim(vname(1,i))
1421 END DO
1422 DO itrc=1,nst
1423 i=idbmas(itrc)
1424 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1425 & 'Hout(idfrac)', &
1426 & 'Write out mass, sediment ', itrc, &
1427 & trim(vname(1,i))
1428 END DO
1429#ifdef BEDLOAD
1430 DO itrc=1,nst
1431 i=idubld(itrc)
1432 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1433 & 'Hout(idUbld)', &
1434 & 'Write out bed load at U-points, sediment ', itrc, &
1435 & trim(vname(1,i))
1436 i=idvbld(itrc)
1437 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1438 & 'Hout(idVbld)', &
1439 & 'Write out bed load at V-points, sediment ', itrc, &
1440 & trim(vname(1,i))
1441 END DO
1442#endif
1443 DO itrc=1,mbedp
1444 i=idsbed(itrc)
1445 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1446 & 'Hout(idSbed)', &
1447 & 'Write out BED property ', itrc, trim(vname(1,i))
1448 END DO
1449 DO itrc=1,mbotp
1450 i=idbott(itrc)
1451 IF (hout(i,ng)) WRITE (out,160) hout(i,ng), &
1452 & 'Hout(idBott)', &
1453 & 'Write out BOTTOM property ', itrc, trim(vname(1,i))
1454 END DO
1455 END IF
1456 IF ((nqck(ng).gt.0).and.any(qout(:,ng))) THEN
1457 WRITE (out,'(1x)')
1458 DO itrc=1,nst
1459 i=idtvar(idsed(itrc))
1460 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1461 & 'Qout(idTvar)', &
1462 & 'Write out sediment', itrc, trim(vname(1,i))
1463 END DO
1464 DO itrc=1,nst
1465 i=idsurt(idsed(itrc))
1466 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1467 & 'Qout(idTvar)', &
1468 & 'Write out surface sediment', itrc, trim(vname(1,i))
1469 END DO
1470 DO itrc=1,nst
1471 i=idfrac(itrc)
1472 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1473 & 'Qout(idfrac)', &
1474 & 'Write out bed fraction, sediment ', itrc, &
1475 & trim(vname(1,i))
1476 END DO
1477 DO itrc=1,nst
1478 i=idbmas(itrc)
1479 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1480 & 'Qout(idfrac)', &
1481 & 'Write out mass, sediment ', itrc, &
1482 & trim(vname(1,i))
1483 END DO
1484#ifdef BEDLOAD
1485 DO itrc=1,nst
1486 i=idubld(itrc)
1487 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1488 & 'Qout(idUbld)', &
1489 & 'Write out bed load at U-points, sediment ', itrc, &
1490 & trim(vname(1,i))
1491 i=idvbld(itrc)
1492 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1493 & 'Qout(idVbld)', &
1494 & 'Write out bed load at V-points, sediment ', itrc, &
1495 & trim(vname(1,i))
1496 END DO
1497#endif
1498 DO itrc=1,mbedp
1499 i=idsbed(itrc)
1500 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1501 & 'Qout(idSbed)', &
1502 & 'Write out BED property ', itrc, trim(vname(1,i))
1503 END DO
1504 DO itrc=1,mbotp
1505 i=idbott(itrc)
1506 IF (qout(i,ng)) WRITE (out,160) qout(i,ng), &
1507 & 'Qout(idBott)', &
1508 & 'Write out BOTTOM property ', itrc, trim(vname(1,i))
1509 END DO
1510 END IF
1511#if defined AVERAGES || \
1512 (defined ad_averages && defined adjoint) || \
1513 (defined rp_averages && defined tl_ioms) || \
1514 (defined tl_averages && defined tangent)
1515 IF ((navg(ng).gt.0).and.any(aout(:,ng))) THEN
1516 WRITE (out,'(1x)')
1517 DO itrc=1,nst
1518 i=idtvar(idsed(itrc))
1519 IF (aout(i,ng)) WRITE (out,160) aout(i,ng), &
1520 & 'Aout(idTvar)', &
1521 & 'Write out averaged sediment', itrc, &
1522 & trim(vname(1,i))
1523 END DO
1524 DO itrc=1,nst
1525 i=idsed(itrc)
1526 IF (aout(idttav(i),ng)) WRITE (out,160) &
1527 & aout(idttav(i),ng), 'Aout(idTTav)', &
1528 & 'Write out averaged <t*t> for tracer ', i, &
1529 & trim(vname(1,idtvar(i)))
1530 END DO
1531 DO itrc=1,nst
1532 i=idsed(itrc)
1533 IF (aout(idutav(i),ng)) WRITE (out,160) &
1534 & aout(idutav(i),ng), 'Aout(idUTav)', &
1535 & 'Write out averaged <u*t> for tracer ', i, &
1536 & trim(vname(1,idtvar(i)))
1537 END DO
1538 DO itrc=1,nst
1539 i=idsed(itrc)
1540 IF (aout(idvtav(i),ng)) WRITE (out,160) &
1541 & aout(idvtav(i),ng), 'Aout(idVTav)', &
1542 & 'Write out averaged <v*t> for tracer ', i, &
1543 & trim(vname(1,idtvar(i)))
1544 END DO
1545 DO itrc=1,nst
1546 i=idsed(itrc)
1547 IF (aout(ihutav(i),ng)) WRITE (out,160) &
1548 & aout(ihutav(i),ng), 'Aout(iHUTav)', &
1549 & 'Write out averaged <Huon*t> for tracer ', i, &
1550 & trim(vname(1,idtvar(i)))
1551 END DO
1552 DO itrc=1,nst
1553 i=idsed(itrc)
1554 IF (aout(ihvtav(i),ng)) WRITE (out,160) &
1555 & aout(ihvtav(i),ng), 'Aout(iHVTav)', &
1556 & 'Write out averaged <Hvom*t> for tracer ', i, &
1557 & trim(vname(1,idtvar(i)))
1558 END DO
1559# ifdef BEDLOAD
1560 DO itrc=1,nst
1561 i=idubld(itrc)
1562 IF (aout(i,ng)) WRITE (out,160) aout(i,ng), &
1563 & 'Aout(idUbld)', &
1564 & 'Write out U-bedload, sediment ', itrc, &
1565 & trim(vname(1,i))
1566 i=idvbld(itrc)
1567 IF (aout(i,ng)) WRITE (out,160) aout(i,ng), &
1568 & 'Aout(idVbld)', &
1569 & 'Write out V-bedload, sediment ', itrc, &
1570 & trim(vname(1,i))
1571 END DO
1572# endif
1573 END IF
1574#endif
1575#ifdef DIAGNOSTICS_TS
1576 IF ((ndia(ng).gt.0).and.any(dout(:,ng))) THEN
1577 WRITE (out,'(1x)')
1578 DO i=1,nst
1579 itrc=idsed(i)
1580 IF (dout(iddtrc(itrc,itrate),ng)) &
1581 & WRITE (out,160) .true., 'Dout(iTrate)', &
1582 & 'Write out rate of change of tracer ', itrc, &
1583 & trim(vname(1,idtvar(itrc)))
1584 END DO
1585 DO i=1,nst
1586 itrc=idsed(i)
1587 IF (dout(iddtrc(itrc,ithadv),ng)) &
1588 & WRITE (out,160) .true., 'Dout(iThadv)', &
1589 & 'Write out horizontal advection, tracer ', itrc, &
1590 & trim(vname(1,idtvar(itrc)))
1591 END DO
1592 DO i=1,nst
1593 itrc=idsed(i)
1594 IF (dout(iddtrc(itrc,itxadv),ng)) &
1595 & WRITE (out,160) .true., 'Dout(iTxadv)', &
1596 & 'Write out horizontal X-advection, tracer ', itrc, &
1597 & trim(vname(1,idtvar(itrc)))
1598 END DO
1599 DO i=1,nst
1600 itrc=idsed(i)
1601 IF (dout(iddtrc(itrc,ityadv),ng)) &
1602 & WRITE (out,160) .true., 'Dout(iTyadv)', &
1603 & 'Write out horizontal Y-advection, tracer ', itrc, &
1604 & trim(vname(1,idtvar(itrc)))
1605 END DO
1606 DO i=1,nst
1607 itrc=idsed(i)
1608 IF (dout(iddtrc(itrc,itvadv),ng)) &
1609 & WRITE (out,160) .true., 'Dout(iTvadv)', &
1610 & 'Write out vertical advection, tracer ', itrc, &
1611 & trim(vname(1,idtvar(itrc)))
1612 END DO
1613# if defined TS_DIF2 || defined TS_DIF4
1614 DO i=1,nst
1615 itrc=idsed(i)
1616 IF (dout(iddtrc(itrc,ithdif),ng)) &
1617 & WRITE (out,160) .true., 'Dout(iThdif)', &
1618 & 'Write out horizontal diffusion, tracer ', itrc, &
1619 & trim(vname(1,idtvar(itrc)))
1620 END DO
1621 DO i=1,nst
1622 itrc=idsed(i)
1623 IF (dout(iddtrc(i,itxdif),ng)) &
1624 & WRITE (out,160) .true., 'Dout(iTxdif)', &
1625 & 'Write out horizontal X-diffusion, tracer ', itrc, &
1626 & trim(vname(1,idtvar(itrc)))
1627 END DO
1628 DO i=1,nst
1629 itrc=idsed(i)
1630 IF (dout(iddtrc(itrc,itydif),ng)) &
1631 & WRITE (out,160) .true., 'Dout(iTydif)', &
1632 & 'Write out horizontal Y-diffusion, tracer ', itrc, &
1633 & trim(vname(1,idtvar(itrc)))
1634 END DO
1635# if defined MIX_GEO_TS || defined MIX_ISO_TS
1636 DO i=1,nst
1637 itrc=idsed(i)
1638 IF (dout(iddtrc(itrc,itsdif),ng)) &
1639 & WRITE (out,160) .true., 'Dout(iTsdif)', &
1640 & 'Write out horizontal S-diffusion, tracer ', itrc, &
1641 & trim(vname(1,idtvar(itrc)))
1642 END DO
1643# endif
1644# endif
1645 DO i=1,nst
1646 itrc=idsed(i)
1647 IF (dout(iddtrc(itrc,itvdif),ng)) &
1648 & WRITE (out,160) .true., 'Dout(iTvdif)', &
1649 & 'Write out vertical diffusion, tracer ', itrc, &
1650 & trim(vname(1,idtvar(itrc)))
1651 END DO
1652 END IF
1653#endif
1654 END IF
1655 END DO
1656 END IF
1657!
1658!-----------------------------------------------------------------------
1659! Scale relevant input parameters
1660!-----------------------------------------------------------------------
1661!
1662 DO ng=1,ngrids
1663 DO i=1,nst
1664 sd50(i,ng)=sd50(i,ng)*0.001_r8
1665 wsed(i,ng)=wsed(i,ng)*0.001_r8
1666 tau_ce(i,ng)=tau_ce(i,ng)/rho0
1667 tau_cd(i,ng)=tau_cd(i,ng)/rho0
1668 nl_tnu4(idsed(i),ng)=sqrt(abs(nl_tnu4(idsed(i),ng)))
1669#ifdef ADJOINT
1670 ad_tnu4(idsed(i),ng)=sqrt(abs(ad_tnu4(idsed(i),ng)))
1671#endif
1672#if defined TANGENT || defined TL_IOMS
1673 tl_tnu4(idsed(i),ng)=sqrt(abs(tl_tnu4(idsed(i),ng)))
1674#endif
1675 IF (tnudg(idsed(i),ng).gt.0.0_r8) THEN
1676 tnudg(idsed(i),ng)=1.0_r8/(tnudg(idsed(i),ng)*86400.0_r8)
1677 ELSE
1678 tnudg(idsed(i),ng)=0.0_r8
1679 END IF
1680 END DO
1681 END DO
1682
1683 30 FORMAT (/,' READ_SedPar - variable info not yet loaded, ', a)
1684 40 FORMAT (/,' READ_SedPar - Error while processing line: ',/,a)
1685 50 FORMAT (/,/,' Sediment Parameters, Grid: ',i2.2, &
1686 & /, ' =============================',/)
1687 60 FORMAT (/,1x,'Size',5x,'Sd50',8x,'Csed',8x,'Srho',8x,'Wsed', &
1688 & 8x,'Erate',7x,'poros',/,1x,'Class',4x,'(mm)',7x, &
1689 & '(kg/m3)',5x,'(kg/m3)',5x,'(mm/s)',5x,'(kg/m2/s)',4x, &
1690 & '(nondim)',/)
1691 70 FORMAT (2x,i2,2x,6(1x,1p,e11.4))
1692 80 FORMAT (/,9x,'tau_ce',6x,'tau_cd',6x,'nl_tnu2',5x,'nl_tnu4',5x, &
1693 & 'Akt_bak',6x,'Tnudg',/,9x,'(N/m2)',6x,'(N/m2)',6x, &
1694 & '(m2/s)',6x,'(m4/s)',7x,'(m2/s)',6x,'(day)',/)
1695 90 FORMAT (/,9x,'morph_fac',/,9x,'(nondim)',/)
1696 100 FORMAT (/,' New bed layer formed when deposition exceeds ',e12.5, &
1697 & ' (m).')
1698 110 FORMAT (' Two first layers are combined when 2nd layer smaller ', &
1699 & 'than ',e12.5,' (m).')
1700 120 FORMAT (' Rate coefficient for bed load transport = ',e12.5,/)
1701 130 FORMAT (' Transition for mixed sediment =',e12.5,/)
1702 140 FORMAT (' Transition for cohesive sediment =',e12.5,/)
1703 150 FORMAT (10x,l1,2x,a,'(',i2.2,')',t30,a,i2.2,':',1x,a)
1704 160 FORMAT (10x,l1,2x,a,t29,a,i2.2,':',1x,a)
1705
1706 RETURN
1707 END SUBROUTINE read_sedpar
1708
inp_decode_mod
Definition inp_decode.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::nst
integer nst
Definition mod_param.F:521
mod_scalars
Definition mod_scalars.F:2
mod_sediment
Definition sediment_mod.h:1
read_sedpar
subroutine read_sedpar(model, inp, out, lwrite)
Definition sediment_inp.h:2