ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
ad_set_depth_mod Module Reference

Functions/Subroutines

subroutine, public ad_set_depth (ng, tile, model)
 
subroutine, public ad_set_depth_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, ad_h, zice, zt_avg1, ad_zt_avg1, ad_hz, ad_z_r, ad_z_w)
 
subroutine, public ad_set_depth_bry (ng, tile, model)
 
subroutine ad_set_depth_bry_tile (ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, h, ad_h, zice, ad_hz_bry)
 

Function/Subroutine Documentation

◆ ad_set_depth()

subroutine, public ad_set_depth_mod::ad_set_depth ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 35 of file ad_set_depth.F.

36!***********************************************************************
37!
38 USE mod_param
39 USE mod_coupling
40 USE mod_grid
41 USE mod_ocean
42 USE mod_stepping
43!
44! Imported variable declarations.
45!
46 integer, intent(in) :: ng, tile, model
47!
48! Local variable declarations.
49!
50 character (len=*), parameter :: MyFile = &
51 & __FILE__
52!
53# include "tile.h"
54!
55# ifdef PROFILE
56 CALL wclock_on (ng, model, 12, __line__, myfile)
57# endif
58 CALL ad_set_depth_tile (ng, tile, model, &
59 & lbi, ubi, lbj, ubj, &
60 & imins, imaxs, jmins, jmaxs, &
61 & nstp(ng), nnew(ng), &
62 & grid(ng) % h, &
63 & grid(ng) % ad_h, &
64# ifdef ICESHELF
65 & grid(ng) % zice, &
66# endif
67 & coupling(ng) % Zt_avg1, &
68 & coupling(ng) % ad_Zt_avg1, &
69 & grid(ng) % ad_Hz, &
70 & grid(ng) % ad_z_r, &
71 & grid(ng) % ad_z_w)
72# ifdef PROFILE
73 CALL wclock_off (ng, model, 12, __line__, myfile)
74# endif
75!
76 RETURN
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ocean
Definition mod_ocean.F:2
mod_param
Definition mod_param.F:2
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References ad_set_depth_tile(), mod_coupling::coupling, mod_grid::grid, mod_stepping::nnew, mod_stepping::nstp, wclock_off(), and wclock_on().

Referenced by ad_main3d(), ad_nesting_mod::ad_nesting(), ad_post_initial_mod::ad_post_initial(), ad_step2d_mod::ad_step2d_tile(), and ad_step2d_mod::ad_step2d_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ad_set_depth_bry()

subroutine, public ad_set_depth_mod::ad_set_depth_bry ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 417 of file ad_set_depth.F.

418!***********************************************************************
419!
420 USE mod_param
421 USE mod_grid
422!
423! Imported variable declarations.
424!
425 integer, intent(in) :: ng, tile, model
426!
427! Local variable declarations.
428!
429 character (len=*), parameter :: MyFile = &
430 & __FILE__//", ad_set_depth_bry"
431!
432# include "tile.h"
433!
434# ifdef PROFILE
435 CALL wclock_on (ng, model, 12, __line__, myfile)
436# endif
437 CALL ad_set_depth_bry_tile (ng, tile, model, &
438 & lbi, ubi, lbj, ubj, lbij, ubij, &
439 & imins, imaxs, jmins, jmaxs, &
440 & grid(ng) % h, &
441 & grid(ng) % ad_h, &
442# ifdef ICESHELF
443 & grid(ng) % zice, &
444# endif
445 & grid(ng) % ad_Hz_bry)
446# ifdef PROFILE
447 CALL wclock_off (ng, model, 12, __line__, myfile)
448# endif
449!
450 RETURN

References ad_set_depth_bry_tile(), mod_grid::grid, wclock_off(), and wclock_on().

Referenced by ad_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ad_set_depth_bry_tile()

subroutine ad_set_depth_mod::ad_set_depth_bry_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:,lbj:), intent(in) h,
real(r8), dimension(lbi:,lbj:), intent(inout) ad_h,
real(r8), dimension(lbi:,lbj:), intent(in) zice,
real(r8), dimension(lbij:,:,:), intent(out) ad_hz_bry )
private

Definition at line 454 of file ad_set_depth.F.

