94
95
100
101#ifdef DISTRIBUTE
102
105#endif
106
107 implicit none
108
109
110
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
115
116#ifdef ASSUMED_SHAPE
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:)
121# ifdef SOLVE3D
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:)
129# endif
130 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
131 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
132 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
133#else
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)
138# ifdef SOLVE3D
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))
146# endif
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,:)
150#endif
151
152
153
154 integer :: NSUB, i, ispace, j, k, trd
155 integer :: idia, istep
156 integer :: my_max_Ci, my_max_Cj, my_max_Ck
157#ifdef DISTRIBUTE
158# ifdef SOLVE3D
159 integer, parameter :: Nreduce = 5
160 integer, parameter :: Ncourant = 7
161# else
162 integer, parameter :: Nreduce = 4
163 integer, parameter :: Ncourant = 5
164# endif
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
169#else
170 integer :: my_threadnum
171#endif
172
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
177#ifdef SOLVE3D
178 real(r8) :: my_Cw, my_max_Cw
179#endif
180 real(r8) :: my_maxspeed, u2v2
181#ifdef SOLVE3D
182 real(r8) :: my_maxrho
183#endif
184 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ke2d
185 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: pe2d
186
187 character (len=8 ) :: kechar, pechar, maxvalchar
188 character (len=22) :: DateTime
189 character (len=60) :: frmt
190
191#include "set_bounds.h"
192
193
194
195
196
197
198
199
200
201 istep=int(mod(real(
iic(ng)-1,r8),1.0e+10_r8))
202#ifdef SOLVE3D
203 idia=nstp
204#else
205 idia=krhs
206#endif
208
209
210
211 IF (mod(
iic(ng)-1,
ninfo(ng)).eq.0)
THEN
212 my_max_c =0.0_r8
213 my_max_cu=0.0_r8
214 my_max_cv=0.0_r8
215#ifdef SOLVE3D
216 my_max_cw=0.0_r8
217#endif
218 my_max_ci=0
219 my_max_cj=0
220 my_max_ck=0
221 my_maxspeed=0.0_r8
222#ifdef SOLVE3D
224#endif
225 DO j=jstr,jend
226#ifdef SOLVE3D
227 DO i=istr,iend
228 ke2d(i,j)=0.0_r8
229 pe2d(i,j)=0.5_r8*
g*z_w(i,j,
n(ng))*z_w(i,j,
n(ng))
230 END DO
233 DO i=istr,iend
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
251 my_max_c =my_c
252 my_max_cu=my_cu
253 my_max_cv=my_cv
254 my_max_cw=my_cw
255 my_max_ci=i
256 my_max_cj=j
257 my_max_ck=k
258 END IF
259 my_maxspeed=max(my_maxspeed,sqrt(0.5_r8*u2v2))
260 my_maxrho=max(my_maxrho,rho(i,j,k))
261 END DO
262 END DO
263#else
265 DO i=istr,iend
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))* &
276 my_c=my_cu+my_cv
277 IF (my_c.gt.my_max_c) THEN
278 my_max_c =my_c
279 my_max_cu=my_cu
280 my_max_cv=my_cv
281 my_max_ci=i
282 my_max_cj=j
283 END IF
284 my_maxspeed=max(my_maxspeed,sqrt(0.5_r8*u2v2))
285 END DO
286#endif
287 END DO
288
289
290
291
292
293
294
295
296
297 DO i=istr,iend
298 pe2d(i,jend+1)=0.0_r8
299 pe2d(i,jstr-1)=0.0_r8
300 ke2d(i,jstr-1)=0.0_r8
301 END DO
302 DO j=jstr,jend
303 DO i=istr,iend
304#ifdef SOLVE3D
305 pe2d(i,jend+1)=pe2d(i,jend+1)+ &
306 & omn(i,j)*(z_w(i,j,
n(ng))-z_w(i,j,0))
307#else
308 pe2d(i,jend+1)=pe2d(i,jend+1)+ &
309 & omn(i,j)*(zeta(i,j,idia)+h(i,j))
310#endif
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)
313 END DO
314 END DO
315 my_volume=0.0_r8
316 my_avgpe=0.0_r8
317 my_avgke=0.0_r8
318 DO i=istr,iend
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)
322 END DO
323
324
325
326
327
328
329
330#ifdef DISTRIBUTE
331 nsub=1
332#else
333 IF (
domain(ng)%SouthWest_Corner(tile).and. &
334 &
domain(ng)%NorthEast_Corner(tile))
THEN
335 nsub=1
336 ELSE
338 END IF
339#endif
340
341
342
343
344
345
346#ifdef SOLVE3D
347
348#endif
349
350
351
352#ifdef SOLVE3D
353
354#endif
355
356
357#ifdef SOLVE3D
358
359#endif
360
365#ifdef SOLVE3D
367#endif
368 IF (my_max_c.eq.
max_c)
THEN
371#ifdef SOLVE3D
373#endif
374 ELSE IF (my_max_c.gt.
max_c)
THEN
378#ifdef SOLVE3D
380#endif
383#ifdef SOLVE3D
385#endif
386 END IF
390#ifdef DISTRIBUTE
395# ifdef SOLVE3D
397# endif
398 op_handle(1)='SUM'
399 op_handle(2)='SUM'
400 op_handle(3)='SUM'
401 op_handle(4)='MAX'
402# ifdef SOLVE3D
403 op_handle(5)='MAX'
404# endif
410# ifdef SOLVE3D
412# endif
413
417 courant(4)=real(
max_ci,r8)
418 courant(5)=real(
max_cj,r8)
419# ifdef SOLVE3D
421 courant(7)=real(
max_ck,r8)
422# endif
423 c_handle(1)='MAXLOC'
430# ifdef SOLVE3D
433# endif
434
436#else
438#endif
442
443
444
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', &
450#ifdef NESTING
451 & 'TOTAL_ENRG', 'NET_VOLUME', 'Grid'
452#else
453 & 'TOTAL_ENRG', 'NET_VOLUME'
454#endif
455#ifdef SOLVE3D
456 WRITE (
stdout,20)
'C => (i,j,k)',
'Cu',
'Cv', &
457 & ' Cw ', 'Max Speed'
458#else
459 WRITE (
stdout,20)
' C => (i,j)',
'Cu',
'Cv', &
460 & ' C Max', 'Max Speed'
461#endif
462#ifdef NESTING
463 10 FORMAT (/,1x,a,1x,a,2x,a,3x,a,4x,a,4x,a,2x,a)
464#else
465 10 FORMAT (/,1x,a,1x,a,2x,a,3x,a,4x,a,4x,a)
466#endif
467 20 FORMAT (21x,a,7x,a,12x,a,10x,a,7x,a,/)
468 END IF
469 END IF
470
472 WRITE (
stdout,30) istep, datetime, &
473#ifdef NESTING
475#else
477#endif
478#ifdef SOLVE3D
480 WRITE (frmt,40) ispace, &
487#else
489 WRITE (frmt,40) ispace, &
495#endif
497#ifdef NESTING
498 30 FORMAT (i10,1x,a,4(1pe14.6),2x,i2.2)
499#else
500 30 FORMAT (i10,1x,a,4(1pe14.6))
501#endif
502 40 FORMAT ('(',i2.2,'x,',a,',i',i1,'.',i1,',', &
503 & a,',i',i1,'.',i1,',', &
504#ifdef SOLVE3D
505 & a,',i',i1,'.',i1,',', &
506#endif
507 & a,',t35,4(1pe13.6,1x))')
508 END IF
509
510
511
512 WRITE (kechar,
'(1pe8.1)')
avgke
513 WRITE (pechar,
'(1pe8.1)')
avgpe
514 DO i=1,8
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
520 END IF
521 END DO
522
523
524
525
528 WRITE (maxvalchar,
'(1pe8.1)')
maxspeed(ng)
530 END IF
531#ifdef SOLVE3D
532
533
534
535
536
537
540 WRITE (maxvalchar,
'(1pe8.1)')
maxrho(ng)
542 END IF
543#endif
544
545
546
551#ifdef SOLVE3D
553#endif
557#ifdef SOLVE3D
559#endif
562#ifdef SOLVE3D
564#endif
565 END IF
566
567 END IF
568
569 RETURN
integer function my_threadnum()
subroutine mp_reduce2(ng, model, isize, jsize, a, handle_op, inpcomm)
integer, dimension(:), allocatable n
integer, dimension(:), allocatable ntilex
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable ntilee
integer, dimension(:), allocatable ninfo
real(dp), parameter spval
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
real(dp), dimension(:), allocatable maxrho
real(dp), parameter large
integer, dimension(:), allocatable idigits
integer, dimension(:), allocatable first_time
character(len=22), dimension(:), allocatable time_code
integer, dimension(:), allocatable kdigits
character(len=80) blowup_string
integer, dimension(:), allocatable jdigits
real(dp), dimension(:), allocatable maxspeed