191
192
196
198# ifdef DISTRIBUTE
200# endif
202
203
204
205 integer, intent(in) :: ng, tile
206 integer, intent(in) :: LBi, UBi, LBj, UBj
207 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
208 integer, intent(in) :: nrhs, nstp, nnew
209
210# ifdef ASSUMED_SHAPE
211# ifdef MASKING
212 real(r8), intent(in) :: rmask(LBi:,LBj:)
213 real(r8), intent(in) :: umask(LBi:,LBj:)
214 real(r8), intent(in) :: vmask(LBi:,LBj:)
215# if defined SOLAR_SOURCE && defined WET_DRY
216 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
217# endif
218# endif
219 real(r8), intent(in) :: pm(LBi:,LBj:)
220 real(r8), intent(in) :: pn(LBi:,LBj:)
221 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
222 real(r8), intent(in) :: Huon(LBi:,LBj:,:)
223 real(r8), intent(in) :: Hvom(LBi:,LBj:,:)
224 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
225 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
226# ifdef SOLAR_SOURCE
227 real(r8), intent(in) :: srflx(LBi:,LBj:)
228# endif
229# ifdef SUN
230 real(r8), intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
231# else
232 real(r8), intent(in) :: Akt(LBi:,LBj:,0:,:)
233# endif
234 real(r8), intent(in) :: Akv(LBi:,LBj:,0:)
235 real(r8), intent(in) :: W(LBi:,LBj:,0:)
236# ifdef SUN
237 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
238# else
239 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
240# endif
241 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
242 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
243
244 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
245 real(r8), intent(in) :: tl_Huon(LBi:,LBj:,:)
246 real(r8), intent(in) :: tl_Hvom(LBi:,LBj:,:)
247 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
248 real(r8), intent(in) :: tl_z_w(LBi:,LBj:,0:)
249 real(r8), intent(in) :: btflx(LBi:,LBj:,:)
250 real(r8), intent(in) :: bustr(LBi:,LBj:)
251 real(r8), intent(in) :: bvstr(LBi:,LBj:)
252 real(r8), intent(in) :: stflx(LBi:,LBj:,:)
253 real(r8), intent(in) :: sustr(LBi:,LBj:)
254 real(r8), intent(in) :: svstr(LBi:,LBj:)
255 real(r8), intent(in) :: tl_ru(LBi:,LBj:,0:,:)
256 real(r8), intent(in) :: tl_rv(LBi:,LBj:,0:,:)
257# ifdef TL_IOMS
258 real(r8), intent(in) :: tl_btflx(LBi:,LBj:,:)
259 real(r8), intent(in) :: tl_bustr(LBi:,LBj:)
260 real(r8), intent(in) :: tl_bvstr(LBi:,LBj:)
261 real(r8), intent(in) :: tl_stflx(LBi:,LBj:,:)
262 real(r8), intent(in) :: tl_sustr(LBi:,LBj:)
263 real(r8), intent(in) :: tl_svstr(LBi:,LBj:)
264# endif
265# ifdef LMD_NONLOCAL_NOT_YET
266 real(r8), intent(in) :: tl_ghats(LBi:,LBj:,0:,:)
267# endif
268# ifdef SUN
269 real(r8), intent(in) :: tl_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
270# else
271 real(r8), intent(in) :: tl_Akt(LBi:,LBj:,0:,:)
272# endif
273 real(r8), intent(in) :: tl_Akv(LBi:,LBj:,0:)
274 real(r8), intent(in) :: tl_W(LBi:,LBj:,0:)
275
276# ifdef DIAGNOSTICS_TS
277
278# endif
279# ifdef DIAGNOSTICS_UV
280
281
282
283
284# endif
285# ifdef SUN
286 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
287# else
288 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
289# endif
290 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
291 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
292
293# else
294
295# ifdef MASKING
296 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
297 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
298 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
299# if defined SOLAR_SOURCE && defined WET_DRY
300 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
301# endif
302# endif
303 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
304 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
305 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
306 real(r8), intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
307 real(r8), intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
308 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
309 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
310# ifdef SOLAR_SOURCE
311 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
312# endif
313 real(r8), intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
314 real(r8), intent(in) :: Akv(LBi:UBi,LBj:UBj,0:N(ng))
315 real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
316 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
317 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
318 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
319
320 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
321 real(r8), intent(in) :: tl_Huon(LBi:UBi,LBj:UBj,N(ng))
322 real(r8), intent(in) :: tl_Hvom(LBi:UBi,LBj:UBj,N(ng))
323 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
324 real(r8), intent(in) :: tl_z_w(LBi:UBi,LBj:UBj,0:N(ng))
325 real(r8), intent(in) :: btflx(LBi:UBi,LBj:UBj,NT(ng))
326 real(r8), intent(in) :: bustr(LBi:UBi,LBj:UBj)
327 real(r8), intent(in) :: bvstr(LBi:UBi,LBj:UBj)
328 real(r8), intent(in) :: stflx(LBi:UBi,LBj:UBj,NT(ng))
329 real(r8), intent(in) :: sustr(LBi:UBi,LBj:UBj)
330 real(r8), intent(in) :: svstr(LBi:UBi,LBj:UBj)
331 real(r8), intent(in) :: tl_ru(LBi:UBi,LBj:UBj,0:N(ng),2)
332 real(r8), intent(in) :: tl_rv(LBi:UBi,LBj:UBj,0:N(ng),2)
333# ifdef TL_IOMS
334 real(r8), intent(in) :: tl_btflx(LBi:UBi,LBj:UBj,NT(ng))
335 real(r8), intent(in) :: tl_bustr(LBi:UBi,LBj:UBj)
336 real(r8), intent(in) :: tl_bvstr(LBi:UBi,LBj:UBj)
337 real(r8), intent(in) :: tl_stflx(LBi:UBi,LBj:UBj,NT(ng))
338 real(r8), intent(in) :: tl_sustr(LBi:UBi,LBj:UBj)
339 real(r8), intent(in) :: tl_svstr(LBi:UBi,LBj:UBj)
340# endif
341# ifdef LMD_NONLOCAL_NOT_YET
342 real(r8), intent(in) :: ghats(LBi:UBi,LBj:UBj,0:N(ng),NAT)
343# endif
344 real(r8), intent(in) :: tl_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
345 real(r8), intent(in) :: tl_Akv(LBi:UBi,LBj:UBj,0:N(ng))
346 real(r8), intent(in) :: tl_W(LBi:UBi,LBj:UBj,0:N(ng))
347
348# ifdef DIAGNOSTICS_TS
349
350
351# endif
352# ifdef DIAGNOSTICS_UV
353
354
355
356
357# endif
358 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
359 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
360 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
361# endif
362
363
364
365 integer :: Isrc, Jsrc
366 integer :: i, ic, indx, is, itrc, j, k, ltrc
367# if defined AGE_MEAN && defined T_PASSIVE
368 integer :: iage
369# endif
370# if defined DIAGNOSTICS_TS || defined DIAGNOSTICS_UV
371 integer :: idiag
372# endif
373 real(r8), parameter :: eps = 1.0e-16_r8
374
375 real(r8) :: cff, cff1, cff2, cff3, cff4
376 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3, tl_cff4
377 real(r8) :: Gamma
378
379 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
380 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
381 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
382
383 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_CF
384 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_DC
385 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_FC
386
387# ifdef SOLAR_SOURCE
388 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: tl_swdk
389# endif
390
391 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE
392 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX
393 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: curv
394 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: grad
395
396 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
397 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
398 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_curv
399 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
400
401# include "set_bounds.h"
402
403# ifndef TS_FIXED
404
405
406
407
408
409# ifdef SOLAR_SOURCE
410
411
412
413
415 DO j=jstr,jend
416 DO i=istr,iend
417 fx(i,j)=z_w(i,j,
n(ng))-z_w(i,j,k)
418 tl_fx(i,j)=tl_z_w(i,j,
n(ng))-tl_z_w(i,j,k)
419 END DO
420 END DO
421
422
423
424
425
427 & lbi, ubi, lbj, ubj, &
428 & imins, imaxs, jmins, jmaxs, &
429 & -1.0_r8, fx, tl_fx, tl_fe)
430 DO j=jstr,jend
431 DO i=istr,iend
432
433
434 tl_swdk(i,j,k)=tl_fe(i,j)
435 END DO
436 END DO
437 END DO
438# endif
439
440
441
442
443
444
445
446
447 t_loop1 :
DO itrc=1,
nt(ng)
448 k_loop :
DO k=1,
n(ng)
449
451
452
453
454 DO j=jstr,jend
455 DO i=istr,iend+1
456 fx(i,j)=huon(i,j,k)* &
457 & 0.5_r8*(t(i-1,j,k,nstp,itrc)+ &
458 & t(i ,j,k,nstp,itrc))
459 tl_fx(i,j)=0.5_r8* &
460 & (tl_huon(i,j,k)* &
461 & (t(i-1,j,k,nstp,itrc)+ &
462 & t(i ,j,k,nstp,itrc))+ &
463 & huon(i,j,k)* &
464 & (tl_t(i-1,j,k,nstp,itrc)+ &
465 & tl_t(i ,j,k,nstp,itrc)))- &
466# ifdef TL_IOMS
467 & fx(i,j)
468# endif
469 END DO
470 END DO
471 DO j=jstr,jend+1
472 DO i=istr,iend
473 fe(i,j)=hvom(i,j,k)* &
474 & 0.5_r8*(t(i,j-1,k,nstp,itrc)+ &
475 & t(i,j ,k,nstp,itrc))
476 tl_fe(i,j)=0.5_r8* &
477 & (tl_hvom(i,j,k)* &
478 & (t(i,j-1,k,nstp,itrc)+ &
479 & t(i,j ,k,nstp,itrc))+ &
480 & hvom(i,j,k)* &
481 & (tl_t(i,j-1,k,nstp,itrc)+ &
482 & tl_t(i,j ,k,nstp,itrc)))- &
483# ifdef TL_IOMS
484 & fe(i,j)
485# endif
486 END DO
487 END DO
488
491
492
493
494 DO j=jstr,jend
495 DO i=istr,iend+1
496 cff1=max(huon(i,j,k),0.0_r8)
497 cff2=min(huon(i,j,k),0.0_r8)
498 tl_cff1=(0.5_r8+sign(0.5_r8, huon(i,j,k)))* &
499 & tl_huon(i,j,k)
500 tl_cff2=(0.5_r8+sign(0.5_r8,-huon(i,j,k)))* &
501 & tl_huon(i,j,k)
502 fx(i,j)=cff1*t(i-1,j,k,nstp,itrc)+ &
503 & cff2*t(i ,j,k,nstp,itrc)
504 tl_fx(i,j)=tl_cff1*t(i-1,j,k,nstp,itrc)+ &
505 & cff1*tl_t(i-1,j,k,nstp,itrc)+ &
506 & tl_cff2*t(i ,j,k,nstp,itrc)+ &
507 & cff2*tl_t(i ,j,k,nstp,itrc)- &
508# ifdef TL_IOMS
509 & fx(i,j)
510# endif
511 END DO
512 END DO
513 DO j=jstr,jend+1
514 DO i=istr,iend
515 cff1=max(hvom(i,j,k),0.0_r8)
516 cff2=min(hvom(i,j,k),0.0_r8)
517 tl_cff1=(0.5_r8+sign(0.5_r8, hvom(i,j,k)))* &
518 & tl_hvom(i,j,k)
519 tl_cff2=(0.5_r8+sign(0.5_r8,-hvom(i,j,k)))* &
520 & tl_hvom(i,j,k)
521 fe(i,j)=cff1*t(i,j-1,k,nstp,itrc)+ &
522 & cff2*t(i,j ,k,nstp,itrc)
523 tl_fe(i,j)=tl_cff1*t(i,j-1,k,nstp,itrc)+ &
524 & cff1*tl_t(i,j-1,k,nstp,itrc)+ &
525 & tl_cff2*t(i,j ,k,nstp,itrc)+ &
526 & cff2*tl_t(i,j ,k,nstp,itrc)- &
527# ifdef TL_IOMS
528 & fe(i,j)
529# endif
530 END DO
531 END DO
532
537
538
539
540
541 DO j=jstr,jend
542 DO i=istrm1,iendp2
543 fx(i,j)=t(i ,j,k,nstp,itrc)- &
544 & t(i-1,j,k,nstp,itrc)
545 tl_fx(i,j)=tl_t(i ,j,k,nstp,itrc)- &
546 & tl_t(i-1,j,k,nstp,itrc)
547# ifdef MASKING
548 fx(i,j)=fx(i,j)*umask(i,j)
549 tl_fx(i,j)=tl_fx(i,j)*umask(i,j)
550# endif
551 END DO
552 END DO
554 IF (
domain(ng)%Western_Edge(tile))
THEN
555 DO j=jstr,jend
556 fx(istr-1,j)=fx(istr,j)
557 tl_fx(istr-1,j)=tl_fx(istr,j)
558 END DO
559 END IF
560 END IF
562 IF (
domain(ng)%Eastern_Edge(tile))
THEN
563 DO j=jstr,jend
564 fx(iend+2,j)=fx(iend+1,j)
565 tl_fx(iend+2,j)=tl_fx(iend+1,j)
566 END DO
567 END IF
568 END IF
569
570 DO j=jstr,jend
571 DO i=istr-1,iend+1
573 curv(i,j)=fx(i+1,j)-fx(i,j)
574 tl_curv(i,j)=tl_fx(i+1,j)-tl_fx(i,j)
576 cff=2.0_r8*fx(i+1,j)*fx(i,j)
577 tl_cff=2.0_r8*(tl_fx(i+1,j)*fx(i,j)+ &
578 & fx(i+1,j)*tl_fx(i,j))- &
579# ifdef TL_IOMS
580 & cff
581# endif
582 IF (cff.gt.eps) THEN
583 grad(i,j)=cff/(fx(i+1,j)+fx(i,j))
584 tl_grad(i,j)=((fx(i+1,j)+fx(i,j))*tl_cff- &
585 & cff*(tl_fx(i+1,j)+tl_fx(i,j)))/ &
586 & ((fx(i+1,j)+fx(i,j))* &
587 & (fx(i+1,j)+fx(i,j)))+ &
588# ifdef TL_IOMS
589 & grad(i,j)
590# endif
591 ELSE
592 grad(i,j)=0.0_r8
593 tl_grad(i,j)=0.0_r8
594 END IF
597 grad(i,j)=0.5_r8*(fx(i+1,j)+fx(i,j))
598 tl_grad(i,j)=0.5_r8*(tl_fx(i+1,j)+tl_fx(i,j))
599 END IF
600 END DO
601 END DO
602
603 cff1=1.0_r8/6.0_r8
604 cff2=1.0_r8/3.0_r8
605 DO j=jstr,jend
606 DO i=istr,iend+1
608 fx(i,j)=huon(i,j,k)*0.5_r8* &
609 & (t(i-1,j,k,nstp,itrc)+ &
610 & t(i ,j,k,nstp,itrc))- &
611 & cff1*(curv(i-1,j)*max(huon(i,j,k),0.0_r8)+ &
612 & curv(i ,j)*min(huon(i,j,k),0.0_r8))
613 tl_fx(i,j)=0.5_r8* &
614 & (tl_huon(i,j,k)* &
615 & (t(i-1,j,k,nstp,itrc)+ &
616 & t(i ,j,k,nstp,itrc))+ &
617 & huon(i,j,k)* &
618 & (tl_t(i-1,j,k,nstp,itrc)+ &
619 & tl_t(i ,j,k,nstp,itrc)))- &
620 & cff1* &
621 & (tl_curv(i-1,j)*max(huon(i,j,k),0.0_r8)+ &
622 & curv(i-1,j)* &
623 & (0.5_r8+sign(0.5_r8, huon(i,j,k)))* &
624 & tl_huon(i,j,k)+ &
625 & tl_curv(i ,j)*min(huon(i,j,k),0.0_r8)+ &
626 & curv(i ,j)* &
627 & (0.5_r8+sign(0.5_r8,-huon(i,j,k)))* &
628 & tl_huon(i,j,k))- &
629# ifdef TL_IOMS
630 & fx(i,j)
631# endif
635 fx(i,j)=huon(i,j,k)*0.5_r8* &
636 & (t(i-1,j,k,nstp,itrc)+ &
637 & t(i ,j,k,nstp,itrc)- &
638 & cff2*(grad(i ,j)- &
639 & grad(i-1,j)))
640 tl_fx(i,j)=0.5_r8* &
641 & (tl_huon(i,j,k)* &
642 & (t(i-1,j,k,nstp,itrc)+ &
643 & t(i ,j,k,nstp,itrc)- &
644 & cff2*(grad(i ,j)- &
645 & grad(i-1,j)))+ &
646 & huon(i,j,k)* &
647 & (tl_t(i-1,j,k,nstp,itrc)+ &
648 & tl_t(i ,j,k,nstp,itrc)- &
649 & cff2*(tl_grad(i ,j)- &
650 & tl_grad(i-1,j))))- &
651# ifdef TL_IOMS
652 & fx(i,j)
653# endif
654 END IF
655 END DO
656 END DO
657
658 DO j=jstrm1,jendp2
659 DO i=istr,iend
660 fe(i,j)=t(i,j ,k,nstp,itrc)- &
661 & t(i,j-1,k,nstp,itrc)
662 tl_fe(i,j)=tl_t(i,j ,k,nstp,itrc)- &
663 & tl_t(i,j-1,k,nstp,itrc)
664# ifdef MASKING
665 fe(i,j)=fe(i,j)*vmask(i,j)
666 tl_fe(i,j)=tl_fe(i,j)*vmask(i,j)
667# endif
668 END DO
669 END DO
671 IF (
domain(ng)%Southern_Edge(tile))
THEN
672 DO i=istr,iend
673 fe(i,jstr-1)=fe(i,jstr)
674 tl_fe(i,jstr-1)=tl_fe(i,jstr)
675 END DO
676 END IF
677 END IF
679 IF (
domain(ng)%Northern_Edge(tile))
THEN
680 DO i=istr,iend
681 fe(i,jend+2)=fe(i,jend+1)
682 tl_fe(i,jend+2)=tl_fe(i,jend+1)
683 END DO
684 END IF
685 END IF
686
687 DO j=jstr-1,jend+1
688 DO i=istr,iend
690 curv(i,j)=fe(i,j+1)-fe(i,j)
691 tl_curv(i,j)=tl_fe(i,j+1)-tl_fe(i,j)
693 cff=2.0_r8*fe(i,j+1)*fe(i,j)
694 tl_cff=2.0_r8*(tl_fe(i,j+1)*fe(i,j)+ &
695 & fe(i,j+1)*tl_fe(i,j))- &
696# ifdef TL_IOMS
697 & cff
698# endif
699 IF (cff.gt.eps) THEN
700 grad(i,j)=cff/(fe(i,j+1)+fe(i,j))
701 tl_grad(i,j)=((fe(i,j+1)+fe(i,j))*tl_cff- &
702 & cff*(tl_fe(i,j+1)+tl_fe(i,j)))/ &
703 & ((fe(i,j+1)+fe(i,j))* &
704 & (fe(i,j+1)+fe(i,j)))+ &
705# ifdef TL_IOMS
706 & grad(i,j)
707# endif
708 ELSE
709 grad(i,j)=0.0_r8
710 tl_grad(i,j)=0.0_r8
711 END IF
714 grad(i,j)=0.5_r8*(fe(i,j+1)+fe(i,j))
715 tl_grad(i,j)=0.5_r8*(tl_fe(i,j+1)+tl_fe(i,j))
716 END IF
717 END DO
718 END DO
719
720 cff1=1.0_r8/6.0_r8
721 cff2=1.0_r8/3.0_r8
722 DO j=jstr,jend+1
723 DO i=istr,iend
725 fe(i,j)=hvom(i,j,k)*0.5_r8* &
726 & (t(i,j-1,k,nstp,itrc)+ &
727 & t(i,j ,k,nstp,itrc))- &
728 & cff1*(curv(i,j-1)*max(hvom(i,j,k),0.0_r8)+ &
729 & curv(i,j )*min(hvom(i,j,k),0.0_r8))
730 tl_fe(i,j)=0.5_r8* &
731 & (tl_hvom(i,j,k)* &
732 & (t(i,j-1,k,nstp,itrc)+ &
733 & t(i,j ,k,nstp,itrc))+ &
734 & hvom(i,j,k)* &
735 & (tl_t(i,j-1,k,nstp,itrc)+ &
736 & tl_t(i,j ,k,nstp,itrc)))- &
737 & cff1* &
738 & (tl_curv(i,j-1)*max(hvom(i,j,k),0.0_r8)+ &
739 & curv(i,j-1)* &
740 & (0.5_r8+sign(0.5_r8, hvom(i,j,k)))* &
741 & tl_hvom(i,j,k)+ &
742 & tl_curv(i,j )*min(hvom(i,j,k),0.0_r8)+ &
743 & curv(i,j )* &
744 & (0.5_r8+sign(0.5_r8,-hvom(i,j,k)))* &
745 & tl_hvom(i,j,k))- &
746# ifdef TL_IOMS
747 & fe(i,j)
748# endif
752 fe(i,j)=hvom(i,j,k)*0.5_r8* &
753 & (t(i,j-1,k,nstp,itrc)+ &
754 & t(i,j ,k,nstp,itrc)- &
755 & cff2*(grad(i,j )- &
756 & grad(i,j-1)))
757 tl_fe(i,j)=0.5_r8* &
758 & (tl_hvom(i,j,k)* &
759 & (t(i,j-1,k,nstp,itrc)+ &
760 & t(i,j ,k,nstp,itrc)- &
761 & cff2*(grad(i,j )- &
762 & grad(i,j-1)))+ &
763 & hvom(i,j,k)* &
764 & (tl_t(i,j-1,k,nstp,itrc)+ &
765 & tl_t(i,j ,k,nstp,itrc)- &
766 & cff2*(tl_grad(i,j )- &
767 & tl_grad(i,j-1))))- &
768# ifdef TL_IOMS
769 & fe(i,j)
770# endif
771 END IF
772 END DO
773 END DO
774 END IF hadv_flux
775
776
777
778
779
780
781
786 IF (((istr.le.isrc).and.(isrc.le.iend+1)).and. &
787 & ((jstr.le.jsrc).and.(jsrc.le.jend+1))) THEN
788 IF (int(
sources(ng)%Dsrc(is)).eq.0)
THEN
790 fx(isrc,jsrc)=huon(isrc,jsrc,k)* &
792 tl_fx(isrc,jsrc)=tl_huon(isrc,jsrc,k)* &
793 &
sources(ng)%Tsrc(is,k,itrc)+ &
794 & huon(isrc,jsrc,k)* &
795 &
sources(ng)%tl_Tsrc(is,k,itrc)- &
796# ifdef TL_IOMS
797 & fx(isrc,jsrc)
798# endif
799 ELSE
800
801
802 tl_fx(isrc,jsrc)=0.0_r8
803 END IF
804 ELSE IF (int(
sources(ng)%Dsrc(is)).eq.1)
THEN
806 fe(isrc,jsrc)=hvom(isrc,jsrc,k)* &
808 tl_fe(isrc,jsrc)=tl_hvom(isrc,jsrc,k)* &
809 &
sources(ng)%Tsrc(is,k,itrc)+ &
810 & hvom(isrc,jsrc,k)* &
811 &
sources(ng)%tl_Tsrc(is,k,itrc)- &
812# ifdef TL_IOMS
813 & fe(isrc,jsrc)
814# endif
815 ELSE
816
817
818 tl_fe(isrc,jsrc)=0.0_r8
819 END IF
820 END IF
821 END IF
822 END DO
823 END IF
824
825
826
829 gamma=0.5_r8
830 ELSE
831 gamma=1.0_r8/6.0_r8
832 END IF
835 cff1=1.0_r8
836 cff2=0.0_r8
837 ELSE
838 cff=(1.0_r8-gamma)*
dt(ng)
839 cff1=0.5_r8+gamma
840 cff2=0.5_r8-gamma
841 END IF
842 DO j=jstr,jend
843 DO i=istr,iend
844
845
846
847
848
849
850 tl_t(i,j,k,3,itrc)=tl_hz(i,j,k)* &
851 & (cff1*t(i,j,k,nstp,itrc)+ &
852 & cff2*t(i,j,k,nnew,itrc))+ &
853 & hz(i,j,k)* &
854 & (cff1*tl_t(i,j,k,nstp,itrc)+ &
855 & cff2*tl_t(i,j,k,nnew,itrc))- &
856 & cff*pm(i,j)*pn(i,j)* &
857 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
858 & tl_fe(i,j+1)-tl_fe(i,j))- &
859# ifdef TL_IOMS
860 & hz(i,j,k)*(cff1*t(i,j,k,nstp,itrc)+ &
861 & cff2*t(i,j,k,nnew,itrc))
862# endif
863 END DO
864 END DO
865 END DO k_loop
866 END DO t_loop1
867
868# if defined AGE_MEAN && defined T_PASSIVE
869
870
871
872
873
874
880 ELSE
881 gamma=1.0_r8/6.0_r8
882 cff=(1.0_r8-gamma)*
dt(ng)
883 END IF
886 DO j=jstr,jend
887 DO i=istr,iend
888
889
890
891
892 tl_t(i,j,k,3,iage)=tl_t(i,j,k,3,iage)+ &
893 & cff* &
894 & (hz(i,j,k)* &
895 & tl_t(i,j,k,nnew,
inert(itrc))+ &
896 & tl_hz(i,j,k)* &
897 & t(i,j,k,nnew,
inert(itrc)))- &
898# ifdef TL_IOMS
899 & cff*hz(i,j,k)* &
900 & t(i,j,k,nnew,
inert(itrc))
901# endif
902 END DO
903 END DO
904 END DO
905 END IF
906 END DO
907# endif
908
909
910
911
912
913
914 j_loop1 : DO j=jstr,jend
915 t_loop2 :
DO itrc=1,
nt(ng)
916
918
919
920
921
922 DO i=istr,iend
923# ifdef NEUMANN
924 fc(i,0)=1.5_r8*t(i,j,1,nstp,itrc)
925 cf(i,1)=0.5_r8
926# else
927 fc(i,0)=2.0_r8*t(i,j,1,nstp,itrc)
928 cf(i,1)=1.0_r8
929# endif
930 END DO
932 DO i=istr,iend
933 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
934 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
935 cf(i,k+1)=cff*hz(i,j,k)
936 fc(i,k)=cff*(3.0_r8*(hz(i,j,k )*t(i,j,k+1,nstp,itrc)+ &
937 & hz(i,j,k+1)*t(i,j,k ,nstp,itrc))- &
938 & hz(i,j,k+1)*fc(i,k-1))
939 END DO
940 END DO
941 DO i=istr,iend
942# ifdef NEUMANN
943 fc(i,
n(ng))=(3.0_r8*t(i,j,
n(ng),nstp,itrc)- &
944 & fc(i,
n(ng)-1))/(2.0_r8-cf(i,
n(ng)))
945# else
946 fc(i,
n(ng))=(2.0_r8*t(i,j,
n(ng),nstp,itrc)- &
947 & fc(i,
n(ng)-1))/(1.0_r8-cf(i,
n(ng)))
948# endif
949 END DO
951 DO i=istr,iend
952 fc(i,k)=fc(i,k)-cf(i,k+1)*fc(i,k+1)
953 END DO
954 END DO
955
956
957
958 DO i=istr,iend
959# ifdef NEUMANN
960
961
962 tl_fc(i,0)=1.5_r8*tl_t(i,j,1,nstp,itrc)
963 cf(i,1)=0.5_r8
964# else
965
966
967 tl_fc(i,0)=2.0_r8*tl_t(i,j,1,nstp,itrc)
968 cf(i,1)=1.0_r8
969# endif
970 END DO
972 DO i=istr,iend
973 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
974 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
975 cf(i,k+1)=cff*hz(i,j,k)
976# ifdef TL_IOMS
977 tl_fc(i,k)=cff* &
978 & (3.0_r8*(hz(i,j,k )* &
979 & tl_t(i,j,k+1,nstp,itrc)+ &
980 & hz(i,j,k+1)* &
981 & tl_t(i,j,k ,nstp,itrc)+ &
982 & tl_hz(i,j,k )* &
983 & t(i,j,k+1,nstp,itrc)+ &
984 & tl_hz(i,j,k+1)* &
985 & t(i,j,k ,nstp,itrc)- &
986 & hz(i,j,k )*t(i,j,k+1,nstp,itrc)- &
987 & hz(i,j,k+1)*t(i,j,k ,nstp,itrc))- &
988 & ((tl_hz(i,j,k+1)-hz(i,j,k+1))*fc(i,k-1)+ &
989 & 2.0_r8*(tl_hz(i,j,k )+ &
990 & tl_hz(i,j,k+1)- &
991 & hz(i,j,k )- &
992 & hz(i,j,k+1))*fc(i,k)+ &
993 & (tl_hz(i,j,k )-hz(i,j,k ))*fc(i,k+1))- &
994 & hz(i,j,k+1)*tl_fc(i,k-1))
995# else
996 tl_fc(i,k)=cff* &
997 & (3.0_r8*(hz(i,j,k )* &
998 & tl_t(i,j,k+1,nstp,itrc)+ &
999 & hz(i,j,k+1)* &
1000 & tl_t(i,j,k ,nstp,itrc)+ &
1001 & tl_hz(i,j,k )* &
1002 & t(i,j,k+1,nstp,itrc)+ &
1003 & tl_hz(i,j,k+1)* &
1004 & t(i,j,k ,nstp,itrc))- &
1005 & (tl_hz(i,j,k+1)*fc(i,k-1)+ &
1006 & 2.0_r8*(tl_hz(i,j,k )+ &
1007 & tl_hz(i,j,k+1))*fc(i,k)+ &
1008 & tl_hz(i,j,k )*fc(i,k+1))- &
1009 & hz(i,j,k+1)*tl_fc(i,k-1))
1010# endif
1011 END DO
1012 END DO
1013 DO i=istr,iend
1014# ifdef NEUMANN
1015
1016
1017
1018 tl_fc(i,
n(ng))=(3.0_r8*tl_t(i,j,
n(ng),nstp,itrc)- &
1019 & tl_fc(i,
n(ng)-1))/ &
1020 & (2.0_r8-cf(i,
n(ng)))
1021# else
1022
1023
1024
1025 tl_fc(i,
n(ng))=(2.0_r8*tl_t(i,j,
n(ng),nstp,itrc)- &
1026 & tl_fc(i,
n(ng)-1))/ &
1027 & (1.0_r8-cf(i,
n(ng)))
1028# endif
1029 END DO
1031 DO i=istr,iend
1032
1033
1034 tl_fc(i,k)=tl_fc(i,k)-cf(i,k+1)*tl_fc(i,k+1)
1035
1036
1037 tl_fc(i,k+1)=tl_w(i,j,k+1)*fc(i,k+1)+ &
1038 & w(i,j,k+1)*tl_fc(i,k+1)- &
1039# ifdef TL_IOMS
1040 & w(i,j,k+1)*fc(i,k+1)
1041# endif
1042 END DO
1043 END DO
1044 DO i=istr,iend
1045
1046
1047 tl_fc(i,
n(ng))=0.0_r8
1048
1049
1050 tl_fc(i,0)=0.0_r8
1051 END DO
1052
1053
1054
1056 DO i=istr,iend
1057 fc(i,k+1)=w(i,j,k+1)*fc(i,k+1)
1058 END DO
1059 END DO
1060 DO i=istr,iend
1062 fc(i,0)=0.0_r8
1063 END DO
1064
1066
1067
1068
1070 DO i=istr,iend
1071 fc(i,k)=t(i,j,k+1,nstp,itrc)- &
1072 & t(i,j,k ,nstp,itrc)
1073 tl_fc(i,k)=tl_t(i,j,k+1,nstp,itrc)- &
1074 & tl_t(i,j,k ,nstp,itrc)
1075 END DO
1076 END DO
1077 DO i=istr,iend
1078 fc(i,0)=fc(i,1)
1079 tl_fc(i,0)=tl_fc(i,1)
1080 fc(i,
n(ng))=fc(i,
n(ng)-1)
1081 tl_fc(i,
n(ng))=tl_fc(i,
n(ng)-1)
1082 END DO
1084 DO i=istr,iend
1085 cff=2.0_r8*fc(i,k)*fc(i,k-1)
1086 tl_cff=2.0_r8*(tl_fc(i,k)*fc(i,k-1)+ &
1087 & fc(i,k)*tl_fc(i,k-1))- &
1088# ifdef TL_IOMS
1089 & cff
1090# endif
1091 IF (cff.gt.eps) THEN
1092 cf(i,k)=cff/(fc(i,k)+fc(i,k-1))
1093 tl_cf(i,k)=((fc(i,k)+fc(i,k-1))*tl_cff- &
1094 & cff*(tl_fc(i,k)+tl_fc(i,k-1)))/ &
1095 & ((fc(i,k)+fc(i,k-1))*(fc(i,k)+fc(i,k-1)))+ &
1096# ifdef TL_IOMS
1097 & cf(i,k)
1098# endif
1099 ELSE
1100 cf(i,k)=0.0_r8
1101 tl_cf(i,k)=0.0_r8
1102 END IF
1103 END DO
1104 END DO
1105 cff1=1.0_r8/3.0_r8
1107 DO i=istr,iend
1108 fc(i,k)=w(i,j,k)* &
1109 & 0.5_r8*(t(i,j,k ,nstp,itrc)+ &
1110 & t(i,j,k+1,nstp,itrc)- &
1111 & cff1*(cf(i,k+1)-cf(i,k)))
1112 tl_fc(i,k)=0.5_r8* &
1113 & (tl_w(i,j,k)* &
1114 & (t(i,j,k ,nstp,itrc)+ &
1115 & t(i,j,k+1,nstp,itrc)- &
1116 & cff1*(cf(i,k+1)-cf(i,k)))+ &
1117 & w(i,j,k)* &
1118 & (tl_t(i,j,k ,nstp,itrc)+ &
1119 & tl_t(i,j,k+1,nstp,itrc)- &
1120 & cff1*(tl_cf(i,k+1)-tl_cf(i,k))))- &
1121# ifdef TL_IOMS
1122 & fc(i,k)
1123# endif
1124 END DO
1125 END DO
1126 DO i=istr,iend
1127 fc(i,0)=0.0_r8
1128 tl_fc(i,0)=0.0_r8
1130 tl_fc(i,
n(ng))=0.0_r8
1131 END DO
1132
1134
1135
1136
1138 DO i=istr,iend
1139 fc(i,k)=w(i,j,k)* &
1140 & 0.5_r8*(t(i,j,k ,nstp,itrc)+ &
1141 & t(i,j,k+1,nstp,itrc))
1142 tl_fc(i,k)=0.5_r8* &
1143 & (tl_w(i,j,k)* &
1144 & (t(i,j,k ,nstp,itrc)+ &
1145 & t(i,j,k+1,nstp,itrc))+ &
1146 & w(i,j,k)* &
1147 & (tl_t(i,j,k ,nstp,itrc)+ &
1148 & tl_t(i,j,k+1,nstp,itrc)))- &
1149# ifdef TL_IOMS
1150 & fc(i,k)
1151# endif
1152 END DO
1153 END DO
1154 DO i=istr,iend
1155 fc(i,0)=0.0_r8
1156 tl_fc(i,0)=0.0_r8
1158 tl_fc(i,
n(ng))=0.0_r8
1159 END DO
1160
1163
1164
1165
1167 DO i=istr,iend
1168 cff1=max(w(i,j,k),0.0_r8)
1169 cff2=min(w(i,j,k),0.0_r8)
1170 tl_cff1=(0.5_r8+sign(0.5_r8, w(i,j,k)))*tl_w(i,j,k)
1171 tl_cff2=(0.5_r8+sign(0.5_r8,-w(i,j,k)))*tl_w(i,j,k)
1172 fc(i,k)=cff1*t(i,j,k ,nstp,itrc)+ &
1173 & cff2*t(i,j,k+1,nstp,itrc)
1174 tl_fc(i,k)=tl_cff1*t(i,j,k ,nstp,itrc)+ &
1175 & cff1*tl_t(i,j,k ,nstp,itrc)+ &
1176 & tl_cff2*t(i,j,k+1,nstp,itrc)+ &
1177 & cff2*tl_t(i,j,k+1,nstp,itrc)- &
1178# ifdef TL_IOMS
1179 & fc(i,k)
1180# endif
1181 END DO
1182 END DO
1183 DO i=istr,iend
1184
1185
1186 tl_fc(i,0)=0.0_r8
1187
1188
1189 tl_fc(i,
n(ng))=0.0_r8
1190 END DO
1191
1194
1195
1196
1197 cff1=0.5_r8
1198 cff2=7.0_r8/12.0_r8
1199 cff3=1.0_r8/12.0_r8
1201 DO i=istr,iend
1202 fc(i,k)=w(i,j,k)* &
1203 & (cff2*(t(i,j,k ,nstp,itrc)+ &
1204 & t(i,j,k+1,nstp,itrc))- &
1205 & cff3*(t(i,j,k-1,nstp,itrc)+ &
1206 & t(i,j,k+2,nstp,itrc)))
1207 tl_fc(i,k)=tl_w(i,j,k)* &
1208 & (cff2*(t(i,j,k ,nstp,itrc)+ &
1209 & t(i,j,k+1,nstp,itrc))- &
1210 & cff3*(t(i,j,k-1,nstp,itrc)+ &
1211 & t(i,j,k+2,nstp,itrc)))+ &
1212 & w(i,j,k)* &
1213 & (cff2*(tl_t(i,j,k ,nstp,itrc)+ &
1214 & tl_t(i,j,k+1,nstp,itrc))- &
1215 & cff3*(tl_t(i,j,k-1,nstp,itrc)+ &
1216 & tl_t(i,j,k+2,nstp,itrc)))- &
1217# ifdef TL_IOMS
1218 & fc(i,k)
1219# endif
1220 END DO
1221 END DO
1222 DO i=istr,iend
1223 fc(i,0)=0.0_r8
1224 tl_fc(i,0)=0.0_r8
1225 fc(i,1)=w(i,j,1)* &
1226 & (cff1*t(i,j,1,nstp,itrc)+ &
1227 & cff2*t(i,j,2,nstp,itrc)- &
1228 & cff3*t(i,j,3,nstp,itrc))
1229 tl_fc(i,1)=tl_w(i,j,1)* &
1230 & (cff1*t(i,j,1,nstp,itrc)+ &
1231 & cff2*t(i,j,2,nstp,itrc)- &
1232 & cff3*t(i,j,3,nstp,itrc))+ &
1233 & w(i,j,1)* &
1234 & (cff1*tl_t(i,j,1,nstp,itrc)+ &
1235 & cff2*tl_t(i,j,2,nstp,itrc)- &
1236 & cff3*tl_t(i,j,3,nstp,itrc))- &
1237# ifdef TL_IOMS
1238 & fc(i,1)
1239# endif
1240
1241 fc(i,
n(ng)-1)=w(i,j,
n(ng)-1)* &
1242 & (cff1*t(i,j,
n(ng) ,nstp,itrc)+ &
1243 & cff2*t(i,j,
n(ng)-1,nstp,itrc)- &
1244 & cff3*t(i,j,
n(ng)-2,nstp,itrc))
1245 tl_fc(i,
n(ng)-1)=tl_w(i,j,
n(ng)-1)* &
1246 & (cff1*t(i,j,
n(ng) ,nstp,itrc)+ &
1247 & cff2*t(i,j,
n(ng)-1,nstp,itrc)- &
1248 & cff3*t(i,j,
n(ng)-2,nstp,itrc))+ &
1250 & (cff1*tl_t(i,j,
n(ng) ,nstp,itrc)+ &
1251 & cff2*tl_t(i,j,
n(ng)-1,nstp,itrc)- &
1252 & cff3*tl_t(i,j,
n(ng)-2,nstp,itrc))- &
1253# ifdef TL_IOMS
1255# endif
1257 tl_fc(i,
n(ng))=0.0_r8
1258 END DO
1259 END IF vadv_flux
1260
1261
1262
1263
1264
1265
1268 gamma=0.5_r8
1269 ELSE
1270 gamma=1.0_r8/6.0_r8
1271 END IF
1274 ELSE
1275 cff=(1.0_r8-gamma)*
dt(ng)
1276 END IF
1278 DO i=istr,iend
1279 dc(i,k)=1.0_r8/(hz(i,j,k)- &
1280 & cff*pm(i,j)*pn(i,j)* &
1281 & (huon(i+1,j,k)-huon(i,j,k)+ &
1282 & hvom(i,j+1,k)-hvom(i,j,k)+ &
1283 & (w(i,j,k)-w(i,j,k-1))))
1284 tl_dc(i,k)=-dc(i,k)*dc(i,k)* &
1285 & (tl_hz(i,j,k)- &
1286 & cff*pm(i,j)*pn(i,j)* &
1287 & (tl_huon(i+1,j,k)-tl_huon(i,j,k)+ &
1288 & tl_hvom(i,j+1,k)-tl_hvom(i,j,k)+ &
1289 & (tl_w(i,j,k)-tl_w(i,j,k-1))))+ &
1290# ifdef TL_IOMS
1291 & 2.0_r8*dc(i,k)
1292# endif
1293 END DO
1294 END DO
1295
1296
1297
1298
1299
1300
1301
1302
1303
1305 DO i=istr,iend
1306 cff1=cff*pm(i,j)*pn(i,j)
1307
1308
1309
1310
1311 tl_t(i,j,k,3,itrc)=tl_dc(i,k)* &
1312 & (t(i,j,k,3,itrc)*hz(i,j,k)- &
1313 & cff1*(fc(i,k)-fc(i,k-1)))+ &
1314 & dc(i,k)* &
1315 & (tl_t(i,j,k,3,itrc)- &
1316 & cff1*(tl_fc(i,k)-tl_fc(i,k-1)))- &
1317# ifdef TL_IOMS
1318 & dc(i,k)* &
1319 & (t(i,j,k,3,itrc)*hz(i,j,k)- &
1320 & cff1*(fc(i,k)-fc(i,k-1)))
1321# endif
1322 END DO
1323 END DO
1324 END DO t_loop2
1325 END DO j_loop1
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336 DO j=jstr,jend
1341 DO i=istr,iend
1342 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
1343 tl_cff=-cff*cff*(tl_z_r(i,j,k+1)-tl_z_r(i,j,k))+ &
1344# ifdef TL_IOMS
1345 & 2.0_8*cff
1346# endif
1347
1348
1349
1350
1351# ifdef TL_IOMS
1352
1353
1354
1355
1356
1357 fc(i,k)=cff3*cff*akt(i,j,k,ltrc)* &
1358 & (t(i,j,k+1,nstp,itrc)- &
1359 & t(i,j,k ,nstp,itrc))
1360# endif
1361 tl_fc(i,k)=cff3* &
1362 & (cff*(tl_akt(i,j,k,ltrc)* &
1363 & (t(i,j,k+1,nstp,itrc)- &
1364 & t(i,j,k ,nstp,itrc))+ &
1365 & akt(i,j,k,ltrc)* &
1366 & (tl_t(i,j,k+1,nstp,itrc)- &
1367 & tl_t(i,j,k ,nstp,itrc)))+ &
1368 & tl_cff*(akt(i,j,k,ltrc)* &
1369 & (t(i,j,k+1,nstp,itrc)- &
1370 & t(i,j,k,nstp,itrc))))- &
1371# ifdef TL_IOMS
1372 & fc(i,k)
1373# endif
1374 END DO
1375 END DO
1376
1377# ifdef LMD_NONLOCAL_NOT_YET
1378
1379
1380
1381
1382
1383
1384 IF (itrc.le.
nat)
THEN
1386 DO i=istr,iend
1387
1388
1389
1390# ifdef TL_IOMS
1391 fc(i,k)=fc(i,k)- &
1392 &
dt(ng)*akt(i,j,k,itrc)*ghats(i,j,k,itrc)
1393# endif
1394 tl_fc(i,k)=tl_fc(i,k)- &
1395 &
dt(ng)*(tl_akt(i,j,k,itrc)* &
1396 & ghats(i,j,k,itrc)+ &
1397 & akt(i,j,k,itrc)* &
1398 & tl_ghats(i,j,k,itrc))+ &
1399# ifdef TL_IOMS
1400 &
dt(ng)*akt(i,j,k,itrc)*ghats(i,j,k,itrc)
1401# endif
1402 END DO
1403 END DO
1404 END IF
1405# endif
1406# ifdef SOLAR_SOURCE
1407
1408
1409
1410
1411 IF (itrc.eq.
itemp)
THEN
1413 DO i=istr,iend
1414
1415
1416# ifdef WET_DRY
1417
1418# endif
1419
1420
1421 tl_fc(i,k)=tl_fc(i,k)+ &
1422 &
dt(ng)*srflx(i,j)* &
1423# ifdef WET_DRY_NOT_YET
1424 & rmask_wet(i,j)* &
1425# endif
1426 & tl_swdk(i,j,k)
1427 END DO
1428 END DO
1429 END IF
1430# endif
1431
1432
1433
1434 DO i=istr,iend
1435
1436
1437 tl_fc(i,0)=
dt(ng)*tl_btflx(i,j,itrc)
1438
1439
1440 tl_fc(i,
n(ng))=
dt(ng)*tl_stflx(i,j,itrc)
1441 END DO
1442
1443
1444
1446 DO i=istr,iend
1447 cff1=hz(i,j,k)*t(i,j,k,nstp,itrc)
1448 tl_cff1=tl_hz(i,j,k)*t(i,j,k,nstp,itrc)+ &
1449 & hz(i,j,k)*tl_t(i,j,k,nstp,itrc)- &
1450# ifdef TL_IOMS
1451 & cff1
1452# endif
1453 cff2=fc(i,k)-fc(i,k-1)
1454 tl_cff2=tl_fc(i,k)-tl_fc(i,k-1)
1455
1456
1457 tl_t(i,j,k,nnew,itrc)=tl_cff1+tl_cff2
1458# ifdef DIAGNOSTICS_TS
1459
1460
1461# endif
1462 END DO
1463 END DO
1464 END DO
1465 END DO
1466# endif /* !TS_FIXED */
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476 j_loop2: DO j=jstr,jend
1479 DO i=istru,iend
1480 cff=1.0_r8/(z_r(i,j,k+1)+z_r(i-1,j,k+1)- &
1481 & z_r(i,j,k )-z_r(i-1,j,k ))
1482 tl_cff=-cff*cff*(tl_z_r(i,j,k+1)+tl_z_r(i-1,j,k+1)- &
1483 & tl_z_r(i,j,k )-tl_z_r(i-1,j,k ))+ &
1484# ifdef TL_IOMS
1485 & 2.0_r8*cff
1486# endif
1487
1488
1489
1490# ifdef TL_IOMS
1491
1492
1493
1494
1495
1496 fc(i,k)=cff3*cff*(u(i,j,k+1,nstp)-u(i,j,k,nstp))* &
1497 & (akv(i,j,k)+akv(i-1,j,k))
1498# endif
1499 tl_fc(i,k)=cff3* &
1500 & (cff*((tl_u(i,j,k+1,nstp)-tl_u(i,j,k,nstp))* &
1501 & (akv(i,j,k)+akv(i-1,j,k))+ &
1502 & (u(i,j,k+1,nstp)-u(i,j,k,nstp))* &
1503 & (tl_akv(i,j,k)+tl_akv(i-1,j,k)))+ &
1504 & tl_cff*(u(i,j,k+1,nstp)-u(i,j,k,nstp))* &
1505 & (akv(i,j,k)+akv(i-1,j,k)))- &
1506# ifdef TL_IOMS
1507 & fc(i,k)
1508# endif
1509 END DO
1510 END DO
1511
1512
1513
1514 DO i=istru,iend
1515# ifdef BODYFORCE
1516
1517
1518 tl_fc(i,0)=0.0_r8
1519
1520
1521 tl_fc(i,
n(ng))=0.0_r8
1522# else
1523
1524
1525 tl_fc(i,0)=
dt(ng)*tl_bustr(i,j)
1526
1527
1528 tl_fc(i,
n(ng))=
dt(ng)*tl_sustr(i,j)
1529# endif
1530 END DO
1531
1532
1533
1535 DO i=istru,iend
1536 dc(i,0)=cff*(pm(i,j)+pm(i-1,j))*(pn(i,j)+pn(i-1,j))
1537 END DO
1538 indx=3-nrhs
1541 DO i=istru,iend
1542 cff1=u(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
1543 tl_cff1=0.5_r8*(tl_u(i,j,k,nstp)* &
1544 & (hz(i,j,k)+hz(i-1,j,k))+ &
1545 & u(i,j,k,nstp)* &
1546 & (tl_hz(i,j,k)+tl_hz(i-1,j,k)))- &
1547# ifdef TL_IOMS
1548 & cff1
1549# endif
1550
1551
1552 tl_cff2=tl_fc(i,k)-tl_fc(i,k-1)
1553
1554
1555 tl_u(i,j,k,nnew)=tl_cff1+tl_cff2
1556# ifdef DIAGNOSTICS_UV
1557
1558
1559
1560
1561
1562# endif
1563 END DO
1564 END DO
1567 DO i=istru,iend
1568 cff1=u(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
1569 tl_cff1=0.5_r8*(tl_u(i,j,k,nstp)* &
1570 & (hz(i,j,k)+hz(i-1,j,k))+ &
1571 & u(i,j,k,nstp)* &
1572 & (tl_hz(i,j,k)+tl_hz(i-1,j,k)))- &
1573# ifdef TL_IOMS
1574 & cff1
1575# endif
1576
1577
1578 tl_cff2=tl_fc(i,k)-tl_fc(i,k-1)
1579 cff3=0.5_r8*dc(i,0)
1580
1581
1582
1583
1584 tl_u(i,j,k,nnew)=tl_cff1- &
1585 & cff3*tl_ru(i,j,k,indx)+ &
1586 & tl_cff2
1587# ifdef DIAGNOSTICS_UV
1588
1589
1590
1591
1592# ifdef BODYFORCE
1593
1594
1595# endif
1596
1597# endif
1598 END DO
1599 END DO
1600 ELSE
1601 cff1= 5.0_r8/12.0_r8
1602 cff2=16.0_r8/12.0_r8
1604 DO i=istru,iend
1605 cff3=u(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i-1,j,k))
1606 tl_cff3=0.5_r8*(tl_u(i,j,k,nstp)* &
1607 & (hz(i,j,k)+hz(i-1,j,k))+ &
1608 & u(i,j,k,nstp)* &
1609 & (tl_hz(i,j,k)+tl_hz(i-1,j,k)))- &
1610# ifdef TL_IOMS
1611 & cff3
1612# endif
1613
1614
1615 tl_cff4=tl_fc(i,k)-tl_fc(i,k-1)
1616
1617
1618
1619
1620
1621 tl_u(i,j,k,nnew)=tl_cff3+ &
1622 & dc(i,0)*(cff1*tl_ru(i,j,k,nrhs)- &
1623 & cff2*tl_ru(i,j,k,indx))+ &
1624 & tl_cff4
1625# ifdef DIAGNOSTICS_UV
1626
1627
1628
1629
1630
1631
1632# ifdef BODYFORCE
1633
1634
1635
1636
1637# endif
1638
1639# endif
1640 END DO
1641 END DO
1642 END IF
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652 IF (j.ge.jstrv) THEN
1655 DO i=istr,iend
1656 cff=1.0_r8/(z_r(i,j,k+1)+z_r(i,j-1,k+1)- &
1657 & z_r(i,j,k )-z_r(i,j-1,k ))
1658 tl_cff=-cff*cff*(tl_z_r(i,j,k+1)+tl_z_r(i,j-1,k+1)- &
1659 & tl_z_r(i,j,k )-tl_z_r(i,j-1,k ))+ &
1660# ifdef TL_IOMS
1661 & 2.0_r8*cff
1662# endif
1663
1664
1665
1666# ifdef TL_IOMS
1667
1668
1669
1670
1671
1672 fc(i,k)=cff3*cff*(v(i,j,k+1,nstp)-v(i,j,k,nstp))* &
1673 & (akv(i,j,k)+akv(i,j-1,k))
1674# endif
1675 tl_fc(i,k)=cff3* &
1676 & (cff*((tl_v(i,j,k+1,nstp)-tl_v(i,j,k,nstp))* &
1677 & (akv(i,j,k)+akv(i,j-1,k))+ &
1678 & (v(i,j,k+1,nstp)-v(i,j,k,nstp))* &
1679 & (tl_akv(i,j,k)+tl_akv(i,j-1,k)))+ &
1680 & tl_cff*(v(i,j,k+1,nstp)-v(i,j,k,nstp))* &
1681 & (akv(i,j,k)+akv(i,j-1,k)))- &
1682# ifdef TL_IOMS
1683 & fc(i,k)
1684# endif
1685 END DO
1686 END DO
1687
1688
1689
1690 DO i=istr,iend
1691# ifdef BODYFORCE
1692
1693
1694 tl_fc(i,0)=0.0_r8
1695
1696
1697 tl_fc(i,
n(ng))=0.0_r8
1698# else
1699
1700
1701 tl_fc(i,0)=
dt(ng)*tl_bvstr(i,j)
1702
1703
1704 tl_fc(i,
n(ng))=
dt(ng)*tl_svstr(i,j)
1705# endif
1706 END DO
1707
1708
1709
1711 DO i=istr,iend
1712 dc(i,0)=cff*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
1713 END DO
1716 DO i=istr,iend
1717 cff1=v(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
1718 tl_cff1=0.5_r8*(tl_v(i,j,k,nstp)* &
1719 & (hz(i,j,k)+hz(i,j-1,k))+ &
1720 & v(i,j,k,nstp)* &
1721 & (tl_hz(i,j,k)+tl_hz(i,j-1,k)))- &
1722# ifdef TL_IOMS
1723 & cff1
1724# endif
1725
1726
1727 tl_cff2=tl_fc(i,k)-tl_fc(i,k-1)
1728
1729
1730 tl_v(i,j,k,nnew)=tl_cff1+tl_cff2
1731# ifdef DIAGNOSTICS_UV
1732
1733
1734
1735
1736
1737# endif
1738 END DO
1739 END DO
1742 DO i=istr,iend
1743 cff1=v(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
1744 tl_cff1=0.5_r8*(tl_v(i,j,k,nstp)* &
1745 & (hz(i,j,k)+hz(i,j-1,k))+ &
1746 & v(i,j,k,nstp)* &
1747 & (tl_hz(i,j,k)+tl_hz(i,j-1,k)))- &
1748# ifdef TL_IOMS
1749 & cff1
1750# endif
1751
1752
1753 tl_cff2=tl_fc(i,k)-tl_fc(i,k-1)
1754 cff3=0.5_r8*dc(i,0)
1755
1756
1757
1758
1759 tl_v(i,j,k,nnew)=tl_cff1- &
1760 & cff3*tl_rv(i,j,k,indx)+ &
1761 & tl_cff2
1762# ifdef DIAGNOSTICS_UV
1763
1764
1765
1766
1767# ifdef BODYFORCE
1768
1769
1770# endif
1771
1772# endif
1773 END DO
1774 END DO
1775 ELSE
1776 cff1= 5.0_r8/12.0_r8
1777 cff2=16.0_r8/12.0_r8
1779 DO i=istr,iend
1780 cff3=v(i,j,k,nstp)*0.5_r8*(hz(i,j,k)+hz(i,j-1,k))
1781 tl_cff3=0.5_r8*(tl_v(i,j,k,nstp)* &
1782 & (hz(i,j,k)+hz(i,j-1,k))+ &
1783 & v(i,j,k,nstp)* &
1784 & (tl_hz(i,j,k)+tl_hz(i,j-1,k)))- &
1785# ifdef TL_IOMS
1786 & cff3
1787# endif
1788
1789
1790 tl_cff4=tl_fc(i,k)-tl_fc(i,k-1)
1791
1792
1793
1794
1795
1796 tl_v(i,j,k,nnew)=tl_cff3+ &
1797 & dc(i,0)*(cff1*tl_rv(i,j,k,nrhs)- &
1798 & cff2*tl_rv(i,j,k,indx))+ &
1799 & tl_cff4
1800# ifdef DIAGNOSTICS_UV
1801
1802
1803
1804
1805
1806
1807# ifdef BODYFORCE
1808
1809
1810
1811
1812# endif
1813
1814# endif
1815 END DO
1816 END DO
1817 END IF
1818 END IF
1819 END DO j_loop2
1820
1821# ifndef TS_FIXED
1822
1823
1824
1825
1826
1827 ic=0
1830 ic=ic+1
1831 END IF
1832
1833
1834
1835
1836
1837
1839 & lbi, ubi, lbj, ubj,
n(ng),
nt(ng), &
1840 & imins, imaxs, jmins, jmaxs, &
1841 & nstp, 3, &
1842 & tl_t)
1843
1845
1846
1847
1848
1850 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1851 & tl_t(:,:,:,3,itrc))
1852 END IF
1853 END DO
1854
1855# ifdef DISTRIBUTE
1856
1857
1858
1859
1860
1861
1863 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
1866 & tl_t(:,:,:,3,:))
1867# endif
1868# endif
1869
1870 RETURN
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
type(t_adv), dimension(:,:), allocatable tl_hadvection
integer, dimension(:), allocatable n
type(t_adv), dimension(:,:), allocatable tl_vadvection
type(t_domain), dimension(:), allocatable domain
type(t_adv), dimension(:,:), allocatable vadvection
integer, dimension(:), allocatable nt
logical, dimension(:), allocatable luvsrc
logical, dimension(:,:), allocatable ltracersrc
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:,:), allocatable compositegrid
integer, parameter isouth
integer, dimension(:), pointer inert
integer, dimension(:), allocatable ntfirst
logical, dimension(:,:), allocatable ltracerclm
integer, parameter inorth
logical, dimension(:,:), allocatable lnudgetclm
type(t_sources), dimension(:), allocatable sources
integer, dimension(:), allocatable nsrc
subroutine mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, a, b, c)
subroutine, public rp_t3dbc_tile(ng, tile, itrc, ic, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nout, tl_t)
subroutine rp_lmd_swfrac_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, zscale, z, tl_z, tl_swdk)