85 & LBi, UBi, LBj, UBj, &
86 & IminS, ImaxS, JminS, JmaxS, &
111 integer,
intent(in) :: ng, tile
112 integer,
intent(in) :: LBi, UBi, LBj, UBj
113 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
114 integer,
intent(in) :: nstp, krhs
117 real(r8),
intent(in) :: h(LBi:,LBj:)
118 real(r8),
intent(in) :: pm(LBi:,LBj:)
119 real(r8),
intent(in) :: pn(LBi:,LBj:)
120 real(r8),
intent(in) :: omn(LBi:,LBj:)
122 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
123 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
124 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
125 real(r8),
intent(in) :: rho(LBi:,LBj:,:)
126 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
127 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
128 real(r8),
intent(in) :: wvel(LBi:,LBj:,0:)
130 real(r8),
intent(in) :: ubar(LBi:,LBj:,:)
131 real(r8),
intent(in) :: vbar(LBi:,LBj:,:)
132 real(r8),
intent(in) :: zeta(LBi:,LBj:,:)
134 real(r8),
intent(in) :: h(LBi:UBi,LBj:UBj)
135 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
136 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
137 real(r8),
intent(in) :: omn(LBi:UBi,LBj:UBj)
139 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
140 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
141 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
142 real(r8),
intent(in) :: rho(LBi:UBi,LBj:UBj,N(ng))
143 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
144 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
145 real(r8),
intent(in) :: wvel(LBi:UBi,LBj:UBj,0:N(ng))
147 real(r8),
intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
148 real(r8),
intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
149 real(r8),
intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
154 integer :: NSUB, i, ispace, j, k, trd
155 integer :: idia, istep
156 integer :: my_max_Ci, my_max_Cj, my_max_Ck
159 integer,
parameter :: Nreduce = 5
160 integer,
parameter :: Ncourant = 7
162 integer,
parameter :: Nreduce = 4
163 integer,
parameter :: Ncourant = 5
165 real(r8),
dimension(Nreduce) :: rbuffer
166 real(r8),
dimension(Ncourant) :: Courant
167 character (len=3),
dimension(Nreduce) :: op_handle
168 character (len=6),
dimension(Nreduce) :: C_handle
170 integer :: my_threadnum
173 real(r8) :: cff, my_avgke, my_avgpe, my_volume
174 real(r8) :: my_C , my_max_C
175 real(r8) :: my_Cu, my_max_Cu
176 real(r8) :: my_Cv, my_max_Cv
178 real(r8) :: my_Cw, my_max_Cw
180 real(r8) :: my_maxspeed, u2v2
182 real(r8) :: my_maxrho
184 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ke2d
185 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: pe2d
187 character (len=8 ) :: kechar, pechar, maxvalchar
188 character (len=22) :: DateTime
189 character (len=60) :: frmt
191#include "set_bounds.h"
201 istep=int(mod(real(
iic(ng)-1,r8),1.0e+10_r8))
211 IF (mod(
iic(ng)-1,
ninfo(ng)).eq.0)
THEN
229 pe2d(i,j)=0.5_r8*
g*z_w(i,j,n(ng))*z_w(i,j,n(ng))
234 u2v2=u(i ,j,k,idia)*u(i ,j,k,idia)+ &
235 & u(i+1,j,k,idia)*u(i+1,j,k,idia)+ &
236 & v(i,j ,k,idia)*v(i,j ,k,idia)+ &
237 & v(i,j+1,k,idia)*v(i,j+1,k,idia)
238 ke2d(i,j)=ke2d(i,j)+ &
239 & hz(i,j,k)*0.25_r8*u2v2
240 pe2d(i,j)=pe2d(i,j)+ &
241 & cff*hz(i,j,k)*(rho(i,j,k)+1000.0_r8)* &
242 & (z_r(i,j,k)-z_w(i,j,0))
243 my_cu=0.5_r8*abs(u(i,j,k,idia)+u(i+1,j,k,idia))* &
245 my_cv=0.5_r8*abs(v(i,j,k,idia)+v(i,j+1,k,idia))* &
247 my_cw=0.5_r8*abs(wvel(i,j,k-1)+wvel(i,j,k))* &
249 my_c=my_cu+my_cv+my_cw
250 IF (my_c.gt.my_max_c)
THEN
259 my_maxspeed=max(my_maxspeed,sqrt(0.5_r8*u2v2))
260 my_maxrho=max(my_maxrho,rho(i,j,k))
266 u2v2=ubar(i ,j,idia)*ubar(i ,j,idia)+ &
267 & ubar(i+1,j,idia)*ubar(i+1,j,idia)+ &
268 & vbar(i,j ,idia)*vbar(i,j ,idia)+ &
269 & vbar(i,j+1,idia)*vbar(i,j+1,idia)
270 ke2d(i,j)=(zeta(i,j,idia)+h(i,j))*0.25_r8*u2v2
271 pe2d(i,j)=cff*zeta(i,j,idia)*zeta(i,j,idia)
272 my_cu=0.5_r8*abs(ubar(i,j,idia)+ubar(i+1,j,idia))* &
274 my_cv=0.5_r8*abs(vbar(i,j,idia)+vbar(i,j+1,idia))* &
277 IF (my_c.gt.my_max_c)
THEN
284 my_maxspeed=max(my_maxspeed,sqrt(0.5_r8*u2v2))
298 pe2d(i,jend+1)=0.0_r8
299 pe2d(i,jstr-1)=0.0_r8
300 ke2d(i,jstr-1)=0.0_r8
305 pe2d(i,jend+1)=pe2d(i,jend+1)+ &
306 & omn(i,j)*(z_w(i,j,n(ng))-z_w(i,j,0))
308 pe2d(i,jend+1)=pe2d(i,jend+1)+ &
309 & omn(i,j)*(zeta(i,j,idia)+h(i,j))
311 pe2d(i,jstr-1)=pe2d(i,jstr-1)+omn(i,j)*pe2d(i,j)
312 ke2d(i,jstr-1)=ke2d(i,jstr-1)+omn(i,j)*ke2d(i,j)
319 my_volume=my_volume+pe2d(i,jend+1)
320 my_avgpe =my_avgpe +pe2d(i,jstr-1)
321 my_avgke =my_avgke +ke2d(i,jstr-1)
333 IF (
domain(ng)%SouthWest_Corner(tile).and. &
334 &
domain(ng)%NorthEast_Corner(tile))
THEN
368 IF (my_max_c.eq.
max_c)
THEN
374 ELSE IF (my_max_c.gt.
max_c)
THEN
417 courant(4)=real(
max_ci,r8)
418 courant(5)=real(
max_cj,r8)
421 courant(7)=real(
max_ck,r8)
447 IF (
master.and.(ng.eq.1))
THEN
448 WRITE (
stdout,10)
'TIME-STEP',
'YYYY-MM-DD hh:mm:ss.ss', &
449 &
'KINETIC_ENRG',
'POTEN_ENRG', &
451 &
'TOTAL_ENRG',
'NET_VOLUME',
'Grid'
453 &
'TOTAL_ENRG',
'NET_VOLUME'
456 WRITE (
stdout,20)
'C => (i,j,k)',
'Cu',
'Cv', &
457 &
' Cw ',
'Max Speed'
459 WRITE (
stdout,20)
' C => (i,j)',
'Cu',
'Cv', &
460 &
' C Max',
'Max Speed'
463 10
FORMAT (/,1x,a,1x,a,2x,a,3x,a,4x,a,4x,a,2x,a)
465 10
FORMAT (/,1x,a,1x,a,2x,a,3x,a,4x,a,4x,a)
467 20
FORMAT (21x,a,7x,a,12x,a,10x,a,7x,a,/)
472 WRITE (
stdout,30) istep, datetime, &
480 WRITE (frmt,40) ispace, &
489 WRITE (frmt,40) ispace, &
498 30
FORMAT (i10,1x,a,4(1pe14.6),2x,i2.2)
500 30
FORMAT (i10,1x,a,4(1pe14.6))
502 40
FORMAT (
'(',i2.2,
'x,',a,
',i',i1,
'.',i1,
',', &
503 & a,
',i',i1,
'.',i1,
',', &
505 & a,
',i',i1,
'.',i1,
',', &
507 & a,
',t35,4(1pe13.6,1x))')
512 WRITE (kechar,
'(1pe8.1)')
avgke
513 WRITE (pechar,
'(1pe8.1)')
avgpe
515 IF ((kechar(i:i).eq.
'N').or.(pechar(i:i).eq.
'N').or. &
516 & (kechar(i:i).eq.
'n').or.(pechar(i:i).eq.
'n').or. &
517 & (kechar(i:i).eq.
'*').or.(pechar(i:i).eq.
'*'))
THEN
528 WRITE (maxvalchar,
'(1pe8.1)')
maxspeed(ng)
540 WRITE (maxvalchar,
'(1pe8.1)')
maxrho(ng)