74 integer,
intent(in) :: ng, ncid
75 integer,
intent(out) :: status
77 character (*),
intent(in) :: ncname
78 character (*),
intent(in) :: aname
80 TYPE(
t_adv),
intent(in) :: Hadv(MAXVAL(NT),Ngrids)
81 TYPE(
t_adv),
intent(in) :: Vadv(MAXVAL(NT),Ngrids)
85 integer :: i, ie, is, itrc, lvar, lstr, nTvar
87 character (len= 1) :: newline
88 character (len= 13) :: Hstring, Vstring
89 character (len= 17) :: frmt
90 character (len= 70) :: line
91 character (len=2816) :: tadv_att
93 character (len=*),
parameter :: MyFile = &
94 & __FILE__//
", tadv_putatt_nf90"
107 WRITE (frmt,10) max(10,lvar)+4
108 10
FORMAT (
"(a,':',t",i2.2,
',a,a,a)')
113 lstr=len_trim(newline)
117 tadv_att(1:lstr)=newline(1:lstr)
119 WRITE (line,frmt)
'ADVECTION', &
125 tadv_att(is:ie)=line(1:lstr)
131 lstr=(ntvar+1)*(26+lvar+4)+1
132 IF (len(tadv_att).lt.lstr)
THEN
134 WRITE (
stdout,20) len(tadv_att), lstr
135 20
FORMAT (/,
' TADV_PUTATT_NF90 - Length of local string ', &
136 &
' tadv_att too small',/,20x,
'Current = ',i5, &
146 IF (hadv(itrc,ng)%AKIMA4)
THEN
148 ELSE IF (hadv(itrc,ng)%CENTERED2)
THEN
150 ELSE IF (hadv(itrc,ng)%CENTERED4)
THEN
152 ELSE IF (hadv(itrc,ng)%HSIMT)
THEN
154 ELSE IF (hadv(itrc,ng)%MPDATA)
THEN
156 ELSE IF (hadv(itrc,ng)%SPLINES)
THEN
158 ELSE IF (hadv(itrc,ng)%SPLIT_U3)
THEN
160 ELSE IF (hadv(itrc,ng)%UPSTREAM3)
THEN
164 IF (vadv(itrc,ng)%AKIMA4)
THEN
166 ELSE IF (vadv(itrc,ng)%CENTERED2)
THEN
168 ELSE IF (vadv(itrc,ng)%CENTERED4)
THEN
170 ELSE IF (vadv(itrc,ng)%HSIMT)
THEN
172 ELSE IF (vadv(itrc,ng)%MPDATA)
THEN
174 ELSE IF (vadv(itrc,ng)%SPLINES)
THEN
176 ELSE IF (vadv(itrc,ng)%SPLIT_U3)
THEN
178 ELSE IF (vadv(itrc,ng)%UPSTREAM3)
THEN
181 IF (itrc.eq.ntvar) newline=
' '
183 & hstring, vstring, &
187 tadv_att(is:ie)=line(1:lstr)
193 status=nf90_put_att(ncid, nf90_global, trim(aname), &
195 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
208 & Hadv, Vadv, status)
248 integer,
intent(in) :: ng
249 integer,
intent(out) :: status
251 character (*),
intent(in) :: ncname
252 character (*),
intent(in) :: aname
254 TYPE (File_desc_t),
intent(in) :: pioFile
255 TYPE(
t_adv),
intent(in) :: Hadv(MAXVAL(NT),Ngrids)
256 TYPE(
t_adv),
intent(in) :: Vadv(MAXVAL(NT),Ngrids)
260 integer :: i, ie, is, itrc, lvar, lstr, nTvar
262 character (len= 1) :: newline
263 character (len= 13) :: Hstring, Vstring
264 character (len= 17) :: frmt
265 character (len= 70) :: line
266 character (len=2816) :: tadv_att
268 character (len=*),
parameter :: MyFile = &
269 & __FILE__//
", tadv_putatt_pio"
282 WRITE (frmt,10) max(10,lvar)+4
283 10
FORMAT (
"(a,':',t",i2.2,
',a,a,a)')
288 lstr=len_trim(newline)
292 tadv_att(1:lstr)=newline(1:lstr)
294 WRITE (line,frmt)
'ADVECTION', &
300 tadv_att(is:ie)=line(1:lstr)
306 lstr=(ntvar+1)*(26+lvar+4)+1
307 IF (len(tadv_att).lt.lstr)
THEN
309 WRITE (
stdout,20) len(tadv_att), lstr
310 20
FORMAT (/,
' TADV_PUTATT_PIO - Length of local string ', &
311 &
'tadv_att too small',/,19x,
'Current = ',i5, &
321 IF (hadv(itrc,ng)%AKIMA4)
THEN
323 ELSE IF (hadv(itrc,ng)%CENTERED2)
THEN
325 ELSE IF (hadv(itrc,ng)%CENTERED4)
THEN
327 ELSE IF (hadv(itrc,ng)%HSIMT)
THEN
329 ELSE IF (hadv(itrc,ng)%MPDATA)
THEN
331 ELSE IF (hadv(itrc,ng)%SPLINES)
THEN
333 ELSE IF (hadv(itrc,ng)%SPLIT_U3)
THEN
335 ELSE IF (hadv(itrc,ng)%UPSTREAM3)
THEN
339 IF (vadv(itrc,ng)%AKIMA4)
THEN
341 ELSE IF (vadv(itrc,ng)%CENTERED2)
THEN
343 ELSE IF (vadv(itrc,ng)%CENTERED4)
THEN
345 ELSE IF (vadv(itrc,ng)%HSIMT)
THEN
347 ELSE IF (vadv(itrc,ng)%MPDATA)
THEN
349 ELSE IF (vadv(itrc,ng)%SPLINES)
THEN
351 ELSE IF (vadv(itrc,ng)%SPLIT_U3)
THEN
353 ELSE IF (vadv(itrc,ng)%UPSTREAM3)
THEN
356 IF (itrc.eq.ntvar) newline=
' '
358 & hstring, vstring, &
362 tadv_att(is:ie)=line(1:lstr)
368 status=pio_put_att(piofile, pio_global, trim(aname), &
370 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
408 logical,
intent(in) :: Lwrite
410 integer,
intent(in) :: iunit, model
412 TYPE(
t_adv),
intent(in) :: Hadv(MAXVAL(NT),Ngrids)
413 TYPE(
t_adv),
intent(in) :: Vadv(MAXVAL(NT),Ngrids)
417 integer :: i, itrc, ng
419 character (len=11) :: Hstring(MAXVAL(NT),Ngrids)
420 character (len=11) :: Vstring(MAXVAL(NT),Ngrids)
428 IF (hadv(itrc,ng)%AKIMA4)
THEN
429 hstring(itrc,ng)=
'Akima4'
430 ELSE IF (hadv(itrc,ng)%CENTERED2)
THEN
431 hstring(itrc,ng)=
'Centered2'
432 ELSE IF (hadv(itrc,ng)%CENTERED4)
THEN
433 hstring(itrc,ng)=
'Centered4'
434 ELSE IF (hadv(itrc,ng)%HSIMT)
THEN
435 hstring(itrc,ng)=
'HSIMT'
436 ELSE IF (hadv(itrc,ng)%MPDATA)
THEN
437 hstring(itrc,ng)=
'MPDATA'
438 ELSE IF (hadv(itrc,ng)%SPLINES)
THEN
439 hstring(itrc,ng)=
'Splines'
440 ELSE IF (hadv(itrc,ng)%SPLIT_U3)
THEN
441 hstring(itrc,ng)=
'Split_U3'
442 ELSE IF (hadv(itrc,ng)%UPSTREAM3)
THEN
443 hstring(itrc,ng)=
'Upstream3'
446 IF (vadv(itrc,ng)%AKIMA4)
THEN
447 vstring(itrc,ng)=
'Akima4'
448 ELSE IF (vadv(itrc,ng)%CENTERED2)
THEN
449 vstring(itrc,ng)=
'Centered2'
450 ELSE IF (vadv(itrc,ng)%CENTERED4)
THEN
451 vstring(itrc,ng)=
'Centered4'
452 ELSE IF (vadv(itrc,ng)%HSIMT)
THEN
453 vstring(itrc,ng)=
'HSIMT'
454 ELSE IF (vadv(itrc,ng)%MPDATA)
THEN
455 vstring(itrc,ng)=
'MPDATA'
456 ELSE IF (vadv(itrc,ng)%SPLINES)
THEN
457 vstring(itrc,ng)=
'Splines'
458 ELSE IF (vadv(itrc,ng)%SPLIT_U3)
THEN
459 vstring(itrc,ng)=
'Split_U3'
460 ELSE IF (vadv(itrc,ng)%UPSTREAM3)
THEN
461 vstring(itrc,ng)=
'Upstream3'
468 IF (
master.and.lwrite)
THEN
472 WRITE (iunit,10) trim(
vname(1,
idtvar(itrc))), ng, &
473 & trim(hstring(itrc,ng)), &
474 & trim(vstring(itrc,ng))
476 WRITE (iunit,20) ng, &
477 & trim(hstring(itrc,ng)), &
478 & trim(vstring(itrc,ng))
483 IF (model.eq.
inlm)
THEN
485 WRITE (iunit,30)
'Akima4', &
486 &
'Fourth-order Akima advection'
487 WRITE (iunit,30)
'Centered2', &
488 &
'Second-order centered differences advection'
489 WRITE (iunit,30)
'Centered4', &
490 &
'Fourth-order centered differences advection'
491 WRITE (iunit,30)
'HSIMT', &
492 &
'Third High-order Spatial Inteporlation at Middle '// &
493 &
'Time Advection with TVD limiter'
494 WRITE (iunit,30)
'MPDATA', &
495 &
'Multidimensional Positive Definite Advection '// &
496 &
'Algorithm, recursive method'
497 WRITE (iunit,30)
'Splines', &
498 &
'Conservative Parabolic Splines Reconstruction '// &
499 &
'Advection (only vertical; not recommended)'
500 WRITE (iunit,30)
'Split_U3', &
501 &
'Split third-order Upstream Advection'
502 WRITE (iunit,30)
'Upstream3', &
503 &
'Third-order Upstream-biased Advection '// &
504 &
'(only horizontal)'
511 IF (model.eq.
inlm)
THEN
514 IF (.not.vadv(i,ng)%MPDATA.and.hadv(i,ng)%MPDATA)
THEN
517 & trim(hstring(i,ng)), &
518 &
'must be specified for both advective terms'
522 ELSE IF (.not.hadv(i,ng)%MPDATA.and.vadv(i,ng)%MPDATA)
THEN
525 & trim(vstring(i,ng)), &
526 &
'must be specified for both advective terms'
530 ELSE IF (.not.vadv(i,ng)%HSIMT.and.hadv(i,ng)%HSIMT)
THEN
533 & trim(hstring(i,ng)), &
534 &
'must be specified for both advective terms'
538 ELSE IF (.not.hadv(i,ng)%HSIMT.and.vadv(i,ng)%HSIMT)
THEN
541 & trim(vstring(i,ng)), &
542 &
'must be specified for both advective terms'
546 ELSE IF (hadv(i,ng)%SPLINES)
THEN
549 & trim(hstring(i,ng)), &
550 &
'is only available for the vertical term'
555 ELSE IF (vadv(i,ng)%UPSTREAM3)
THEN
558 & trim(vstring(i,ng)), &
559 &
'is only available for the horizontal term'
567 ELSE IF (model.eq.
iadm)
THEN
570 IF (hadv(i,ng)%MPDATA.or.hadv(i,ng)%HSIMT)
THEN
573 & trim(hstring(i,ng)), &
574 &
'is not supported in adjoint-based algorithms'
578 ELSE IF (vadv(i,ng)%MPDATA.or.vadv(i,ng)%HSIMT)
THEN
581 & trim(vstring(i,ng)), &
582 &
'is not supported in adjoint-based algorithms'
586 ELSE IF (hadv(i,ng)%SPLINES)
THEN
589 & trim(hstring(i,ng)), &
590 &
'is only available for the vertical term'
595 ELSE IF (vadv(i,ng)%UPSTREAM3)
THEN
598 & trim(vstring(i,ng)), &
599 &
'is only available for the horizontal term'
609 10
FORMAT (/,1x,a,t26,i2,t31,a,t50,a)
610 20
FORMAT (t26,i2,t31,a,t50,a)
611 30
FORMAT (1x,a,t13,a)
612 40
FORMAT (/,
'TADV_REPORT - Illegal tracer advection scheme for ''', &
613 & a,
''' in grid: ',i0,/,14x,
'''',a,
'''',1x,a,
'.',/)