59 integer,
pointer :: isrc(:)
60 integer,
pointer :: jsrc(:)
62 real(
r8),
pointer :: dsrc(:)
63 real(
r8),
pointer :: fsrc(:)
64 real(
r8),
pointer :: qbar(:)
65 real(
r8),
pointer :: qshape(:,:)
66 real(
r8),
pointer :: qsrc(:,:)
67 real(
r8),
pointer :: tsrc(:,:,:)
68 real(
r8),
pointer :: xsrc(:)
69 real(
r8),
pointer :: ysrc(:)
72 real(
r8),
pointer :: qbarg(:,:)
73 real(
r8),
pointer :: tsrcg(:,:,:,:)
77 real(
r8),
pointer :: ad_qbar(:)
78 real(
r8),
pointer :: ad_qsrc(:,:)
79 real(
r8),
pointer :: ad_tsrc(:,:,:)
83 real(
r8),
pointer :: tl_qbar(:)
84 real(
r8),
pointer :: tl_qsrc(:,:)
85 real(
r8),
pointer :: tl_tsrc(:,:,:)
96 integer,
allocatable ::
msrc(:)
97 integer,
allocatable ::
nsrc(:)
116# if defined PIO_LIB && defined DISTRIBUTE
133 integer :: vid, ifile, nvatt, nvdim
135 integer :: is, itrc, k, mg
137 real(
r8),
parameter :: inival = 0.0_r8
139 character (len=*),
parameter :: myfile = &
140 & __FILE__//
", allocate_sources"
143# if defined PIO_LIB && defined DISTRIBUTE
145 TYPE (var_desc_t) :: my_piovar
153 IF (.not.
allocated(
msrc))
THEN
157 IF (.not.
allocated(
nsrc))
THEN
169 SELECT CASE (
ssf(ng)%IOtype)
173 & searchvar = foundit, &
178# if defined PIO_LIB && defined DISTRIBUTE
182 & searchvar = foundit, &
183 & piovar = my_piovar, &
283 sources(ng) % Dsrc(is) = inival
284 sources(ng) % Fsrc(is) = inival
285 sources(ng) % Xsrc(is) = inival
286 sources(ng) % Ysrc(is) = inival
287 sources(ng) % Qbar(is) = inival
289 sources(ng) % QbarG(is,1) = inival
290 sources(ng) % QbarG(is,2) = inival
293 sources(ng) % ad_Qbar(is) = inival
296 sources(ng) % tl_Qbar(is) = inival
301 sources(ng) % Qshape(is,k) = inival
302 sources(ng) % Qsrc(is,k) = inival
304 sources(ng) % ad_Qsrc(is,k) = inival
307 sources(ng) % tl_Qsrc(is,k) = inival
314 sources(ng) % Tsrc(is,k,itrc) = inival
316 sources(ng) % ad_Tsrc(is,k,itrc) = inival
319 sources(ng) % tl_Tsrc(is,k,itrc) = inival
322 sources(ng) % TsrcG(is,k,1,itrc) = inival
323 sources(ng) % TsrcG(is,k,2,itrc) = inival
341#ifdef SUBOBJECT_DEALLOCATION
352 character (len=*),
parameter :: myfile = &
353 & __FILE__//
", deallocate_mixing"
355#ifdef SUBOBJECT_DEALLOCATION
363 & __line__,
'SOURCES(ng)%Isrc'))
RETURN
366 & __line__,
'SOURCES(ng)%Jsrc'))
RETURN
369 & __line__,
'SOURCES(ng)%Dsrc'))
RETURN
372 & __line__,
'SOURCES(ng)%Fsrc'))
RETURN
375 & __line__,
'SOURCES(ng)%Qbar'))
RETURN
378 & __line__,
'SOURCES(ng)%Qshape'))
RETURN
381 & __line__,
'SOURCES(ng)%Qsrc'))
RETURN
384 & __line__,
'SOURCES(ng)%Tsrc'))
RETURN
387 & __line__,
'SOURCES(ng)%Xsrc'))
RETURN
390 & __line__,
'SOURCES(ng)%Ysrc'))
RETURN
394 & __line__,
'SOURCES(ng)%QbarG'))
RETURN
397 & __line__,
'SOURCES(ng)%TsrcG'))
RETURN
402 & __line__,
'SOURCES(ng)%ad_Qbar'))
RETURN
405 & __line__,
'SOURCES(ng)%ad_Qsrc'))
RETURN
408 & __line__,
'SOURCES(ng)%ad_Tsrc'))
RETURN
413 & __line__,
'SOURCES(ng)%tl_Qbar'))
RETURN
416 & __line__,
'SOURCES(ng)%tl_Qsrc'))
RETURN
419 & __line__,
'SOURCES(ng)%tl_Tsrc'))
RETURN
427 IF (ng.eq.ngrids)
THEN
435 IF (
allocated(
msrc))
THEN
439 IF (
allocated(
nsrc))
THEN
460#if defined PIO_LIB && defined DISTRIBUTE
469 integer,
intent(in) :: ng, Npsrc
471 character (len=*),
intent(in) :: ncname
475 integer :: i, ic_u, ic_v, ic_w
477 real(r8) :: Dsrc_min, Dsrc_max
479 real(r8) :: Dsrc(Npsrc)
481 character (len=*),
parameter :: MyFile = &
482 & __FILE__//
", check_sources"
496 SELECT CASE (
ssf(ng)%IOtype)
499 & vname(1,idrdir), dsrc, &
500 & min_val = dsrc_min, &
501 & max_val = dsrc_max)
503# if defined PIO_LIB && defined DISTRIBUTE
506 & vname(1,idrdir), dsrc, &
507 & min_val = dsrc_min, &
508 & max_val = dsrc_max)
520 IF (int(dsrc(i)).eq.0) ic_u=ic_u+1
521 IF (int(dsrc(i)).eq.1) ic_v=ic_v+1
522 IF (int(dsrc(i)).eq.2) ic_w=ic_w+1
526 IF (ng.eq.1)
WRITE (
stdout,10)
527 WRITE (
stdout,20) ng, trim(ncname), &
536 (ic_u.eq.0).and.(ic_v.eq.0))
THEN
540 IF (.not.
luvsrc(ng).and.
lwsrc(ng).and.(ic_w.eq.0))
THEN
546 10
FORMAT (/,1x,
'Point Sources/Sinks grid-cell flag locations ', &
548 20
FORMAT (4x,
'Grid: ',i0,
', file: ',a,/, &
549 & 19x,
'LuvSrc = ',l1,2x,
'u-face = ',i0,/, &
550 & 19x,
'LuvSrc = ',l1,2x,
'v-face = ',i0,/, &
551 & 19x,
'LwSrc = ',l1,2x,
'w-face = ',i0)
552 30
FORMAT (/,
' CHECK_SOURCES - Cannot find point Souces/Sinks ', &
553 &
"the '",a,
"' method.")
type(t_io), dimension(:), allocatable ssf
integer, parameter io_nf90
integer, parameter io_pio
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(nvard) var_dsize
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
integer, dimension(:), allocatable n
real(r8), dimension(:), allocatable dmem
integer, dimension(:), allocatable nt
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
logical, dimension(:), allocatable luvsrc
logical, dimension(:,:), allocatable ltracersrc
logical, dimension(:), allocatable lwsrc
type(t_sources), dimension(:), allocatable sources
subroutine, public allocate_sources(ng)
integer, dimension(:), allocatable nsrc
subroutine, public deallocate_sources(ng)
integer, dimension(:), allocatable msrc
subroutine check_sources(ng, ncname, npsrc)
logical function, public founderror(flag, noerr, line, routine)