147
148
154
156# ifdef DISTRIBUTE
159# endif
161
162
163
164 integer, intent(in) :: ng, tile
165 integer, intent(in) :: LBi, UBi, LBj, UBj
166 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
167 integer, intent(in) :: nrhs, nstp, nnew
168
169# ifdef ASSUMED_SHAPE
170# ifdef MASKING
171 real(r8), intent(in) :: rmask(LBi:,LBj:)
172 real(r8), intent(in) :: umask(LBi:,LBj:)
173 real(r8), intent(in) :: vmask(LBi:,LBj:)
174# endif
175# ifdef WET_DRY
176 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
177 real(r8), intent(in) :: umask_wet(LBi:,LBj:)
178 real(r8), intent(in) :: vmask_wet(LBi:,LBj:)
179# endif
180 real(r8), intent(in) :: omn(LBi:,LBj:)
181 real(r8), intent(in) :: om_u(LBi:,LBj:)
182 real(r8), intent(in) :: om_v(LBi:,LBj:)
183 real(r8), intent(in) :: on_u(LBi:,LBj:)
184 real(r8), intent(in) :: on_v(LBi:,LBj:)
185 real(r8), intent(in) :: pm(LBi:,LBj:)
186 real(r8), intent(in) :: pn(LBi:,LBj:)
187 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
188 real(r8), intent(in) :: Huon(LBi:,LBj:,:)
189 real(r8), intent(in) :: Hvom(LBi:,LBj:,:)
190 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
191# ifdef SUN
192 real(r8), intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
193 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
194# else
195 real(r8), intent(in) :: Akt(LBi:,LBj:,0:,:)
196 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
197# endif
198 real(r8), intent(in) :: W(LBi:,LBj:,0:)
199
200# ifdef DIAGNOSTICS_TS
201
202# endif
203 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
204 real(r8), intent(inout) :: ad_Huon(LBi:,LBj:,:)
205 real(r8), intent(inout) :: ad_Hvom(LBi:,LBj:,:)
206 real(r8), intent(inout) :: ad_z_r(LBi:,LBj:,:)
207# ifdef SUN
208 real(r8), intent(inout) :: ad_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
209# else
210 real(r8), intent(inout) :: ad_Akt(LBi:,LBj:,0:,:)
211# endif
212 real(r8), intent(inout) :: ad_W(LBi:,LBj:,0:)
213# ifdef SUN
214 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
215# else
216 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
217# endif
218# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
219 real(r8), intent(out) :: dAktdz(LBi:,LBj:,:)
220# endif
221
222# else
223
224# ifdef MASKING
225 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
226 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
227 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
228# endif
229# ifdef WET_DRY
230 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
231 real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
232 real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
233# endif
234 real(r8), intent(in) :: omn(LBi:UBi,LBj:UBj)
235 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
236 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
237 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
238 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
239 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
240 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
241 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
242 real(r8), intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
243 real(r8), intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
244 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
245 real(r8), intent(in) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
246 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
247 real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
248
249# ifdef DIAGNOSTICS_TS
250
251
252# endif
253 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
254 real(r8), intent(inout) :: ad_Huon(LBi:UBi,LBj:UBj,N(ng))
255 real(r8), intent(inout) :: ad_Hvom(LBi:UBi,LBj:UBj,N(ng))
256 real(r8), intent(inout) :: ad_z_r(LBi:UBi,LBj:UBj,N(ng))
257 real(r8), intent(inout) :: ad_Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
258 real(r8), intent(inout) :: ad_W(LBi:UBi,LBj:UBj,0:N(ng))
259 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
260# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
261 real(r8), intent(out) :: dAktdz(LBi:UBi,LBj:UBj,N(ng))
262# endif
263# endif
264
265
266
267 logical :: LapplySrc, Lhsimt
268
269 integer :: JminT, JmaxT
270 integer :: Isrc, Jsrc
271 integer :: i, ic, is, itrc, j, k, ltrc
272# if defined AGE_MEAN && defined T_PASSIVE
273 integer :: iage
274# endif
275# ifdef DIAGNOSTICS_TS
276 integer :: idiag
277# endif
278
279 real(r8), parameter :: eps = 1.0e-16_r8
280
281 real(r8) :: cff, cff1, cff2, cff3
282 real(r8) :: ad_cff, ad_cff1, ad_cff2, ad_cff3
283 real(r8) :: adfac, adfac1, adfac2
284
285 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
286 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: BC
287 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC
288# ifdef SPLINES_VDIFF
289 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: DC1
290# endif
291 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
292
293 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_CF
294 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_BC
295 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
296 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: ad_FC
297
298 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE
299 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX
300 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: curv
301 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: grad
302
303 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FE
304 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FX
305 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_curv
306 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_grad
307
308 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
309 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: ad_oHz
310
311# include "set_bounds.h"
312
313
314
315
316
319
320
321
322 ad_cff=0.0_r8
323 ad_cff1=0.0_r8
324 ad_cff2=0.0_r8
325 ad_cff3=0.0_r8
326 DO j=jmins,jmaxs
327 DO i=imins,imaxs
328 ad_fe(i,j)=0.0_r8
329 ad_fx(i,j)=0.0_r8
330 ad_curv(i,j)=0.0_r8
331 ad_grad(i,j)=0.0_r8
332 END DO
334 DO i=imins,imaxs
335 ad_ohz(i,j,k)=0.0_r8
336 END DO
337 END DO
338 END DO
340 DO i=imins,imaxs
341 ad_cf(i,k)=0.0_r8
342 ad_bc(i,k)=0.0_r8
343 ad_dc(i,k)=0.0_r8
344 ad_fc(i,k)=0.0_r8
345 END DO
346 END DO
347
348# if defined FLOATS_NOT_YET && defined FLOAT_VWALK
349
350
351
352
353
354
355
356
357# ifdef DISTRIBUTE
359 & lbi, ubi, lbj, ubj, 1,
n(ng), &
362 & daktdz)
363# endif
365 CALL exchange_r3d_tile (ng, tile, &
366 & lbi, ubi, lbj, ubj, 1,
n(ng), &
367 & daktdz)
368 END IF
369
370 DO j=jstrr,jendr
371 DO i=istrr,iendr
373 daktdz(i,j,k)=(akt(i,j,k,1)-akt(i,j,k-1,1))/hz(i,j,k)
374 END DO
375 END DO
376 END DO
377# endif
378
379
380
381
382
383
384# ifdef DISTRIBUTE
385
386
387
388
389
390
391
392
394 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
397 & ad_t(:,:,:,nnew,:))
398
399# endif
400
401
402
403
404
405 ic=0
406
408
409
410
411
413 ic=ic+1
414 END IF
415
416
417
419
420
421
422
424 & lbi, ubi, lbj, ubj, 1,
n(ng), &
425 & ad_t(:,:,:,nnew,itrc))
426 END IF
427
428# ifdef DIAGNOSTICS_TS
429
430
431
432
433
434
435
436
437
438
439
440
441
442# endif
443# ifdef MASKING
444
445
446
448 DO j=jstrr,jendr
449 DO i=istrr,iendr
450
451
452 ad_t(i,j,k,nnew,itrc)=ad_t(i,j,k,nnew,itrc)*rmask(i,j)
453 END DO
454 END DO
455 END DO
456# endif
457
458
459
462 DO j=jstrr,jendr
463 DO i=istrr,iendr
464
465
466
467
468
469 ad_t(i,j,k,nnew,itrc)=ad_t(i,j,k,nnew,itrc)- &
471 &
clima(ng)%Tnudgcof(i,j,k,ic)* &
472 & ad_t(i,j,k,nnew,itrc)
473 END DO
474 END DO
475 END DO
476 END IF
477
478
479
480
481
482
483
484
485
487 & lbi, ubi, lbj, ubj,
n(ng),
nt(ng), &
488 & imins, imaxs, jmins, jmaxs, &
489 & nstp, nnew, &
490 & ad_t)
491 END DO
492
493# if defined AGE_MEAN && defined T_PASSIVE
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
512 DO j=jstr,jend
513 DO i=istr,iend
516 CONTINUE
517 ELSE
518
519
520
521
522 ad_t(i,j,k,3,
inert(itrc))=ad_t(i,j,k,3,
inert(itrc))+ &
523 &
dt(ng)*ad_t(i,j,k,nnew,iage)
524 END IF
525 END DO
526 END DO
527 END DO
528 END DO
529# endif
530
531
532
533
534
535
536
537 IF (lhsimt) THEN
539 DO j=jstrm2,jendp2
540 DO i=istrm2,iendp2
541 ohz(i,j,k)=1.0_r8/hz(i,j,k)
542 END DO
543 END DO
544 END DO
545 ELSE
547 DO j=jstr,jend
548 DO i=istr,iend
549 ohz(i,j,k)=1.0_r8/hz(i,j,k)
550 END DO
551 END DO
552 END DO
553 END IF
554
555
556
557 j_loop2 : DO j=jstr,jend
560
561# ifdef SPLINES_VDIFF
564
565
566
567
568
569 cff1=1.0_r8/6.0_r8
571 DO i=istr,iend
572 fc(i,k)=cff1*hz(i,j,k )- &
573 &
dt(ng)*akt(i,j,k-1,ltrc)*ohz(i,j,k )
574 cf(i,k)=cff1*hz(i,j,k+1)- &
575 &
dt(ng)*akt(i,j,k+1,ltrc)*ohz(i,j,k+1)
576 END DO
577 END DO
578 DO i=istr,iend
579 cf(i,0)=0.0_r8
580 dc(i,0)=0.0_r8
581 END DO
582
583
584
585 cff1=1.0_r8/3.0_r8
587 DO i=istr,iend
588 bc(i,k)=cff1*(hz(i,j,k)+hz(i,j,k+1))+ &
589 &
dt(ng)*akt(i,j,k,ltrc)*(ohz(i,j,k)+ohz(i,j,k+1))
590 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
591 cf(i,k)=cff*cf(i,k)
592 dc(i,k)=cff*(t(i,j,k+1,nnew,itrc)-t(i,j,k,nnew,itrc)- &
593 & fc(i,k)*dc(i,k-1))
594 END DO
595 END DO
596
597
598
599 DO i=istr,iend
601 END DO
603 DO i=istr,iend
604 dc(i,k)=dc(i,k)-cf(i,k)*dc(i,k+1)
605 END DO
606 END DO
607
608
609
611 DO i=istr,iend
612 dc1(i,k)=dc(i,k)*akt(i,j,k,ltrc)
613 END DO
614 END DO
615
616
617
618
619
621 DO i=istr,iend
622# ifdef DIAGNOSTICS_TS
623
624
625# endif
626
627
628 ad_cff1=ad_cff1+ad_t(i,j,k,nnew,itrc)
629
630
631
633 adfac1=adfac*ohz(i,j,k)
634 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac1
635 ad_dc(i,k )=ad_dc(i,k )+adfac1
636 ad_ohz(i,j,k)=ad_ohz(i,j,k)+(dc1(i,k)-dc1(i,k-1))*adfac
637 ad_cff1=0.0_r8
638
639
640
641 ad_dc(i,k)=ad_dc(i,k)*akt(i,j,k,ltrc)
642 ad_akt(i,j,k,ltrc)=ad_akt(i,j,k,ltrc)+dc(i,k)*ad_dc(i,k)
643 END DO
644 END DO
645
646
647
649 DO i=istr,iend
650
651
652 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
653 END DO
654 END DO
655 DO i=istr,iend
656
657
658 ad_dc(i,
n(ng))=0.0_r8
659 END DO
660
661
662
663 cff1=1.0_r8/3.0_r8
665 DO i=istr,iend
666 bc(i,k)=cff1*(hz(i,j,k)+hz(i,j,k+1))+ &
667 &
dt(ng)*akt(i,j,k,ltrc)*(ohz(i,j,k)+ohz(i,j,k+1))
668 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
669
670
671
672
673
674
675
676 adfac=cff*ad_dc(i,k)
677 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
678 ad_cf(i,k)=ad_cf(i,k)-dc(i,k+1)*adfac
679 ad_bc(i,k)=ad_bc(i,k)-dc(i,k )*adfac
680 ad_fc(i,k)=ad_fc(i,k)-dc(i,k-1)*adfac
681 ad_t(i,j,k ,nnew,itrc)=ad_t(i,j,k ,nnew,itrc)-adfac
682 ad_t(i,j,k+1,nnew,itrc)=ad_t(i,j,k+1,nnew,itrc)+adfac
683 ad_dc(i,k)=0.0_r8
684
685
686
687
688
689
690 adfac=cff1*ad_bc(i,k)
691 adfac1=
dt(ng)*ad_bc(i,k)
692 adfac2=adfac1*akt(i,j,k,ltrc)
693 ad_ohz(i,j,k )=ad_ohz(i,j,k )+adfac2
694 ad_ohz(i,j,k+1)=ad_ohz(i,j,k+1)+adfac2
695 ad_akt(i,j,k,ltrc)=ad_akt(i,j,k,ltrc)+ &
696 & (ohz(i,j,k)+ohz(i,j,k+1))*adfac1
697 ad_hz(i,j,k )=ad_hz(i,j,k )+adfac
698 ad_hz(i,j,k+1)=ad_hz(i,j,k+1)+adfac
699 ad_bc(i,k)=0.0_r8
700 END DO
701 END DO
702
703
704
705
706
707
708
709
710 DO i=istr,iend
711
712
713 ad_cf(i,0)=0.0_r8
714
715
716 ad_dc(i,0)=0.0_r8
717 END DO
718 cff1=1.0_r8/6.0_r8
720 DO i=istr,iend
721
722
723
724
725 adfac=
dt(ng)*ad_cf(i,k)
726 ad_ohz(i,j,k+1)=ad_ohz(i,j,k+1)- &
727 & akt(i,j,k+1,ltrc)*adfac
728 ad_akt(i,j,k+1,ltrc)=ad_akt(i,j,k+1,ltrc)- &
729 & ohz(i,j,k+1)*adfac
730 ad_hz(i,j,k+1)=ad_hz(i,j,k+1)+cff1*ad_cf(i,k)
731 ad_cf(i,k)=0.0_r8
732
733
734
735
736 adfac=
dt(ng)*ad_fc(i,k)
737 ad_ohz(i,j,k )=ad_ohz(i,j,k )- &
738 & akt(i,j,k-1,ltrc)*adfac
739 ad_akt(i,j,k-1,ltrc)=ad_akt(i,j,k-1,ltrc)- &
740 & ohz(i,j,k )*adfac
741 ad_hz(i,j,k )=ad_hz(i,j,k )+cff1*ad_fc(i,k)
742 ad_fc(i,k)=0.0_r8
743 END DO
744 END DO
745 ELSE
746# endif
747
748
749
750
751
752
755 DO i=istr,iend
756 cff1=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
757 fc(i,k)=cff*cff1*akt(i,j,k,ltrc)
758 END DO
759 END DO
760 DO i=istr,iend
761 fc(i,0)=0.0_r8
763 END DO
764
765
766
768 DO i=istr,iend
769 bc(i,k)=hz(i,j,k)-fc(i,k)-fc(i,k-1)
770 END DO
771 END DO
772
773
774
775
776 DO i=istr,iend
777 cff=1.0_r8/bc(i,1)
778 cf(i,1)=cff*fc(i,1)
779 END DO
781 DO i=istr,iend
782 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
783 cf(i,k)=cff*fc(i,k)
784 END DO
785 END DO
786
787
789 DO i=istr,iend
790# ifdef DIAGNOSTICS_TS
791
792
793# endif
794
795
796 ad_dc(i,k)=ad_dc(i,k)+ad_t(i,j,k,nnew,itrc)
797 ad_t(i,j,k,nnew,itrc)=0.0_r8
798
799
800 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
801# ifdef DIAGNOSTICS_TS
802
803# endif
804 END DO
805 END DO
806 DO i=istr,iend
807# ifdef DIAGNOSTICS_TS
808
809
810
811# endif
812
813
814 ad_dc(i,
n(ng))=ad_dc(i,
n(ng))+ad_t(i,j,
n(ng),nnew,itrc)
815 ad_t(i,j,
n(ng),nnew,itrc)=0.0_r8
816
817
818
819 adfac=ad_dc(i,
n(ng))/ &
820 & (bc(i,
n(ng))-fc(i,
n(ng)-1)*cf(i,
n(ng)-1))
821 ad_dc(i,
n(ng)-1)=ad_dc(i,
n(ng)-1)-fc(i,
n(ng)-1)*adfac
822 ad_dc(i,
n(ng) )=adfac
823 END DO
824
825
826
827
829 DO i=istr,iend
830 cff=1.0_r8/(bc(i,k)-fc(i,k-1)*cf(i,k-1))
831
832
833 adfac=cff*ad_dc(i,k)
834 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k-1)*adfac
835 ad_dc(i,k )=adfac
836 END DO
837 END DO
838 DO i=istr,iend
839 cff=1.0_r8/bc(i,1)
840
841
842 ad_dc(i,1)=cff*ad_dc(i,1)
843 END DO
844
845 DO i=istr,iend
846
847
848
849
850 ad_bc(i,
n(ng) )=-t(i,j,
n(ng) ,nnew,itrc)*ad_dc(i,
n(ng))
851 ad_fc(i,
n(ng)-1)=-t(i,j,
n(ng)-1,nnew,itrc)*ad_dc(i,
n(ng))
852 ad_t(i,j,
n(ng),nnew,itrc)=ad_dc(i,
n(ng))
853 ad_dc(i,
n(ng))=0.0_r8
854
855
856
857
858 ad_fc(i,1)=-t(i,j,2,nnew,itrc)*ad_dc(i,1)
859 ad_bc(i,1)=-t(i,j,1,nnew,itrc)*ad_dc(i,1)
860 ad_t(i,j,1,nnew,itrc)=ad_dc(i,1)
861 ad_dc(i,1)=0.0_r8
862 END DO
864 DO i=istr,iend
865
866
867
868
869
870 ad_fc(i,k-1)=ad_fc(i,k-1)- &
871 & t(i,j,k-1,nnew,itrc)*ad_dc(i,k)
872 ad_fc(i,k )=ad_fc(i,k )- &
873 & t(i,j,k+1,nnew,itrc)*ad_dc(i,k)
874 ad_bc(i,k)=ad_bc(i,k)- &
875 & t(i,j,k ,nnew,itrc)*ad_dc(i,k)
876 ad_t(i,j,k,nnew,itrc)=ad_t(i,j,k,nnew,itrc)+ad_dc(i,k)
877 ad_dc(i,k)=0.0_r8
878 END DO
879 END DO
880
881
882
884 DO i=istr,iend
885
886
887 ad_fc(i,k-1)=ad_fc(i,k-1)-ad_bc(i,k)
888 ad_fc(i,k )=ad_fc(i,k )-ad_bc(i,k)
889 ad_hz(i,j,k)=ad_hz(i,j,k)+ad_bc(i,k)
890 ad_bc(i,k)=0.0_r8
891 END DO
892 END DO
893
894
895
896
897
898
899
900
901
902
903
904
905 DO i=istr,iend
906
907
908 ad_fc(i,
n(ng))=0.0_r8
909
910
911 ad_fc(i,0)=0.0_r8
912 END DO
915 DO i=istr,iend
916 cff1=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
917
918
919
920 adfac=cff*ad_fc(i,k)
921 ad_akt(i,j,k,ltrc)=ad_akt(i,j,k,ltrc)+cff1*adfac
922 ad_cff1=ad_cff1+akt(i,j,k,ltrc)*adfac
923 ad_fc(i,k)=0.0_r8
924
925
926 adfac=-cff1*cff1*ad_cff1
927 ad_z_r(i,j,k )=ad_z_r(i,j,k )-adfac
928 ad_z_r(i,j,k+1)=ad_z_r(i,j,k+1)+adfac
929 ad_cff1=0.0_r8
930 END DO
931 END DO
932# ifdef SPLINES_VDIFF
933 END IF
934# endif
935 END DO
936 END DO j_loop2
937
938
939
940
941
942
943
944
945
946
947
948
949
955 IF (int(
sources(ng)%Dsrc(is)).eq.2)
THEN
958 IF (((istr.le.isrc).and.(isrc.le.iend+1)).and. &
959 & ((jstr.le.jsrc).and.(jsrc.le.jend+1))) THEN
961 cff=
dt(ng)*pm(isrc,jsrc)*pn(isrc,jsrc)
962# ifdef SPLINES_VDIFF
963 cff=cff*ohz(isrc,jsrc,k)
964# endif
966 cff3=
sources(ng)%Tsrc(is,k,itrc)
967 ELSE
968 cff3=t(isrc,jsrc,k,3,itrc)
969 END IF
970# ifdef SPLINES_VDIFF
971
972
973
974
975
976
977
978
979
980 adfac=cff*ad_t(isrc,jsrc,k,nnew,itrc)
982 & cff3*adfac
983 ad_cff3=ad_cff3+ &
985 ad_cff=ad_cff+ &
986 &
sources(ng)%Qsrc(is,k)*cff3* &
987 & ad_t(isrc,jsrc,k,nnew,itrc)
988# else
989
990
991
992
993
994
995
996 adfac=cff*ad_t(isrc,jsrc,k,nnew,itrc)
998 & cff3*adfac
999 ad_cff3=ad_cff3+ &
1000 &
sources(ng)%Qsrc(is,k)*adfac
1001# endif
1003
1004
1005 sources(ng)%ad_Tsrc(is,k,itrc)= &
1006 &
sources(ng)%ad_Tsrc(is,k,itrc)+ &
1007 ad_cff3
1008 ELSE
1009
1010
1011 ad_t(isrc,jsrc,k,3,itrc)=ad_t(isrc,jsrc,k,3,itrc)+&
1012 & ad_cff3
1013 END IF
1014 ad_cff3=0.0_r8
1015# ifdef SPLINES_VDIFF
1016
1017
1018 ad_ohz(isrc,jsrc,k)=ad_ohz(isrc,jsrc,k)+ &
1019 & cff*ad_cff
1020 ad_cff=0.0_r8
1021# endif
1022 END DO
1023 END IF
1024 END IF
1025 END DO
1026 END IF
1027 END DO
1028 END IF
1029
1030
1031
1032
1033
1034 t_loop2 :
DO itrc=1,
nt(ng)
1036 jmint=jstrvm2
1037 jmaxt=jendp2i
1038 ELSE
1039 jmint=jstr
1040 jmaxt=jend
1041 END IF
1042
1043 j_loop1 : DO j=jmint,jmaxt
1044
1045
1046
1047
1049
1050
1051
1052
1053
1054 DO i=istr,iend
1055# ifdef NEUMANN
1056 fc(i,0)=1.5_r8*t(i,j,1,3,itrc)
1057 cf(i,1)=0.5_r8
1058# else
1059 fc(i,0)=2.0_r8*t(i,j,1,3,itrc)
1060 cf(i,1)=1.0_r8
1061# endif
1062 END DO
1064 DO i=istr,iend
1065 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
1066 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
1067 cf(i,k+1)=cff*hz(i,j,k)
1068 fc(i,k)=cff*(3.0_r8*(hz(i,j,k )*t(i,j,k+1,3,itrc)+ &
1069 & hz(i,j,k+1)*t(i,j,k ,3,itrc))- &
1070 & hz(i,j,k+1)*fc(i,k-1))
1071 END DO
1072 END DO
1073 DO i=istr,iend
1074# ifdef NEUMANN
1075 fc(i,
n(ng))=(3.0_r8*t(i,j,
n(ng),3,itrc)-fc(i,
n(ng)-1))/ &
1076 & (2.0_r8-cf(i,
n(ng)))
1077# else
1078 fc(i,
n(ng))=(2.0_r8*t(i,j,
n(ng),3,itrc)-fc(i,
n(ng)-1))/ &
1079 & (1.0_r8-cf(i,
n(ng)))
1080# endif
1081 END DO
1083 DO i=istr,iend
1084 fc(i,k)=fc(i,k)-cf(i,k+1)*fc(i,k+1)
1085 fc(i,k+1)=w(i,j,k+1)*fc(i,k+1)
1086 END DO
1087 END DO
1088 DO i=istr,iend
1090 fc(i,0)=0.0_r8
1091 END DO
1092
1094
1095
1096
1098 DO i=istr,iend
1099 fc(i,k)=t(i,j,k+1,3,itrc)- &
1100 & t(i,j,k ,3,itrc)
1101 END DO
1102 END DO
1103 DO i=istr,iend
1104 fc(i,0)=fc(i,1)
1105 fc(i,
n(ng))=fc(i,
n(ng)-1)
1106 END DO
1108 DO i=istr,iend
1109 cff=2.0_r8*fc(i,k)*fc(i,k-1)
1110 IF (cff.gt.eps) THEN
1111 cf(i,k)=cff/(fc(i,k)+fc(i,k-1))
1112 ELSE
1113 cf(i,k)=0.0_r8
1114 END IF
1115 END DO
1116 END DO
1117 cff1=1.0_r8/3.0_r8
1119 DO i=istr,iend
1120 fc(i,k)=w(i,j,k)* &
1121 & 0.5_r8*(t(i,j,k ,3,itrc)+ &
1122 & t(i,j,k+1,3,itrc)- &
1123 & cff1*(cf(i,k+1)-cf(i,k)))
1124 END DO
1125 END DO
1126 DO i=istr,iend
1127# ifdef SED_MORPH
1128 fc(i,0)=w(i,j,0)*t(i,j,1,3,itrc)
1129# else
1130 fc(i,0)=0.0_r8
1131# endif
1133 END DO
1134
1136
1137
1138
1139
1141 DO i=istr,iend
1142 fc(i,k)=w(i,j,k)* &
1143 & 0.5_r8*(t(i,j,k ,3,itrc)+ &
1144 & t(i,j,k+1,3,itrc))
1145 END DO
1146 END DO
1147 DO i=istr,iend
1148# ifdef SED_MORPH
1149 fc(i,0)=w(i,j,0)*t(i,j,1,3,itrc)
1150# else
1151 fc(i,0)=0.0_r8
1152# endif
1154 END DO
1155
1157
1158
1159
1160
1161 CONTINUE
1162
1164
1165
1166
1167
1168
1169 CONTINUE
1170
1173
1174
1175
1176
1177 cff1=0.5_r8
1178 cff2=7.0_r8/12.0_r8
1179 cff3=1.0_r8/12.0_r8
1181 DO i=istr,iend
1182 fc(i,k)=w(i,j,k)* &
1183 & (cff2*(t(i,j,k ,3,itrc)+ &
1184 & t(i,j,k+1,3,itrc))- &
1185 & cff3*(t(i,j,k-1,3,itrc)+ &
1186 & t(i,j,k+2,3,itrc)))
1187 END DO
1188 END DO
1189 DO i=istr,iend
1190# ifdef SED_MORPH
1191 fc(i,0)=w(i,j,0)*2.0_r8* &
1192 & (cff2*t(i,j,1,3,itrc)- &
1193 & cff3*t(i,j,2,3,itrc))
1194# else
1195 fc(i,0)=0.0_r8
1196# endif
1197 fc(i,1)=w(i,j,1)* &
1198 & (cff1*t(i,j,1,3,itrc)+ &
1199 & cff2*t(i,j,2,3,itrc)- &
1200 & cff3*t(i,j,3,3,itrc))
1201 fc(i,
n(ng)-1)=w(i,j,
n(ng)-1)* &
1202 & (cff1*t(i,j,
n(ng) ,3,itrc)+ &
1203 & cff2*t(i,j,
n(ng)-1,3,itrc)- &
1204 & cff3*t(i,j,
n(ng)-2,3,itrc))
1206 END DO
1207 END IF vadv_flux_basic
1208
1209
1210# ifdef SPLINES_VDIFF
1211
1212
1213# endif
1214
1216 CONTINUE
1217 ELSE
1218 DO i=istr,iend
1219 cf(i,0)=
dt(ng)*pm(i,j)*pn(i,j)
1220 END DO
1222 DO i=istr,iend
1223 cff1=cf(i,0)*(fc(i,k)-fc(i,k-1))
1224# ifdef DIAGNOSTICS_TS
1225
1226
1227
1228
1229
1230# endif
1231# ifdef SPLINES_VDIFF
1232
1233
1234
1235
1236
1237 ad_ohz(i,j,k)=ad_ohz(i,j,k)+ &
1238 & (t(i,j,k,nnew,itrc)*hz(i,j,k))* &
1239 & ad_t(i,j,k,nnew,itrc)
1240 ad_t(i,j,k,nnew,itrc)=ad_t(i,j,k,nnew,itrc)*ohz(i,j,k)
1241# endif
1242
1243
1244 ad_cff1=ad_cff1-ad_t(i,j,k,nnew,itrc)
1245
1246
1247 adfac=cf(i,0)*ad_cff1
1248 ad_fc(i,k-1)=ad_fc(i,k-1)-adfac
1249 ad_fc(i,k )=ad_fc(i,k )+adfac
1250 ad_cff1=0.0_r8
1251 END DO
1252 END DO
1253 END IF vadv_stepping
1254
1255
1256
1258
1259
1260
1261
1262
1263 DO i=istr,iend
1264# ifdef NEUMANN
1265 fc(i,0)=1.5_r8*t(i,j,1,3,itrc)
1266 cf(i,1)=0.5_r8
1267# else
1268 fc(i,0)=2.0_r8*t(i,j,1,3,itrc)
1269 cf(i,1)=1.0_r8
1270# endif
1271 END DO
1273 DO i=istr,iend
1274 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
1275 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
1276 cf(i,k+1)=cff*hz(i,j,k)
1277 fc(i,k)=cff*(3.0_r8*(hz(i,j,k )*t(i,j,k+1,3,itrc)+ &
1278 & hz(i,j,k+1)*t(i,j,k ,3,itrc))- &
1279 & hz(i,j,k+1)*fc(i,k-1))
1280 END DO
1281 END DO
1282 DO i=istr,iend
1283# ifdef NEUMANN
1284 fc(i,
n(ng))=(3.0_r8*t(i,j,
n(ng),3,itrc)-fc(i,
n(ng)-1))/ &
1285 & (2.0_r8-cf(i,
n(ng)))
1286# else
1287 fc(i,
n(ng))=(2.0_r8*t(i,j,
n(ng),3,itrc)-fc(i,
n(ng)-1))/ &
1288 & (1.0_r8-cf(i,
n(ng)))
1289# endif
1290 END DO
1292 DO i=istr,iend
1293 fc(i,k)=fc(i,k)-cf(i,k+1)*fc(i,k+1)
1294 END DO
1295 END DO
1296
1297
1298
1299 DO i=istr,iend
1300
1301
1302 ad_fc(i,
n(ng))=0.0_r8
1303
1304
1305 ad_fc(i,0)=0.0_r8
1306 END DO
1307
1308
1309
1311 DO i=istr,iend
1312
1313
1314
1315 ad_w(i,j,k+1)=ad_w(i,j,k+1)+fc(i,k+1)*ad_fc(i,k+1)
1316 ad_fc(i,k+1)=w(i,j,k+1)*ad_fc(i,k+1)
1317
1318
1319 ad_fc(i,k+1)=ad_fc(i,k+1)-cf(i,k+1)*ad_fc(i,k)
1320 END DO
1321 END DO
1322 DO i=istr,iend
1323# ifdef NEUMANN
1324
1325
1326
1327
1328 adfac=ad_fc(i,
n(ng))/(2.0_r8-cf(i,
n(ng)))
1329 ad_t(i,j,
n(ng),3,itrc)=ad_t(i,j,
n(ng),3,itrc)+3.0_r8*adfac
1330 ad_fc(i,
n(ng)-1)=ad_fc(i,
n(ng)-1)-adfac
1331 ad_fc(i,
n(ng))=0.0_r8
1332# else
1333
1334
1335
1336
1337 adfac=ad_fc(i,
n(ng))/(1.0_r8-cf(i,
n(ng)))
1338 ad_t(i,j,
n(ng),3,itrc)=ad_t(i,j,
n(ng),3,itrc)+2.0_r8*adfac
1339 ad_fc(i,
n(ng)-1)=ad_fc(i,
n(ng)-1)-adfac
1341# endif
1342 END DO
1344 DO i=istr,iend
1345 cff=1.0_r8/(2.0_r8*hz(i,j,k)+ &
1346 & hz(i,j,k+1)*(2.0_r8-cf(i,k)))
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358 adfac=cff*ad_fc(i,k)
1359 adfac1=3.0_r8*adfac
1360 adfac2=2.0_r8*adfac
1361 ad_t(i,j,k ,3,itrc)=ad_t(i,j,k ,3,itrc)+ &
1362 & hz(i,j,k+1)*adfac1
1363 ad_t(i,j,k+1,3,itrc)=ad_t(i,j,k+1,3,itrc)+ &
1364 & hz(i,j,k )*adfac1
1365 ad_hz(i,j,k )=ad_hz(i,j,k )+ &
1366 & t(i,j,k+1,3,itrc)*adfac1- &
1367 & fc(i,k )*adfac2- &
1368 & fc(i,k+1)*adfac
1369 ad_hz(i,j,k+1)=ad_hz(i,j,k+1)+ &
1370 & t(i,j,k ,3,itrc)*adfac1- &
1371 & fc(i,k-1)*adfac- &
1372 & fc(i,k )*adfac2
1373 ad_fc(i,k-1)=ad_fc(i,k-1)-hz(i,j,k+1)*adfac
1374 ad_fc(i,k)=0.0_r8
1375 END DO
1376 END DO
1377 DO i=istr,iend
1378# ifdef NEUMANN
1379
1380
1381 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+1.5_r8*ad_fc(i,0)
1382 ad_fc(i,0)=0.0_r8
1383# else
1384
1385
1386 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+2.0_r8*ad_fc(i,0)
1387 ad_fc(i,0)=0.0_r8
1388# endif
1389 END DO
1390
1392
1393
1394
1396 DO i=istr,iend
1397 fc(i,k)=t(i,j,k+1,3,itrc)- &
1398 & t(i,j,k ,3,itrc)
1399 END DO
1400 END DO
1401 DO i=istr,iend
1402 fc(i,0)=fc(i,1)
1403 fc(i,
n(ng))=fc(i,
n(ng)-1)
1404 END DO
1406 DO i=istr,iend
1407 cff=2.0_r8*fc(i,k)*fc(i,k-1)
1408 IF (cff.gt.eps) THEN
1409 cf(i,k)=cff/(fc(i,k)+fc(i,k-1))
1410 ELSE
1411 cf(i,k)=0.0_r8
1412 END IF
1413 END DO
1414 END DO
1415 DO i=istr,iend
1416
1417
1418 ad_fc(i,
n(ng))=0.0_r8
1419# ifdef SED_MORPH
1420
1421
1422
1423 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+w(i,j,0)*ad_fc(i,0)
1424 ad_w(i,j,0)=ad_w(i,j,0)+t(i,j,1,3,itrc)*ad_fc(i,0)
1425 ad_fc(i,0)=0.0_r8
1426# else
1427
1428
1429 ad_fc(i,0)=0.0_r8
1430# endif
1431 END DO
1432 cff1=1.0_r8/3.0_r8
1434 DO i=istr,iend
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445 adfac=0.5_r8*ad_fc(i,k)
1446 adfac1=adfac*w(i,j,k)
1447 adfac2=adfac1*cff1
1448 ad_cf(i,k )=ad_cf(i,k )+adfac2
1449 ad_cf(i,k+1)=ad_cf(i,k+1)-adfac2
1450 ad_t(i,j,k ,3,itrc)=ad_t(i,j,k ,3,itrc)+adfac1
1451 ad_t(i,j,k+1,3,itrc)=ad_t(i,j,k+1,3,itrc)+adfac1
1452 ad_w(i,j,k)=ad_w(i,j,k)+ &
1453 & (t(i,j,k ,3,itrc)+ &
1454 & t(i,j,k+1,3,itrc)- &
1455 & cff1*(cf(i,k+1)-cf(i,k)))*adfac
1456 ad_fc(i,k)=0.0_r8
1457 END DO
1458 END DO
1460 DO i=istr,iend
1461 cff=2.0_r8*fc(i,k)*fc(i,k-1)
1462 IF (cff.gt.eps) THEN
1463
1464
1465
1466
1467 adfac=ad_cf(i,k)/ &
1468 & ((fc(i,k)+fc(i,k-1))*(fc(i,k)+fc(i,k-1)))
1469 adfac1=adfac*cff
1470 ad_fc(i,k-1)=ad_fc(i,k-1)-adfac1
1471 ad_fc(i,k )=ad_fc(i,k )-adfac1
1472 ad_cff=ad_cff+(fc(i,k)+fc(i,k-1))*adfac
1473 ad_cf(i,k)=0.0_r8
1474 ELSE
1475
1476
1477 ad_cf(i,k)=0.0_r8
1478 END IF
1479
1480
1481
1482 adfac=2.0_r8*ad_cff
1483 ad_fc(i,k-1)=ad_fc(i,k-1)+fc(i,k )*adfac
1484 ad_fc(i,k )=ad_fc(i,k )+fc(i,k-1)*adfac
1485 ad_cff=0.0_r8
1486 END DO
1487 END DO
1488 DO i=istr,iend
1489
1490
1491 ad_fc(i,
n(ng)-1)=ad_fc(i,
n(ng)-1)+ad_fc(i,
n(ng))
1492 ad_fc(i,
n(ng))=0.0_r8
1493
1494
1495 ad_fc(i,1)=ad_fc(i,1)+ad_fc(i,0)
1496 ad_fc(i,0)=0.0_r8
1497 END DO
1499 DO i=istr,iend
1500
1501
1502
1503 ad_t(i,j,k ,3,itrc)=ad_t(i,j,k ,3,itrc)-ad_fc(i,k)
1504 ad_t(i,j,k+1,3,itrc)=ad_t(i,j,k+1,3,itrc)+ad_fc(i,k)
1505 ad_fc(i,k)=0.0_r8
1506 END DO
1507 END DO
1508
1510
1511
1512
1513 DO i=istr,iend
1514
1515
1516 ad_fc(i,
n(ng))=0.0_r8
1517# ifdef SED_MORPH
1518
1519
1520
1521 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+w(i,j,0)*ad_fc(i,0)
1522 ad_w(i,j,0)=ad_w(i,j,0)+t(i,j,1,3,itrc)*ad_fc(i,0)
1523 ad_fc(i,0)=0.0_r8
1524# else
1525
1526
1527 ad_fc(i,0)=0.0_r8
1528# endif
1529 END DO
1531 DO i=istr,iend
1532
1533
1534
1535
1536
1537
1538
1539
1540 adfac=0.5_r8*ad_fc(i,k)
1541 adfac1=adfac*w(i,j,k)
1542 ad_t(i,j,k ,3,itrc)=ad_t(i,j,k ,3,itrc)+adfac1
1543 ad_t(i,j,k+1,3,itrc)=ad_t(i,j,k+1,3,itrc)+adfac1
1544 ad_w(i,j,k)=ad_w(i,j,k)+ &
1545 & (t(i,j,k ,3,itrc)+ &
1546 & t(i,j,k+1,3,itrc))*adfac
1547 ad_fc(i,k)=0.0_r8
1548 END DO
1549 END DO
1550
1552
1553
1554
1555 CONTINUE
1556
1558
1559
1560
1561
1562
1563 CONTINUE
1564
1567
1568
1569
1570 cff1=0.5_r8
1571 cff2=7.0_r8/12.0_r8
1572 cff3=1.0_r8/12.0_r8
1573 DO i=istr,iend
1574
1575
1576 ad_fc(i,
n(ng))=0.0_r8
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586 adfac=w(i,j,
n(ng)-1)*ad_fc(i,
n(ng)-1)
1587 ad_w(i,j,
n(ng)-1)=ad_w(i,j,
n(ng)-1)+ &
1588 & (cff1*t(i,j,
n(ng) ,3,itrc)+ &
1589 & cff2*t(i,j,
n(ng)-1,3,itrc)- &
1590 & cff3*t(i,j,
n(ng)-2,3,itrc))* &
1592 ad_t(i,j,
n(ng)-2,3,itrc)=ad_t(i,j,
n(ng)-2,3,itrc)- &
1593 & cff3*adfac
1594 ad_t(i,j,
n(ng)-1,3,itrc)=ad_t(i,j,
n(ng)-1,3,itrc)+ &
1595 & cff2*adfac
1596 ad_t(i,j,
n(ng) ,3,itrc)=ad_t(i,j,
n(ng) ,3,itrc)+ &
1597 & cff1*adfac
1598 ad_fc(i,
n(ng)-1)=0.0_r8
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608 adfac=w(i,j,1)*ad_fc(i,1)
1609 ad_w(i,j,1)=ad_w(i,j,1)+ &
1610 & (cff1*t(i,j,1,3,itrc)+ &
1611 & cff2*t(i,j,2,3,itrc)- &
1612 & cff3*t(i,j,3,3,itrc))*ad_fc(i,1)
1613 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+cff1*adfac
1614 ad_t(i,j,2,3,itrc)=ad_t(i,j,2,3,itrc)+cff2*adfac
1615 ad_t(i,j,3,3,itrc)=ad_t(i,j,3,3,itrc)-cff3*adfac
1616 ad_fc(i,1)=0.0_r8
1617# ifdef SED_MORPH
1618
1619
1620
1621
1622
1623
1624
1625
1626 adfac=2.0_r8*ad_fc(i,0)
1627 adfac1=adfac*w(i,j,0)
1628 ad_t(i,j,1,3,itrc)=ad_t(i,j,1,3,itrc)+cff2*adfac1
1629 ad_t(i,j,2,3,itrc)=ad_t(i,j,2,3,itrc)-cff3*adfac1
1630 ad_w(i,j,0)=ad_w(i,j,0)+ &
1631 & (cff2*t(i,j,1,3,itrc)- &
1632 & cff3*t(i,j,2,3,itrc))*adfac
1633 ad_fc(i,0)=0.0_r8
1634# else
1635
1636
1637 ad_fc(i,0)=0.0_r8
1638# endif
1639 END DO
1641 DO i=istr,iend
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653 adfac=w(i,j,k)*ad_fc(i,k)
1654 adfac1=adfac*cff2
1655 adfac2=adfac*cff3
1656 ad_w(i,j,k)=ad_w(i,j,k)+ &
1657 & (cff2*(t(i,j,k ,3,itrc)+ &
1658 & t(i,j,k+1,3,itrc))- &
1659 & cff3*(t(i,j,k-1,3,itrc)+ &
1660 & t(i,j,k+2,3,itrc)))*ad_fc(i,k)
1661 ad_t(i,j,k-1,3,itrc)=ad_t(i,j,k-1,3,itrc)-adfac2
1662 ad_t(i,j,k ,3,itrc)=ad_t(i,j,k ,3,itrc)+adfac1
1663 ad_t(i,j,k+1,3,itrc)=ad_t(i,j,k+1,3,itrc)+adfac1
1664 ad_t(i,j,k+2,3,itrc)=ad_t(i,j,k+2,3,itrc)-adfac2
1665 ad_fc(i,k)=0.0_r8
1666 END DO
1667 END DO
1668 END IF vadv_flux
1669 END DO j_loop1
1670 END DO t_loop2
1671
1672
1673
1674
1675
1676 t_loop1 :
DO itrc=1,
nt(ng)
1677
1678 k_loop :
DO k=1,
n(ng)
1679
1680
1681
1683 CONTINUE
1684 ELSE
1685 DO j=jstr,jend
1686 DO i=istr,iend
1687 cff=
dt(ng)*pm(i,j)*pn(i,j)
1688# ifdef DIAGNOSTICS_TS
1689
1690
1691
1692# endif
1693
1694
1695 ad_cff3=ad_cff3-ad_t(i,j,k,nnew,itrc)
1696
1697
1698 ad_cff1=ad_cff1+ad_cff3
1699 ad_cff2=ad_cff2+ad_cff3
1700 ad_cff3=0.0_r8
1701
1702
1703 adfac=cff*ad_cff2
1704 ad_fe(i,j )=ad_fe(i,j )-adfac
1705 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac
1706 ad_cff2=0.0_r8
1707
1708
1709 adfac=cff*ad_cff1
1710 ad_fx(i ,j)=ad_fx(i ,j)-adfac
1711 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac
1712 ad_cff1=0.0_r8
1713 END DO
1714 END DO
1715 END IF hadv_stepping
1716
1717
1718
1719
1720
1721
1722
1727 IF (int(
sources(ng)%Dsrc(is)).eq.0)
THEN
1730 lapplysrc=(istrum2.le.isrc).and. &
1731 & (isrc.le.iendp3).and. &
1732 & (jstrvm2.le.jsrc).and. &
1733 & (jsrc.le.jendp2i)
1734 ELSE
1735 lapplysrc=(istr.le.isrc).and. &
1736 & (isrc.le.iend+1).and. &
1737 & (jstr.le.jsrc).and. &
1738 & (jsrc.le.jend)
1739 END IF
1740 IF (lapplysrc) THEN
1742
1743
1744
1745
1746
1747 ad_huon(isrc,jsrc,k)=ad_huon(isrc,jsrc,k)+ &
1748 &
sources(ng)%Tsrc(is,k,itrc)* &
1749 & ad_fx(isrc,jsrc)
1750 sources(ng)%ad_Tsrc(is,k,itrc)= &
1751 &
sources(ng)%ad_Tsrc(is,k,itrc)+ &
1752 & huon(isrc,jsrc,k)* &
1753 & ad_fx(isrc,jsrc)
1754 ad_fx(isrc,jsrc)=0.0_r8
1755# ifdef MASKING
1756 ELSE
1757 IF ((rmask(isrc ,jsrc).eq.0.0_r8).and. &
1758 & (rmask(isrc-1,jsrc).eq.1.0_r8)) THEN
1759
1760
1761
1762
1763
1764 ad_t(isrc-1,jsrc,k,3,itrc)= &
1765 & ad_t(isrc-1,jsrc,k,3,itrc)+ &
1766 & huon(isrc,jsrc,k)* &
1767 & ad_fx(isrc,jsrc)
1768 ad_huon(isrc,jsrc,k)=ad_huon(isrc,jsrc,k)+ &
1769 & t(isrc-1,jsrc,k,3,itrc)* &
1770 & ad_fx(isrc,jsrc)
1771 ad_fx(isrc,jsrc)=0.0_r8
1772 ELSE IF ((rmask(isrc ,jsrc).eq.1.0_r8).and. &
1773 & (rmask(isrc-1,jsrc).eq.0.0_r8)) THEN
1774
1775
1776
1777
1778
1779 ad_t(isrc ,jsrc,k,3,itrc)= &
1780 & ad_t(isrc ,jsrc,k,3,itrc)+ &
1781 & huon(isrc,jsrc,k)* &
1782 & ad_fx(isrc,jsrc)
1783 ad_huon(isrc,jsrc,k)=ad_huon(isrc,jsrc,k)+ &
1784 & t(isrc ,jsrc,k,3,itrc)* &
1785 & ad_fx(isrc,jsrc)
1786 ad_fx(isrc,jsrc)=0.0_r8
1787 END IF
1788# endif
1789 END IF
1790 END IF
1791 ELSE IF (int(
sources(ng)%Dsrc(is)).eq.1)
THEN
1794 lapplysrc=(istrum2.le.isrc).and. &
1795 & (isrc.le.iendp2i).and. &
1796 & (jstrvm2.le.jsrc).and. &
1797 & (jsrc.le.jendp3)
1798 ELSE
1799 lapplysrc=(istr.le.isrc).and. &
1800 & (isrc.le.iend).and. &
1801 & (jstr.le.jsrc).and. &
1802 & (jsrc.le.jend+1)
1803 END IF
1804 IF (lapplysrc) THEN
1806
1807
1808
1809
1810
1811 ad_hvom(isrc,jsrc,k)=ad_hvom(isrc,jsrc,k)+ &
1812 &
sources(ng)%Tsrc(is,k,itrc)* &
1813 & ad_fe(isrc,jsrc)
1814 sources(ng)%ad_Tsrc(is,k,itrc)= &
1815 &
sources(ng)%ad_Tsrc(is,k,itrc)+ &
1816 & hvom(isrc,jsrc,k)* &
1817 & ad_fe(isrc,jsrc)
1818 ad_fe(isrc,jsrc)=0.0_r8
1819# ifdef MASKING
1820 ELSE
1821 IF ((rmask(isrc,jsrc ).eq.0.0_r8).and. &
1822 & (rmask(isrc,jsrc-1).eq.1.0_r8)) THEN
1823
1824
1825
1826
1827
1828 ad_t(isrc,jsrc-1,k,3,itrc)= &
1829 & ad_t(isrc,jsrc-1,k,3,itrc)+ &
1830 & hvom(isrc,jsrc,k)* &
1831 & ad_fe(isrc,jsrc)
1832 ad_hvom(isrc,jsrc,k)=ad_hvom(isrc,jsrc,k)+ &
1833 & t(isrc,jsrc-1,k,3,itrc)* &
1834 & ad_fe(isrc,jsrc)
1835 ad_fe(isrc,jsrc)=0.0_r8
1836 ELSE IF ((rmask(isrc,jsrc ).eq.1.0_r8).and. &
1837 & (rmask(isrc,jsrc-1).eq.0.0_r8)) THEN
1838
1839
1840
1841
1842
1843 ad_t(isrc,jsrc ,k,3,itrc)= &
1844 & ad_t(isrc,jsrc ,k,3,itrc)+ &
1845 & hvom(isrc,jsrc,k)* &
1846 & ad_fe(isrc,jsrc)
1847 ad_hvom(isrc,jsrc,k)=ad_hvom(isrc,jsrc,k)+ &
1848 & t(isrc,jsrc ,k,3,itrc)* &
1849 & ad_fe(isrc,jsrc)
1850 ad_fe(isrc,jsrc)=0.0_r8
1851 END IF
1852# endif
1853 END IF
1854 END IF
1855 END IF
1856 END DO
1857 END IF
1858
1859
1860
1862
1863
1864
1865 DO j=jstr,jend+1
1866 DO i=istr,iend
1867
1868
1869
1870
1871
1872
1873 adfac=0.5_r8*ad_fe(i,j)
1874 adfac1=adfac*hvom(i,j,k)
1875 ad_t(i,j-1,k,3,itrc)=ad_t(i,j-1,k,3,itrc)+adfac1
1876 ad_t(i,j ,k,3,itrc)=ad_t(i,j ,k,3,itrc)+adfac1
1877 ad_hvom(i,j,k)=ad_hvom(i,j,k)+ &
1878 & (t(i,j-1,k,3,itrc)+ &
1879 & t(i,j ,k,3,itrc))*adfac
1880 ad_fe(i,j)=0.0_r8
1881 END DO
1882 END DO
1883 DO j=jstr,jend
1884 DO i=istr,iend+1
1885
1886
1887
1888
1889
1890
1891 adfac=0.5_r8*ad_fx(i,j)
1892 adfac1=adfac*huon(i,j,k)
1893 ad_t(i-1,j,k,3,itrc)=ad_t(i-1,j,k,3,itrc)+adfac1
1894 ad_t(i ,j,k,3,itrc)=ad_t(i ,j,k,3,itrc)+adfac1
1895 ad_huon(i,j,k)=ad_huon(i,j,k)+ &
1896 & (t(i-1,j,k,3,itrc)+ &
1897 & t(i ,j,k,3,itrc))*adfac
1898 ad_fx(i,j)=0.0_r8
1899 END DO
1900 END DO
1901
1903
1904
1905
1906
1907 CONTINUE
1908
1910
1911
1912
1913
1914
1915 CONTINUE
1916
1921
1922
1923
1924
1925 DO j=jstrm1,jendp2
1926 DO i=istr,iend
1927 fe(i,j)=t(i,j ,k,3,itrc)- &
1928 & t(i,j-1,k,3,itrc)
1929# ifdef MASKING
1930 fe(i,j)=fe(i,j)*vmask(i,j)
1931# endif
1932 END DO
1933 END DO
1935 IF (
domain(ng)%Southern_Edge(tile))
THEN
1936 DO i=istr,iend
1937 fe(i,jstr-1)=fe(i,jstr)
1938 END DO
1939 END IF
1940 END IF
1942 IF (
domain(ng)%Northern_Edge(tile))
THEN
1943 DO i=istr,iend
1944 fe(i,jend+2)=fe(i,jend+1)
1945 END DO
1946 END IF
1947 END IF
1948
1949 DO j=jstr-1,jend+1
1950 DO i=istr,iend
1952 curv(i,j)=fe(i,j+1)-fe(i,j)
1954 cff=2.0_r8*fe(i,j+1)*fe(i,j)
1955 IF (cff.gt.eps) THEN
1956 grad(i,j)=cff/(fe(i,j+1)+fe(i,j))
1957 ELSE
1958 grad(i,j)=0.0_r8
1959 END IF
1962 grad(i,j)=0.5_r8*(fe(i,j+1)+fe(i,j))
1963 END IF
1964 END DO
1965 END DO
1966
1967 cff1=1.0_r8/6.0_r8
1968 cff2=1.0_r8/3.0_r8
1969 DO j=jstr,jend+1
1970 DO i=istr,iend
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989 adfac=0.5_r8*ad_fe(i,j)
1990 adfac1=adfac*hvom(i,j,k)
1991 adfac2=cff1*ad_fe(i,j)
1992 ad_hvom(i,j,k)=ad_hvom(i,j,k)+ &
1993 & (t(i,j-1,k,3,itrc)+ &
1994 & t(i,j ,k,3,itrc))*adfac- &
1995 & (curv(i,j-1)* &
1996 & (0.5_r8+sign(0.5_r8, hvom(i,j,k)))+ &
1997 & curv(i,j )* &
1998 & (0.5_r8+sign(0.5_r8,-hvom(i,j,k))))* &
1999 & adfac2
2000 ad_t(i,j-1,k,3,itrc)=ad_t(i,j-1,k,3,itrc)+adfac1
2001 ad_t(i,j ,k,3,itrc)=ad_t(i,j ,k,3,itrc)+adfac1
2002 ad_curv(i,j-1)=ad_curv(i,j-1)- &
2003 & max(hvom(i,j,k),0.0_r8)*adfac2
2004 ad_curv(i,j )=ad_curv(i,j )- &
2005 & min(hvom(i,j,k),0.0_r8)*adfac2
2006 ad_fe(i,j)=0.0_r8
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022 adfac=0.5_r8*ad_fe(i,j)
2023 adfac1=adfac*hvom(i,j,k)
2024 adfac2=adfac1*cff2
2025 ad_hvom(i,j,k)=ad_hvom(i,j,k)+ &
2026 & adfac*(t(i,j-1,k,3,itrc)+ &
2027 & t(i,j ,k,3,itrc)- &
2028 & cff2*(grad(i,j )- &
2029 & grad(i,j-1)))
2030 ad_t(i,j-1,k,3,itrc)=ad_t(i,j-1,k,3,itrc)+adfac1
2031 ad_t(i,j ,k,3,itrc)=ad_t(i,j ,k,3,itrc)+adfac1
2032 ad_grad(i,j-1)=ad_grad(i,j-1)+adfac2
2033 ad_grad(i,j )=ad_grad(i,j )-adfac2
2034 ad_fe(i,j)=0.0_r8
2035 END IF
2036 END DO
2037 END DO
2038
2039 DO j=jstr-1,jend+1
2040 DO i=istr,iend
2042
2043
2044 ad_fe(i,j )=ad_fe(i,j )-ad_curv(i,j)
2045 ad_fe(i,j+1)=ad_fe(i,j+1)+ad_curv(i,j)
2046 ad_curv(i,j)=0.0_r8
2048 cff=2.0_r8*fe(i,j+1)*fe(i,j)
2049 IF (cff.gt.eps) THEN
2050
2051
2052
2053
2054
2055 adfac=ad_grad(i,j)/ &
2056 & ((fe(i,j+1)+fe(i,j))*(fe(i,j+1)+fe(i,j)))
2057 adfac1=adfac*cff
2058 ad_fe(i,j )=ad_fe(i,j)-adfac1
2059 ad_fe(i,j+1)=ad_fe(i,j+1)-adfac1
2060 ad_cff=ad_cff+(fe(i,j+1)+fe(i,j))*adfac
2061 ad_grad(i,j)=0.0_r8
2062 ELSE
2063
2064
2065 ad_grad(i,j)=0.0_r8
2066 END IF
2067
2068
2069
2070 adfac=2.0_r8*ad_cff
2071 ad_fe(i,j )=ad_fe(i,j )+fe(i,j+1)*adfac
2072 ad_fe(i,j+1)=ad_fe(i,j+1)+fe(i,j )*adfac
2073 ad_cff=0.0_r8
2076
2077
2078 adfac=0.5_r8*ad_grad(i,j)
2079 ad_fe(i,j )=ad_fe(i,j )+adfac
2080 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac
2081 ad_grad(i,j)=0.0_r8
2082 END IF
2083 END DO
2084 END DO
2086 IF (
domain(ng)%Northern_Edge(tile))
THEN
2087 DO i=istr,iend
2088
2089
2090 ad_fe(i,jend+1)=ad_fe(i,jend+1)+ad_fe(i,jend+2)
2091 ad_fe(i,jend+2)=0.0_r8
2092 END DO
2093 END IF
2094 END IF
2096 IF (
domain(ng)%Southern_Edge(tile))
THEN
2097 DO i=istr,iend
2098
2099
2100 ad_fe(i,jstr)=ad_fe(i,jstr)+ad_fe(i,jstr-1)
2101 ad_fe(i,jstr-1)=0.0_r8
2102 END DO
2103 END IF
2104 END IF
2105
2106 DO j=jstrm1,jendp2
2107 DO i=istr,iend
2108# ifdef MASKING
2109
2110
2111 ad_fe(i,j)=ad_fe(i,j)*vmask(i,j)
2112# endif
2113
2114
2115
2116 ad_t(i,j-1,k,3,itrc)=ad_t(i,j-1,k,3,itrc)-ad_fe(i,j)
2117 ad_t(i,j ,k,3,itrc)=ad_t(i,j ,k,3,itrc)+ad_fe(i,j)
2118 ad_fe(i,j)=0.0_r8
2119 END DO
2120 END DO
2121
2122 DO j=jstr,jend
2123 DO i=istrm1,iendp2
2124 fx(i,j)=t(i ,j,k,3,itrc)- &
2125 & t(i-1,j,k,3,itrc)
2126# ifdef MASKING
2127 fx(i,j)=fx(i,j)*umask(i,j)
2128# endif
2129 END DO
2130 END DO
2132 IF (
domain(ng)%Western_Edge(tile))
THEN
2133 DO j=jstr,jend
2134 fx(istr-1,j)=fx(istr,j)
2135 END DO
2136 END IF
2137 END IF
2139 IF (
domain(ng)%Eastern_Edge(tile))
THEN
2140 DO j=jstr,jend
2141 fx(iend+2,j)=fx(iend+1,j)
2142 END DO
2143 END IF
2144 END IF
2145
2146 DO j=jstr,jend
2147 DO i=istr-1,iend+1
2149 curv(i,j)=fx(i+1,j)-fx(i,j)
2151 cff=2.0_r8*fx(i+1,j)*fx(i,j)
2152 IF (cff.gt.eps) THEN
2153 grad(i,j)=cff/(fx(i+1,j)+fx(i,j))
2154 ELSE
2155 grad(i,j)=0.0_r8
2156 END IF
2159 grad(i,j)=0.5_r8*(fx(i+1,j)+fx(i,j))
2160 END IF
2161 END DO
2162 END DO
2163
2164 cff1=1.0_r8/6.0_r8
2165 cff2=1.0_r8/3.0_r8
2166 DO j=jstr,jend
2167 DO i=istr,iend+1
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186 adfac=0.5_r8*ad_fx(i,j)
2187 adfac1=adfac*huon(i,j,k)
2188 adfac2=cff1*ad_fx(i,j)
2189 ad_huon(i,j,k)=ad_huon(i,j,k)+ &
2190 & (t(i-1,j,k,3,itrc)+ &
2191 & t(i ,j,k,3,itrc))*adfac- &
2192 & (curv(i-1,j)* &
2193 & (0.5_r8+sign(0.5_r8, huon(i,j,k)))+ &
2194 & curv(i ,j)* &
2195 & (0.5_r8+sign(0.5_r8,-huon(i,j,k))))* &
2196 & adfac2
2197 ad_t(i-1,j,k,3,itrc)=ad_t(i-1,j,k,3,itrc)+adfac1
2198 ad_t(i ,j,k,3,itrc)=ad_t(i ,j,k,3,itrc)+adfac1
2199 ad_curv(i-1,j)=ad_curv(i-1,j)- &
2200 & max(huon(i,j,k),0.0_r8)*adfac2
2201 ad_curv(i ,j)=ad_curv(i ,j)- &
2202 & min(huon(i,j,k),0.0_r8)*adfac2
2203 ad_fx(i,j)=0.0_r8
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219 adfac=0.5_r8*ad_fx(i,j)
2220 adfac1=adfac*huon(i,j,k)
2221 adfac2=adfac1*cff2
2222 ad_huon(i,j,k)=ad_huon(i,j,k)+ &
2223 & adfac*(t(i-1,j,k,3,itrc)+ &
2224 & t(i ,j,k,3,itrc)- &
2225 & cff2*(grad(i ,j)- &
2226 & grad(i-1,j)))
2227 ad_t(i-1,j,k,3,itrc)=ad_t(i-1,j,k,3,itrc)+adfac1
2228 ad_t(i ,j,k,3,itrc)=ad_t(i ,j,k,3,itrc)+adfac1
2229 ad_grad(i-1,j)=ad_grad(i-1,j)+adfac2
2230 ad_grad(i ,j)=ad_grad(i ,j)-adfac2
2231 ad_fx(i,j)=0.0_r8
2232 END IF
2233 END DO
2234 END DO
2235
2236 DO j=jstr,jend
2237 DO i=istr-1,iend+1
2239
2240
2241 ad_fx(i ,j)=ad_fx(i ,j)-ad_curv(i,j)
2242 ad_fx(i+1,j)=ad_fx(i+1,j)+ad_curv(i,j)
2243 ad_curv(i,j)=0.0_r8
2245 cff=2.0_r8*fx(i+1,j)*fx(i,j)
2246 IF (cff.gt.eps) THEN
2247
2248
2249
2250
2251
2252 adfac=ad_grad(i,j)/ &
2253 & ((fx(i+1,j)+fx(i,j))*(fx(i+1,j)+fx(i,j)))
2254 adfac1=adfac*cff
2255 ad_fx(i ,j)=ad_fx(i ,j)-adfac1
2256 ad_fx(i+1,j)=ad_fx(i+1,j)-adfac1
2257 ad_cff=ad_cff+(fx(i+1,j)+fx(i,j))*adfac
2258 ad_grad(i,j)=0.0_r8
2259 ELSE
2260
2261
2262 ad_grad(i,j)=0.0_r8
2263 END IF
2266
2267
2268 adfac=0.5_r8*ad_grad(i,j)
2269 ad_fx(i ,j)=ad_fx(i ,j)+adfac
2270 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac
2271 ad_grad(i,j)=0.0_r8
2272 END IF
2273
2274
2275
2276 adfac=2.0_r8*ad_cff
2277 ad_fx(i ,j)=ad_fx(i ,j)+fx(i+1,j)*adfac
2278 ad_fx(i+1,j)=ad_fx(i+1,j)+fx(i ,j)*adfac
2279 ad_cff=0.0_r8
2280 END DO
2281 END DO
2283 IF (
domain(ng)%Eastern_Edge(tile))
THEN
2284 DO j=jstr,jend
2285
2286
2287 ad_fx(iend+1,j)=ad_fx(iend+1,j)+ad_fx(iend+2,j)
2288 ad_fx(iend+2,j)=0.0_r8
2289 END DO
2290 END IF
2291 END IF
2293 IF (
domain(ng)%Western_Edge(tile))
THEN
2294 DO j=jstr,jend
2295
2296
2297 ad_fx(istr,j)=ad_fx(istr,j)+ad_fx(istr-1,j)
2298 ad_fx(istr-1,j)=0.0_r8
2299 END DO
2300 END IF
2301 END IF
2302
2303 DO j=jstr,jend
2304 DO i=istrm1,iendp2
2305# ifdef MASKING
2306
2307
2308 ad_fx(i,j)=ad_fx(i,j)*umask(i,j)
2309# endif
2310
2311
2312
2313 ad_t(i-1,j,k,3,itrc)=ad_t(i-1,j,k,3,itrc)-ad_fx(i,j)
2314 ad_t(i ,j,k,3,itrc)=ad_t(i ,j,k,3,itrc)+ad_fx(i,j)
2315 ad_fx(i,j)=0.0_r8
2316 END DO
2317 END DO
2318 END IF hadv_flux
2319 END DO k_loop
2320
2321# ifdef AD_SUPPORTED
2322
2323
2324
2325
2326
2329# ifdef DISTRIBUTE
2330
2331
2332
2333
2334
2335
2337 & lbi, ubi, lbj, ubj, 1,
n(ng), &
2340 & ad_t(:,:,:,nnew,itrc))
2341# endif
2343
2344
2345
2346
2348 & lbi, ubi, lbj, ubj, 1,
n(ng), &
2349 & ad_t(:,:,:,nnew,itrc))
2350 END IF
2351 END IF
2352# endif
2353
2354 END DO t_loop1
2355
2356
2357
2358 IF (lhsimt) THEN
2360 DO j=jstrm2,jendp2
2361 DO i=istrm2,iendp2
2362 ohz(i,j,k)=1.0_r8/hz(i,j,k)
2363
2364
2365 ad_hz(i,j,k)=ad_hz(i,j,k)- &
2366 & ohz(i,j,k)*ohz(i,j,k)*ad_ohz(i,j,k)
2367 ad_ohz(i,j,k)=0.0_r8
2368 END DO
2369 END DO
2370 END DO
2371 ELSE
2373 DO j=jstr,jend
2374 DO i=istr,iend
2375 ohz(i,j,k)=1.0_r8/hz(i,j,k)
2376
2377
2378 ad_hz(i,j,k)=ad_hz(i,j,k)- &
2379 & ohz(i,j,k)*ohz(i,j,k)*ad_ohz(i,j,k)
2380 ad_ohz(i,j,k)=0.0_r8
2381 END DO
2382 END DO
2383 END DO
2384 END IF
2385
2386 RETURN
subroutine ad_exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
subroutine, public ad_t3dbc_tile(ng, tile, itrc, ic, lbi, ubi, lbj, ubj, ubk, ubt, imins, imaxs, jmins, jmaxs, nstp, nout, ad_t)
type(t_clima), dimension(:), allocatable clima
type(t_adv), dimension(:,:), allocatable ad_hadvection
integer, dimension(:), allocatable n
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable nt
type(t_adv), dimension(:,:), allocatable ad_vadvection
logical, dimension(:), allocatable luvsrc
logical, dimension(:,:), allocatable ltracersrc
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:), allocatable lwsrc
logical, dimension(:,:), allocatable compositegrid
integer, parameter isouth
integer, dimension(:), pointer inert
logical, dimension(:,:), allocatable ltracerclm
integer, parameter inorth
logical, dimension(:,:), allocatable lnudgetclm
type(t_sources), dimension(:), allocatable sources
integer, dimension(:), allocatable nsrc
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine ad_mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)