63 SUBROUTINE ana_psource_tile (ng, tile, model, &
64 & LBi, UBi, LBj, UBj, &
65 & IminS, ImaxS, JminS, JmaxS, &
90 integer,
intent(in) :: ng, tile, model
91 integer,
intent(in) :: LBi, UBi, LBj, UBj
92 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
93 integer,
intent(in) :: nnew, knew
96 real(r8),
intent(in) :: zeta(LBi:,LBj:,:)
97 real(r8),
intent(in) :: ubar(LBi:,LBj:,:)
98 real(r8),
intent(in) :: vbar(LBi:,LBj:,:)
100 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
101 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
102 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
104 real(r8),
intent(in) :: h(LBi:,LBj:)
105 real(r8),
intent(in) :: on_u(LBi:,LBj:)
106 real(r8),
intent(in) :: om_v(LBi:,LBj:)
108 real(r8),
intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
109 real(r8),
intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
110 real(r8),
intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
112 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
113 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
114 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
116 real(r8),
intent(in) :: h(LBi:UBi,LBj:UBj)
117 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
118 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
123 integer :: Npts, NSUB, is, i, j, k, ised
125 real(r8) :: Pspv = 0.0_r8
126 real(r8),
save :: area_east, area_west
127 real(r8) :: cff, fac, my_area_east, my_area_west
129#if defined DISTRIBUTE && defined SOLVE3D
130 real(r8),
dimension(Msrc(ng)*N(ng)) :: Pwrk
132#if defined DISTRIBUTE
133 real(r8),
dimension(2) :: rbuffer
135 character (len=3),
dimension(2) :: io_handle
138#include "set_bounds.h"
156#if defined RIVERPLUME1
175#elif defined RIVERPLUME2
178 DO is=1,(
nsrc(ng)-1)/2
192#elif defined SED_TEST1
207 ana_psource.h: no values provided for
nsrc, dsrc, isrc, jsrc.
239# if defined SED_TEST1
244 IF (((istrt.le.i).and.(i.le.iendt)).and. &
245 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
246 IF (ubar(i,j,knew).ne.0.0_r8)
THEN
247 cff=abs(u(i,j,k,nnew)/ubar(i,j,knew))
251 sources(ng)%Qshape(is,k)=cff* &
256 & (z_w(i-1,j,n(ng))- &
264 pwrk=reshape(
sources(ng)%Qshape,(/npts/))
266 sources(ng)%Qshape=reshape(pwrk,(/
msrc(ng),n(ng)/))
269# elif defined RIVERPLUME1
271 IF (
domain(ng)%NorthEast_Test(tile))
THEN
274 sources(ng)%Qshape(is,k)=1.0_r8/real(n(ng),r8)
279# elif defined RIVERPLUME2
284 IF (((istrt.le.i).and.(i.le.iendt)).and. &
285 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
286 IF (vbar(i,j,knew).ne.0.0_r8)
THEN
287 cff=abs(v(i,j,k,nnew)/vbar(i,j,knew))
291 sources(ng)%Qshape(is,k)=cff* &
296 & (z_w(i,j-1,n(ng))- &
305 sources(ng)%Qshape(
nsrc(ng),k)=1.0_r8/real(n(ng),r8)
309 pwrk=reshape(
sources(ng)%Qshape,(/npts/))
311 sources(ng)%Qshape=reshape(pwrk,(/
msrc(ng),n(ng)/))
320 IF (
domain(ng)%NorthEast_Test(tile))
THEN
323 sources(ng)%Qshape(is,k)=1.0_r8/real(n(ng),r8)
340#if defined RIVERPLUME1
342 fac=1.0_r8+tanh((
time(ng)-43200.0_r8)/43200.0_r8)
347 sources(ng)%Qbar(is)=fac*1500.0_r8
358#elif defined RIVERPLUME2
359 DO is=1,(
nsrc(ng)-1)/2
362 IF (((istrt.le.i).and.(i.le.iendt)).and. &
363 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
364 sources(ng)%Qbar(is)=-0.05_r8*om_v(i,j)* &
365 & (0.5_r8*(zeta(i,j-1,knew)+h(i,j-1)+ &
366 & zeta(i ,j,knew)+h(i ,j)))
372 IF (((istrt.le.i).and.(i.le.iendt)).and. &
373 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
374 sources(ng)%Qbar(is)=-0.05_r8*om_v(i,j)* &
375 & (0.5_r8*(zeta(i,j-1,knew)+h(i,j-1)+ &
376 & zeta(i ,j,knew)+h(i ,j)))
386#elif defined SED_TEST1
388 fac=-36.0_r8*10.0_r8*1.0_r8
392 IF (((istrt.le.i).and.(i.le.iendt)).and. &
393 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
394 cff=0.5_r8*(zeta(i-1,j,knew)+h(i-1,j)+ &
395 & zeta(i ,j,knew)+h(i ,j))*on_u(i,j)
397 my_area_west=my_area_west+cff
402 fac=-36.0_r8*10.0_r8*1.0_r8
406 IF (((istrt.le.i).and.(i.le.iendt)).and. &
407 & ((jstrt.le.j).and.(j.le.jendt)))
THEN
408 cff=0.5_r8*(zeta(i-1,j,knew)+h(i-1,j)+ &
409 & zeta(i ,j,knew)+h(i ,j))*on_u(i,j)
411 my_area_east=my_area_east+cff
418 IF (
domain(ng)%SouthWest_Corner(tile).and. &
419 &
domain(ng)%NorthEast_Corner(tile))
THEN
430 area_west=area_west+my_area_west
431 area_east=area_east+my_area_east
457 ana_psource.h: no values provided for qbar.
466 IF (
domain(ng)%NorthEast_Test(tile))
THEN
488# if defined RIVERPLUME1
489 IF (
domain(ng)%NorthEast_Test(tile))
THEN
508# elif defined RIVERPLUME2
509 IF (
domain(ng)%NorthEast_Test(tile))
THEN
524# elif defined SED_TEST1
529 ana_psource.h: no values provided for tsrc.
subroutine ana_psource_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nnew, knew, zeta, ubar, vbar, u, v, z_w, h, on_u, om_v)