462!***********************************************************************
463!
464 USE mod_param
465 USE mod_boundary
466 USE mod_ncparam
467 USE mod_scalars
468!
469# ifdef DISTRIBUTE
470 USE mp_exchange_mod, ONLY : ad_mp_exchange3d_bry
471# endif
472!
473! Imported variable declarations.
474!
475 integer, intent(in) :: ng, tile, model
476 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
477 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
478!
479# ifdef ASSUMED_SHAPE
480 real(r8), intent(in) :: h(LBi:,LBj:)
481 real(r8), intent(inout) :: ad_h(LBi:,LBj:)
482# ifdef ICESHELF
483 real(r8), intent(in) :: zice(LBi:,LBj:)
484# endif
485 real(r8), intent(out) :: ad_Hz_bry(LBij:,:,:)
486# else
487 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
488 real(r8), intent(inout) :: ad_h(LBi:UBi,LBj:UBj)
489# ifdef ICESHELF
490 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
491# endif
492 real(r8), intent(out) :: ad_Hz_bry(LBij:UBij,N(ng),4)
493# endif
494!
495! Local variable declarations.
496!
497 integer :: i, ibry, j, k
498
499 real(r8) :: cff_w, cff1_w, cff2_w
500 real(r8) :: hinv, hwater, z_w0
501 real(r8) :: ad_cff2_w, ad_hinv, ad_hwater, ad_z_w0
502 real(r8) :: adfac
503
504 real(r8), dimension(0:N(ng)) :: ad_Zw
505
506# include "set_bounds.h"
507!
508!-----------------------------------------------------------------------
509! Initialize adjoint private variables.
510!-----------------------------------------------------------------------
511!
512 ad_cff2_w=0.0_r8
513 ad_z_w0=0.0_r8
514 ad_hinv=0.0_r8
515 ad_hwater=0.0_r8
516 ad_zw(0:n(ng))=0.0_r8
517
518# ifdef DISTRIBUTE
519!
520!-----------------------------------------------------------------------
521! Exchange boundary information.
522!-----------------------------------------------------------------------
523!
524 DO ibry=1,4
525!^ CALL mp_exchange3d_bry (ng, tile, model, 1, ibry, &
526!^ & LBij, UBij, 1, N(ng), &
527!^ & NghostPoints, &
528!^ & EWperiodic(ng), NSperiodic(ng), &
529!^ & tl_Hz_bry(:,:,ibry))
530!^
531 CALL ad_mp_exchange3d_bry (ng, tile, model, 1, ibry, &
532 & lbij, ubij, 1, n(ng), &
533 & nghostpoints, &
534 & ewperiodic(ng), nsperiodic(ng), &
535 & ad_hz_bry(:,:,ibry))
536 END DO
537# endif
538!
539!-----------------------------------------------------------------------
540! Original formulation: Compute vertical depths (meters, negative) at
541! RHO- and W-points, and vertical grid
542! thicknesses. Various stretching functions are possible.
543!
544! z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
545!
546! Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
547!
548!-----------------------------------------------------------------------
549!
550 IF (vtransform(ng).eq.1) THEN
551
552 IF (ad_lbc(inorth,isfsur,ng)%acquire.and. &
553 & domain(ng)%Northern_Edge(tile)) THEN
554 j=bounds(ng)%edge(inorth,r2dvar)
555 DO i=istrt,iendt
556 hwater=h(i,j)
557# ifdef ICESHELF
558 hwater=hwater-abs(zice(i,j))
559# endif
560 hinv=1.0_r8/hwater
561 DO k=1,n(ng)
562 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
563 cff1_w=scalars(ng)%Cs_w(k)
564 z_w0=cff_w+cff1_w*hwater
565!^ tl_Hz_bry(i,k,inorth)=tl_Zw(k)-tl_Zw(k-1)
566!^
567 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,inorth)
568 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,inorth)
569 ad_hz_bry(i,k,inorth)=0.0_r8
570!^ tl_Zw(k)=tl_z_w0+ &
571!^ & BOUNDARY(ng)%tl_zeta_north(i)* &
572!^ & (1.0_r8+z_w0*hinv)+ &
573!^ & BOUNDARY(ng)%zeta_north(i)* &
574!^ & (tl_z_w0*hinv+z_w0*tl_hinv)
575!^
576 adfac=boundary(ng)%zeta_north(i)*ad_zw(k)
577 ad_z_w0=ad_z_w0+hinv*adfac+ad_zw(k)
578 ad_hinv=ad_hinv+z_w0*adfac
579 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
580 & ad_zeta_north(i)+ &
581 & (1.0_r8+z_w0*hinv)*ad_zw(k)
582 ad_zw(k)=0.0_r8
583!^ tl_z_w0=cff1_w*tl_hwater
584!^
585 ad_hwater=ad_hwater+cff1_w*ad_z_w0
586 ad_z_w0=0.0_r8
587 END DO
588!^ tl_Zw(0)=-tl_h(i,j)
589!^
590 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
591 ad_zw(0)=0.0_r8
592!^ tl_hinv=-hinv*hinv*tl_hwater
593!^
594 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
595 ad_hinv=0.0_r8
596!^ tl_hwater=tl_h(i,j)
597!^
598 ad_h(i,j)=ad_h(i,j)+ad_hwater
599 ad_hwater=0.0_r8
600 END DO
601 END IF
602!
603 IF (ad_lbc(isouth,isfsur,ng)%acquire.and. &
604 & domain(ng)%Southern_Edge(tile)) THEN
605 j=bounds(ng)%edge(isouth,r2dvar)
606 DO i=istrt,iendt
607 hwater=h(i,j)
608# ifdef ICESHELF
609 hwater=hwater-abs(zice(i,j))
610# endif
611 hinv=1.0_r8/hwater
612 DO k=1,n(ng)
613 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
614 cff1_w=scalars(ng)%Cs_w(k)
615 z_w0=cff_w+cff1_w*hwater
616!^ tl_Hz_bry(i,k,isouth)=tl_Zw(k)-tl_Zw(k-1)
617!^
618 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,isouth)
619 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,isouth)
620 ad_hz_bry(i,k,isouth)=0.0_r8
621!^ tl_Zw(k)=tl_z_w0+ &
622!^ & BOUNDARY(ng)%tl_zeta_south(i)* &
623!^ & (1.0_r8+z_w0*hinv)+ &
624!^ & BOUNDARY(ng)%zeta_south(i)* &
625!^ & (tl_z_w0*hinv+z_w0*tl_hinv)
626!^
627 adfac=boundary(ng)%zeta_south(i)*ad_zw(k)
628 ad_z_w0=ad_z_w0+hinv*adfac+ad_zw(k)
629 ad_hinv=ad_hinv+z_w0*adfac
630 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
631 & ad_zeta_south(i)+ &
632 & (1.0_r8+z_w0*hinv)*ad_zw(k)
633 ad_zw(k)=0.0_r8
634!^ tl_z_w0=cff1_w*tl_hwater
635!^
636 ad_hwater=ad_hwater+cff1_w*ad_z_w0
637 ad_z_w0=0.0_r8
638 END DO
639!^ tl_Zw(0)=-tl_h(i,j)
640!^
641 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
642 ad_zw(0)=0.0_r8
643!^ tl_hinv=-hinv*hinv*tl_hwater
644!^
645 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
646 ad_hinv=0.0_r8
647!^ tl_hwater=tl_h(i,j)
648!^
649 ad_h(i,j)=ad_h(i,j)+ad_hwater
650 ad_hwater=0.0_r8
651 END DO
652 END IF
653!
654 IF (ad_lbc(ieast,isfsur,ng)%acquire.and. &
655 & domain(ng)%Eastern_Edge(tile)) THEN
656 i=bounds(ng)%edge(ieast,r2dvar)
657 DO j=jstrt,jendt
658 hwater=h(i,j)
659# ifdef ICESHELF
660 hwater=hwater-abs(zice(i,j))
661# endif
662 hinv=1.0_r8/hwater
663 DO k=1,n(ng)
664 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
665 cff1_w=scalars(ng)%Cs_w(k)
666 z_w0=cff_w+cff1_w*hwater
667!^ tl_Hz_bry(i,k,ieast)=tl_Zw(k)-tl_Zw(k-1)
668!^
669 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,ieast)
670 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,ieast)
671 ad_hz_bry(i,k,ieast)=0.0_r8
672!^ tl_Zw(k)=tl_z_w0+ &
673!^ & BOUNDARY(ng)%tl_zeta_east(j)* &
674!^ & (1.0_r8+z_w0*hinv)+ &
675!^ & BOUNDARY(ng)%zeta_east(j)* &
676!^ & (tl_z_w0*hinv+z_w0*tl_hinv)
677!^
678 adfac=boundary(ng)%zeta_east(j)*ad_zw(k)
679 ad_z_w0=ad_z_w0+hinv*adfac+ad_zw(k)
680 ad_hinv=ad_hinv+z_w0*adfac
681 boundary(ng)%ad_zeta_east(j)=boundary(ng)% &
682 & ad_zeta_east(j)+ &
683 & (1.0_r8+z_w0*hinv)*ad_zw(k)
684 ad_zw(k)=0.0_r8
685!^ tl_z_w0=cff1_w*tl_hwater
686!^
687 ad_hwater=ad_hwater+cff1_w*ad_z_w0
688 ad_z_w0=0.0_r8
689 END DO
690!^ tl_Zw(0)=-tl_h(i,j)
691!^
692 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
693 ad_zw(0)=0.0_r8
694!^ tl_hinv=-hinv*hinv*tl_hwater
695!^
696 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
697 ad_hinv=0.0_r8
698!^ tl_hwater=tl_h(i,j)
699!^
700 ad_h(i,j)=ad_h(i,j)+ad_hwater
701 ad_hwater=0.0_r8
702 END DO
703 END IF
704!
705 IF (ad_lbc(iwest,isfsur,ng)%acquire.and. &
706 & domain(ng)%Western_Edge(tile)) THEN
707 i=bounds(ng)%edge(iwest,r2dvar)
708 DO j=jstrt,jendt
709 hwater=h(i,j)
710# ifdef ICESHELF
711 hwater=hwater-abs(zice(i,j))
712# endif
713 hinv=1.0_r8/hwater
714 DO k=1,n(ng)
715 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
716 cff1_w=scalars(ng)%Cs_w(k)
717 z_w0=cff_w+cff1_w*hwater
718!^ tl_Hz_bry(i,k,iwest)=tl_Zw(k)-tl_Zw(k-1)
719!^
720 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,iwest)
721 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,iwest)
722 ad_hz_bry(i,k,iwest)=0.0_r8
723!^ tl_Zw(k)=tl_z_w0+ &
724!^ & BOUNDARY(ng)%tl_zeta_west(j)* &
725!^ & (1.0_r8+z_w0*hinv)+ &
726!^ & BOUNDARY(ng)%zeta_west(j)* &
727!^ ^ (tl_z_w0*hinv+z_w0*tl_hinv)
728!^
729 adfac=boundary(ng)%zeta_west(j)*ad_zw(k)
730 ad_z_w0=ad_z_w0+hinv*adfac+ad_zw(k)
731 ad_hinv=ad_hinv+z_w0*adfac
732 boundary(ng)%ad_zeta_west(j)=boundary(ng)% &
733 & ad_zeta_west(j)+ &
734 & (1.0_r8+z_w0*hinv)*ad_zw(k)
735 ad_zw(k)=0.0_r8
736!^ tl_z_w0=cff1_w*tl_hwater
737!^
738 ad_hwater=ad_hwater+cff1_w*ad_z_w0
739 ad_z_w0=0.0_r8
740 END DO
741!^ tl_Zw(0)=-tl_h(i,j)
742!^
743 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
744 ad_zw(0)=0.0_r8
745!^ tl_hinv=-hinv*hinv*tl_hwater
746!^
747 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
748 ad_hinv=0.0_r8
749!^ tl_hwater=tl_h(i,j)
750!^
751 ad_h(i,j)=ad_h(i,j)+ad_hwater
752 ad_hwater=0.0_r8
753 END DO
754 END IF
755!
756!-----------------------------------------------------------------------
757! New formulation: Compute vertical depths (meters, negative) at
758! RHO- and W-points, and vertical grid thicknesses.
759! Various stretching functions are possible.
760!
761! z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
762!
763! Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
764!
765!-----------------------------------------------------------------------
766!
767 ELSE IF (vtransform(ng).eq.2) THEN
768
769 IF (ad_lbc(inorth,isfsur,ng)%acquire.and. &
770 & domain(ng)%Northern_Edge(tile)) THEN
771 j=bounds(ng)%edge(inorth,r2dvar)
772 DO i=istrt,iendt
773 hwater=h(i,j)
774# ifdef ICESHELF
775 hwater=hwater-abs(zice(i,j))
776# endif
777 hinv=1.0_r8/(hc(ng)+hwater)
778 DO k=1,n(ng)
779 cff_w=hc(ng)*scalars(ng)%sc_w(k)
780 cff1_w=scalars(ng)%Cs_w(k)
781 cff2_w=(cff_w+cff1_w*hwater)*hinv
782!^ tl_Hz_bry(i,k,inorth)=tl_Zw(k)-tl_Zw(k-1)
783!^
784 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,inorth)
785 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,inorth)
786 ad_hz_bry(i,k,inorth)=0.0_r8
787!^ tl_Zw(k)=BOUNDARY(ng)%tl_zeta_north(i)+ &
788!^ & (BOUNDARY(ng)%tl_zeta_north(i)+ &
789!^ & tl_hwater)*cff2_w+ &
790!^ & (BOUNDARY(ng)%zeta_north(i)+ &
791!^ & hwater)*tl_cff2_w
792!^
793 adfac=cff2_w*ad_zw(k)
794 ad_cff2_w=ad_cff2_w+ &
795 & (boundary(ng)%zeta_north(i)+hwater)*ad_zw(k)
796 ad_hwater=ad_hwater+adfac
797 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
798 & ad_zeta_north(i)+ &
799 & ad_zw(k)+adfac
800 ad_zw(k)=0.0_r8
801!^ tl_cff2_w=cff1_w*tl_hwater*hinv+ &
802!^ & (cff_w+cff1_w*hwater)*tl_hinv
803!^
804 ad_hinv=ad_hinv+ &
805 & (cff_w+cff1_w*hwater)*ad_cff2_w
806 ad_hwater=ad_hwater+ &
807 & cff1_w*hinv*ad_cff2_w
808 ad_cff2_w=0.0_r8
809 END DO
810!^ tl_Zw(0)=-tl_h(i,j)
811!^
812 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
813 ad_zw(0)=0.0_r8
814!^ tl_hinv=-hinv*hinv*tl_hwater
815!^
816 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
817 ad_hinv=0.0_r8
818!^ tl_hwater=tl_h(i,j)
819!^
820 ad_h(i,j)=ad_h(i,j)+ad_hwater
821 ad_hwater=0.0_r8
822 END DO
823 END IF
824!
825 IF (ad_lbc(isouth,isfsur,ng)%acquire.and. &
826 & domain(ng)%Southern_Edge(tile)) THEN
827 j=bounds(ng)%edge(isouth,r2dvar)
828 DO i=istrt,iendt
829 hwater=h(i,j)
830# ifdef ICESHELF
831 hwater=hwater-abs(zice(i,j))
832# endif
833 hinv=1.0_r8/(hc(ng)+hwater)
834 DO k=1,n(ng)
835 cff_w=hc(ng)*scalars(ng)%sc_w(k)
836 cff1_w=scalars(ng)%Cs_w(k)
837 cff2_w=(cff_w+cff1_w*hwater)*hinv
838!^ tl_Hz_bry(i,k,isouth)=tl_Zw(k)-tl_Zw(k-1)
839!^
840 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,isouth)
841 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,isouth)
842 ad_hz_bry(i,k,isouth)=0.0_r8
843!^ tl_Zw(k)=BOUNDARY(ng)%tl_zeta_south(i)+ &
844!^ & (BOUNDARY(ng)%tl_zeta_south(i)+ &
845!^ & tl_hwater)*cff2_w+ &
846!^ & (BOUNDARY(ng)%zeta_south(i)+ &
847!^ & hwater)*tl_cff2_w
848!^
849 adfac=cff2_w*ad_zw(k)
850 ad_cff2_w=ad_cff2_w+ &
851 & (boundary(ng)%zeta_south(i)+hwater)*ad_zw(k)
852 ad_hwater=ad_hwater+adfac
853 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
854 & ad_zeta_south(i)+ &
855 & ad_zw(k)+adfac
856 ad_zw(k)=0.0_r8
857!^ tl_cff2_w=cff1_w*tl_hwater*hinv+ &
858!^ & (cff_w+cff1_w*hwater)*tl_hinv
859!^
860 ad_hinv=ad_hinv+ &
861 & (cff_w+cff1_w*hwater)*ad_cff2_w
862 ad_hwater=ad_hwater+ &
863 & cff1_w*hinv*ad_cff2_w
864 ad_cff2_w=0.0_r8
865 END DO
866!^ tl_Zw(0)=-tl_h(i,j)
867!^
868 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
869 ad_zw(0)=0.0_r8
870!^ tl_hinv=-hinv*hinv*tl_hwater
871!^
872 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
873 ad_hinv=0.0_r8
874!^ tl_hwater=tl_h(i,j)
875!^
876 ad_h(i,j)=ad_h(i,j)+ad_hwater
877 ad_hwater=0.0_r8
878 END DO
879 END IF
880!
881 IF (ad_lbc(ieast,isfsur,ng)%acquire.and. &
882 & domain(ng)%Eastern_Edge(tile)) THEN
883 i=bounds(ng)%edge(ieast,r2dvar)
884 DO j=jstrt,jendt
885 hwater=h(i,j)
886# ifdef ICESHELF
887 hwater=hwater-abs(zice(i,j))
888# endif
889 hinv=1.0_r8/(hc(ng)+hwater)
890 DO k=1,n(ng)
891 cff_w=hc(ng)*scalars(ng)%sc_w(k)
892 cff1_w=scalars(ng)%Cs_w(k)
893 cff2_w=(cff_w+cff1_w*hwater)*hinv
894!^ tl_Hz_bry(i,k,ieast)=tl_Zw(k)-tl_Zw(k-1)
895!^
896 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,ieast)
897 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,ieast)
898 ad_hz_bry(i,k,ieast)=0.0_r8
899!^ tl_Zw(k)=BOUNDARY(ng)%tl_zeta_east(j)+ &
900!^ & (BOUNDARY(ng)%tl_zeta_east(j)+ &
901!^ & tl_hwater)*cff2_w+ &
902!^ & (BOUNDARY(ng)%zeta_east(j)+ &
903!^ & hwater)*tl_cff2_w
904!^
905 adfac=cff2_w*ad_zw(k)
906 ad_cff2_w=ad_cff2_w+ &
907 & (boundary(ng)%zeta_east(j)+hwater)*ad_zw(k)
908 ad_hwater=ad_hwater+adfac
909 boundary(ng)%ad_zeta_east(j)=boundary(ng)% &
910 & ad_zeta_east(j)+ &
911 & ad_zw(k)+adfac
912 ad_zw(k)=0.0_r8
913!^ tl_cff2_w=cff1_w*tl_hwater*hinv+ &
914!^ & (cff_w+cff1_w*hwater)*tl_hinv
915!^
916 ad_hinv=ad_hinv+ &
917 & (cff_w+cff1_w*hwater)*ad_cff2_w
918 ad_hwater=ad_hwater+ &
919 & cff1_w*hinv*ad_cff2_w
920 ad_cff2_w=0.0_r8
921 END DO
922!^ tl_Zw(0)=-tl_h(i,j)
923!^
924 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
925 ad_zw(0)=0.0_r8
926!^ tl_hinv=-hinv*hinv*tl_hwater
927!^
928 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
929 ad_hinv=0.0_r8
930!^ tl_hwater=tl_h(i,j)
931!^
932 ad_h(i,j)=ad_h(i,j)+ad_hwater
933 ad_hwater=0.0_r8
934 END DO
935 END IF
936!
937 IF (ad_lbc(iwest,isfsur,ng)%acquire.and. &
938 & domain(ng)%Western_Edge(tile)) THEN
939 i=bounds(ng)%edge(iwest,r2dvar)
940 DO j=jstrt,jendt
941 hwater=h(i,j)
942# ifdef ICESHELF
943 hwater=hwater-abs(zice(i,j))
944# endif
945 hinv=1.0_r8/(hc(ng)+hwater)
946 DO k=1,n(ng)
947 cff_w=hc(ng)*scalars(ng)%sc_w(k)
948 cff1_w=scalars(ng)%Cs_w(k)
949 cff2_w=(cff_w+cff1_w*hwater)*hinv
950!^ tl_Hz_bry(i,k,iwest)=tl_Zw(k)-tl_Zw(k-1)
951!^
952 ad_zw(k-1)=ad_zw(k-1)-ad_hz_bry(i,k,iwest)
953 ad_zw(k )=ad_zw(k )+ad_hz_bry(i,k,iwest)
954 ad_hz_bry(i,k,iwest)=0.0_r8
955!^ tl_Zw(k)=BOUNDARY(ng)%tl_zeta_west(j)+ &
956!^ & (BOUNDARY(ng)%tl_zeta_west(j)+ &
957!^ & tl_hwater)*cff2_w+ &
958!^ & (BOUNDARY(ng)%zeta_west(j)+ &
959!^ & hwater)*tl_cff2_w
960!^
961 adfac=cff2_w*ad_zw(k)
962 ad_cff2_w=ad_cff2_w+ &
963 & (boundary(ng)%zeta_west(j)+hwater)*ad_zw(k)
964 ad_hwater=ad_hwater+adfac
965 boundary(ng)%ad_zeta_west(j)=boundary(ng)% &
966 & ad_zeta_west(j)+ &
967 & ad_zw(k)+adfac
968 ad_zw(k)=0.0_r8
969!^ tl_cff2_w=cff1_w*tl_hwater*hinv+ &
970!^ & (cff_w+cff1_w*hwater)*tl_hinv
971!^
972 ad_hinv=ad_hinv+ &
973 & (cff_w+cff1_w*hwater)*ad_cff2_w
974 ad_hwater=ad_hwater+ &
975 & cff1_w*hinv*ad_cff2_w
976 ad_cff2_w=0.0_r8
977 END DO
978!^ tl_Zw(0)=-tl_h(i,j)
979!^
980 ad_h(i,j)=ad_h(i,j)-ad_zw(0)
981 ad_zw(0)=0.0_r8
982!^ tl_hinv=-hinv*hinv*tl_hwater
983!^
984 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
985 ad_hinv=0.0_r8
986!^ tl_hwater=tl_h(i,j)
987!^
988 ad_h(i,j)=ad_h(i,j)+ad_hwater
989 ad_hwater=0.0_r8
990 END DO
991 END IF
992 END IF
993!
994 RETURN
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_param::ad_lbc
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::hc
real(dp), dimension(:), allocatable hc
Definition mod_scalars.F:624
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::scalars
type(t_scalars), dimension(:), allocatable scalars
Definition mod_scalars.F:65
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::vtransform
integer, dimension(:), allocatable vtransform
Definition mod_scalars.F:604
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::ad_mp_exchange3d_bry
subroutine ad_mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:6303

References mod_param::ad_lbc, mp_exchange_mod::ad_mp_exchange3d_bry(), mod_boundary::boundary, mod_param::bounds, mod_param::domain, mod_scalars::ewperiodic, mod_scalars::hc, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_scalars::iwest, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::r2dvar, mod_scalars::scalars, and mod_scalars::vtransform.

Referenced by ad_set_depth_bry().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ad_set_depth_tile()

subroutine, public ad_set_depth_mod::ad_set_depth_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:,lbj:), intent(in) h,
real(r8), dimension(lbi:,lbj:), intent(inout) ad_h,
real(r8), dimension(lbi:,lbj:), intent(in) zice,
real(r8), dimension(lbi:,lbj:), intent(in) zt_avg1,
real(r8), dimension(lbi:,lbj:), intent(inout) ad_zt_avg1,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_hz,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_z_r,
real(r8), dimension(lbi:,lbj:,0:), intent(inout) ad_z_w )

Definition at line 80 of file ad_set_depth.F.

90!***********************************************************************
91!
92 USE mod_param
93 USE mod_scalars
94# if defined SEDIMENT_NOT_YET && defined SED_MORPH_NOT_YET
95 USE mod_sediment
96# endif
97!
98 USE ad_exchange_2d_mod
99 USE ad_exchange_3d_mod
100# ifdef DISTRIBUTE
101 USE mp_exchange_mod, ONLY : ad_mp_exchange2d, ad_mp_exchange3d
102# endif
103!
104! Imported variable declarations.
105!
106 integer, intent(in) :: ng, tile, model
107 integer, intent(in) :: LBi, UBi, LBj, UBj
108 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
109 integer, intent(in) :: nstp, nnew
110!
111# ifdef ASSUMED_SHAPE
112 real(r8), intent(in) :: h(LBi:,LBj:)
113 real(r8), intent(in) :: Zt_avg1(LBi:,LBj:)
114# ifdef ICESHELF
115 real(r8), intent(in) :: zice(LBi:,LBj:)
116# endif
117 real(r8), intent(inout) :: ad_h(LBi:,LBj:)
118 real(r8), intent(inout) :: ad_Zt_avg1(LBi:,LBj:)
119 real(r8), intent(inout) :: ad_Hz(LBi:,LBj:,:)
120 real(r8), intent(inout) :: ad_z_r(LBi:,LBj:,:)
121 real(r8), intent(inout) :: ad_z_w(LBi:,LBj:,0:)
122# else
123 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
124 real(r8), intent(in) :: Zt_avg1(LBi:UBi,LBj:UBj)
125# ifdef ICESHELF
126 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
127# endif
128 real(r8), intent(inout) :: ad_h(LBi:UBi,LBj:UBj)
129 real(r8), intent(inout) :: ad_Zt_avg1(LBi:UBi,LBj:UBj)
130 real(r8), intent(inout) :: ad_Hz(LBi:UBi,LBj:UBj,N(ng))
131 real(r8), intent(inout) :: ad_z_r(LBi:UBi,LBj:UBj,N(ng))
132 real(r8), intent(inout) :: ad_z_w(LBi:UBi,LBj:UBj,0:N(ng))
133# endif
134!
135! Local variable declarations.
136!
137 integer :: i, j, k
138
139 real(r8) :: cff, cff_r, cff1_r, cff2_r, cff_w, cff1_w, cff2_w
140 real(r8) :: hinv, hwater, z_r0, z_w0
141 real(r8) :: adfac, ad_hinv, ad_hwater, ad_z_r0, ad_z_w0
142 real(r8) :: ad_cff2_r, ad_cff2_w
143
144# include "set_bounds.h"
145!
146!-----------------------------------------------------------------------
147! Initialize adjoint private variables.
148!-----------------------------------------------------------------------
149!
150 ad_cff2_r=0.0_r8
151 ad_cff2_w=0.0_r8
152 ad_z_r0=0.0_r8
153 ad_z_w0=0.0_r8
154 ad_hinv=0.0_r8
155 ad_hwater=0.0_r8
156!
157!-----------------------------------------------------------------------
158! Compute time evolving adjoint depths and vertical thicknesses.
159!-----------------------------------------------------------------------
160!
161! Exchange boundary information.
162!
163# ifdef DISTRIBUTE
164!^ CALL mp_exchange3d (ng, tile, model, 2, &
165!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
166!^ & NghostPoints, &
167!^ & EWperiodic(ng), NSperiodic(ng), &
168!^ & tl_z_r, tl_Hz)
169!^
170 CALL ad_mp_exchange3d (ng, tile, model, 2, &
171 & lbi, ubi, lbj, ubj, 1, n(ng), &
172 & nghostpoints, &
173 & ewperiodic(ng), nsperiodic(ng), &
174 & ad_z_r, ad_hz)
175!^ CALL mp_exchange3d (ng, tile, model, 1, &
176!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
177!^ & NghostPoints, &
178!^ & EWperiodic(ng), NSperiodic(ng), &
179!^ & tl_z_w)
180!^
181 CALL ad_mp_exchange3d (ng, tile, model, 1, &
182 & lbi, ubi, lbj, ubj, 0, n(ng), &
183 & nghostpoints, &
184 & ewperiodic(ng), nsperiodic(ng), &
185 & ad_z_w)
186!^ CALL mp_exchange2d (ng, tile, model, 1, &
187!^ & LBi, UBi, LBj, UBj, &
188!^ & NghostPoints, &
189!^ & EWperiodic(ng), NSperiodic(ng), &
190!^ & tl_h)
191!^
192 CALL ad_mp_exchange2d (ng, tile, model, 1, &
193 & lbi, ubi, lbj, ubj, &
194 & nghostpoints, &
195 & ewperiodic(ng), nsperiodic(ng), &
196 & ad_h)
197!
198# endif
199
200 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
201!^ CALL exchange_r3d_tile (ng, tile, &
202!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
203!^ & tl_Hz)
204!^
205 CALL ad_exchange_r3d_tile (ng, tile, &
206 & lbi, ubi, lbj, ubj, 1, n(ng), &
207 & ad_hz)
208!^ CALL exchange_r3d_tile (ng, tile, &
209!^ & LBi, UBi, LBj, UBj, 1, N(ng), &
210!^ & tl_z_r)
211!^
212 CALL ad_exchange_r3d_tile (ng, tile, &
213 & lbi, ubi, lbj, ubj, 1, n(ng), &
214 & ad_z_r)
215!^ CALL exchange_w3d_tile (ng, tile, &
216!^ & LBi, UBi, LBj, UBj, 0, N(ng), &
217!^ & tl_z_w)
218!^
219 CALL ad_exchange_w3d_tile (ng, tile, &
220 & lbi, ubi, lbj, ubj, 0, n(ng), &
221 & ad_z_w)
222!^ CALL exchange_r2d_tile (ng, tile, &
223!^ & LBi, UBi, LBj, UBj, &
224!^ & tl_h)
225!^
226 CALL ad_exchange_r2d_tile (ng, tile, &
227 & lbi, ubi, lbj, ubj, &
228 & ad_h)
229 END IF
230!
231!-----------------------------------------------------------------------
232! Original formulation: Compute vertical depths (meters, negative) at
233! RHO- and W-points, and vertical grid
234! thicknesses. Various stretching functions are possible.
235!
236! z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
237!
238! Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
239!
240!-----------------------------------------------------------------------
241!
242 IF (vtransform(ng).eq.1) THEN
243 DO j=jstrt,jendt
244 DO k=n(ng),1,-1
245 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
246 cff_r=hc(ng)*(scalars(ng)%sc_r(k)-scalars(ng)%Cs_r(k))
247 cff1_r=scalars(ng)%Cs_r(k)
248 cff1_w=scalars(ng)%Cs_w(k)
249 DO i=istrt,iendt
250 hwater=h(i,j)
251# ifdef ICESHELF
252 hwater=hwater-abs(zice(i,j))
253# endif
254 hinv=1.0_r8/hwater
255 z_w0=cff_w+cff1_w*hwater
256 z_r0=cff_r+cff1_r*hwater
257
258!^ tl_Hz(i,j,k)=tl_z_w(i,j,k)-tl_z_w(i,j,k-1)
259!^
260 ad_z_w(i,j,k )=ad_z_w(i,j,k )+ad_hz(i,j,k)
261 ad_z_w(i,j,k-1)=ad_z_w(i,j,k-1)-ad_hz(i,j,k)
262 ad_hz(i,j,k)=0.0_r8
263!^ tl_z_r(i,j,k)=tl_z_r0+ &
264!^ & tl_Zt_avg1(i,j)*(1.0_r8+z_r0*hinv)+ &
265!^ & Zt_avg1(i,j)*(tl_z_r0*hinv+z_r0*tl_hinv)
266!^
267 adfac=zt_avg1(i,j)*ad_z_r(i,j,k)
268 ad_z_r0=ad_z_r0+hinv*adfac+ad_z_r(i,j,k)
269 ad_hinv=ad_hinv+z_r0*adfac
270 ad_zt_avg1(i,j)=ad_zt_avg1(i,j)+ &
271 & (1.0_r8+z_r0*hinv)*ad_z_r(i,j,k)
272 ad_z_r(i,j,k)=0.0_r8
273!^ tl_z_r0=cff1_r*tl_hwater
274!^
275 ad_hwater=ad_hwater+cff1_r*ad_z_r0
276 ad_z_r0=0.0_r8
277!^ tl_z_w(i,j,k)=tl_z_w0+ &
278!^ & tl_Zt_avg1(i,j)*(1.0_r8+z_w0*hinv)+ &
279!^ & Zt_avg1(i,j)*(tl_z_w0*hinv+z_w0*tl_hinv)
280!^
281 adfac=zt_avg1(i,j)*ad_z_w(i,j,k)
282 ad_z_w0=ad_z_w0+hinv*adfac+ad_z_w(i,j,k)
283 ad_hinv=ad_hinv+z_w0*adfac
284 ad_zt_avg1(i,j)=ad_zt_avg1(i,j)+ &
285 & (1.0_r8+z_w0*hinv)*ad_z_w(i,j,k)
286 ad_z_w(i,j,k)=0.0_r8
287!^ tl_z_w0=cff1_w*tl_hwater
288!^
289 ad_hwater=ad_hwater+cff1_w*ad_z_w0
290 ad_z_w0=0.0_r8
291!^ tl_hinv=-hinv*hinv*tl_hwater
292!^
293 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
294 ad_hinv=0.0_r8
295!^ tl_hwater=tl_h(i,j)
296!^
297 ad_h(i,j)=ad_h(i,j)+ad_hwater
298 ad_hwater=0.0_r8
299 END DO
300 END DO
301
302 DO i=istrt,iendt
303!^ tl_z_w(i,j,0)=-tl_h(i,j)
304!^
305 ad_h(i,j)=ad_h(i,j)-ad_z_w(i,j,0)
306 ad_z_w(i,j,0)=0.0_r8
307# if defined WET_DRY
308 IF (h(i,j).eq.0.0_r8) THEN
309!^ tl_h(i,j)=0.0_r8
310!^
311 ad_h(i,j)=0.0_r8
312 END IF
313# endif
314 END DO
315 END DO
316!
317!-----------------------------------------------------------------------
318! New formulation: Compute vertical depths (meters, negative) at
319! RHO- and W-points, and vertical grid thicknesses.
320! Various stretching functions are possible.
321!
322! z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
323!
324! Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
325!
326!-----------------------------------------------------------------------
327!
328 ELSE IF (vtransform(ng).eq.2) THEN
329 DO j=jstrt,jendt
330 DO k=n(ng),1,-1
331 cff_r=hc(ng)*scalars(ng)%sc_r(k)
332 cff_w=hc(ng)*scalars(ng)%sc_w(k)
333 cff1_r=scalars(ng)%Cs_r(k)
334 cff1_w=scalars(ng)%Cs_w(k)
335 DO i=istrt,iendt
336 hwater=h(i,j)
337# ifdef ICESHELF
338 hwater=hwater-abs(zice(i,j))
339# endif
340 hinv=1.0_r8/(hc(ng)+hwater)
341 cff2_r=(cff_r+cff1_r*hwater)*hinv
342 cff2_w=(cff_w+cff1_w*hwater)*hinv
343!^ tl_Hz(i,j,k)=tl_z_w(i,j,k)-tl_z_w(i,j,k-1)
344!^
345 ad_z_w(i,j,k )=ad_z_w(i,j,k )+ad_hz(i,j,k)
346 ad_z_w(i,j,k-1)=ad_z_w(i,j,k-1)-ad_hz(i,j,k)
347 ad_hz(i,j,k)=0.0_r8
348!^ tl_z_r(i,j,k)=tl_Zt_avg1(i,j)+ &
349!^ & (tl_Zt_avg1(i,j)+tl_hwater)*cff2_r+ &
350!^ & (Zt_avg1(i,j)+hwater)*tl_cff2_r
351!^
352 adfac=cff2_r*ad_z_r(i,j,k)
353 ad_cff2_r=ad_cff2_r+ &
354 & (zt_avg1(i,j)+hwater)*ad_z_r(i,j,k)
355 ad_hwater=ad_hwater+adfac
356 ad_zt_avg1(i,j)=ad_zt_avg1(i,j)+ad_z_r(i,j,k)+adfac
357 ad_z_r(i,j,k)=0.0_r8
358!^ tl_cff2_r=cff1_r*tl_hwater*hinv+ &
359!^ & (cff_r+cff1_r*hwater)*tl_hinv
360!^
361 ad_hinv=ad_hinv+ &
362 & (cff_r+cff1_r*hwater)*ad_cff2_r
363 ad_hwater=ad_hwater+ &
364 & cff1_r*hinv*ad_cff2_r
365 ad_cff2_r=0.0_r8
366!^ tl_z_w(i,j,k)=tl_Zt_avg1(i,j)+ &
367!^ & (tl_Zt_avg1(i,j)+tl_hwater)*cff2_w+ &
368!^ & (Zt_avg1(i,j)+hwater)*tl_cff2_w
369!^
370 adfac=cff2_w*ad_z_w(i,j,k)
371 ad_cff2_w=ad_cff2_w+ &
372 & (zt_avg1(i,j)+hwater)*ad_z_w(i,j,k)
373 ad_hwater=ad_hwater+adfac
374 ad_zt_avg1(i,j)=ad_zt_avg1(i,j)+ad_z_w(i,j,k)+adfac
375 ad_z_w(i,j,k)=0.0_r8
376!^ tl_cff2_w=cff1_w*tl_hwater*hinv+ &
377!^ & (cff_w+cff1_w*hwater)*tl_hinv
378!^
379 ad_hinv=ad_hinv+ &
380 & (cff_w+cff1_w*hwater)*ad_cff2_w
381 ad_hwater=ad_hwater+ &
382 & cff1_w*hinv*ad_cff2_w
383 ad_cff2_w=0.0_r8
384!^ tl_hinv=-hinv*hinv*tl_hwater
385!^
386 ad_hwater=ad_hwater-hinv*hinv*ad_hinv
387 ad_hinv=0.0_r8
388!^ tl_hwater=tl_h(i,j)
389!^
390 ad_h(i,j)=ad_h(i,j)+ad_hwater
391 ad_hwater=0.0_r8
392 END DO
393 END DO
394
395 DO i=istrt,iendt
396!^ tl_z_w(i,j,0)=-tl_h(i,j)
397!^
398 ad_h(i,j)=ad_h(i,j)-ad_z_w(i,j,0)
399 ad_z_w(i,j,0)=0.0_r8
400# if defined WET_DRY
401 IF (h(i,j).eq.0.0_r8) THEN
402!^ tl_h(i,j)=0.0_r8
403!^
404 ad_h(i,j)=0.0_r8
405 END IF
406# endif
407 END DO
408 END DO
409 END IF
410
411 RETURN
ad_exchange_2d_mod
Definition ad_exchange_2d.F:2
ad_exchange_2d_mod::ad_exchange_r2d_tile
subroutine ad_exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_exchange_2d.F:431
ad_exchange_3d_mod
Definition ad_exchange_3d.F:2
ad_exchange_3d_mod::ad_exchange_w3d_tile
subroutine ad_exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1693
ad_exchange_3d_mod::ad_exchange_r3d_tile
subroutine ad_exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:461
mod_sediment
Definition sediment_mod.h:1
mp_exchange_mod::ad_mp_exchange3d
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)
Definition mp_exchange.F:5451
mp_exchange_mod::ad_mp_exchange2d
subroutine ad_mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
Definition mp_exchange.F:4058

References ad_exchange_2d_mod::ad_exchange_r2d_tile(), ad_exchange_3d_mod::ad_exchange_r3d_tile(), ad_exchange_3d_mod::ad_exchange_w3d_tile(), mp_exchange_mod::ad_mp_exchange2d(), mp_exchange_mod::ad_mp_exchange3d(), mod_scalars::ewperiodic, mod_scalars::hc, mod_param::n, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::scalars, and mod_scalars::vtransform.

Referenced by ad_set_depth().

Here is the call graph for this function:
Here is the caller graph for this function: