Functions/Subroutines
subroutine, public	tl_set_depth (ng, tile, model)

subroutine, public	tl_set_depth_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, tl_h, zice, zt_avg1, tl_zt_avg1, tl_hz, tl_z_r, tl_z_w)

subroutine, public	tl_set_depth_bry (ng, tile, model)

subroutine	tl_set_depth_bry_tile (ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, h, tl_h, zice, tl_hz_bry)

subroutine, public	tl_bath (ng, tile)

subroutine, public	tl_bath_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, tl_h)

Function/Subroutine Documentation

◆ tl_bath()

subroutine, public tl_set_depth_mod::tl_bath	(	integer, intent(in)	ng,
		integer, intent(in)	tile )

Definition at line 809 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_grid
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", tl_bath"
!
# include "tile.h"
!
# ifdef PROFILE
      CALL wclock_on (ng, itlm, 12, __line__, myfile)
# endif
      CALL tl_bath_tile (ng, tile,                                      &
     &                   lbi, ubi, lbj, ubj,                            &
     &                   imins, imaxs, jmins, jmaxs,                    &
     &                   grid(ng) % tl_h)
# ifdef PROFILE
      CALL wclock_off (ng, itlm, 12, __line__, myfile)
# endif
!
      RETURN

References mod_grid::grid, mod_param::itlm, tl_bath_tile(), wclock_off(), and wclock_on().

Referenced by tl_initial(), and roms_kernel_mod::tlm_initial().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ tl_bath_tile()

subroutine, public tl_set_depth_mod::tl_bath_tile	(	integer, intent(in)	ng,
		integer, intent(in)	tile,
		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,
		real(r8), dimension(lbi:,lbj:), intent(out)	tl_h )

Definition at line 841 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_scalars
!
      USE exchange_2d_mod
# ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange2d
# endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
# ifdef ASSUMED_SHAPE
      real(r8), intent(out) :: tl_h(LBi:,LBj:)
# else
      real(r8), intent(out) :: tl_h(LBi:UBi,LBj:UBj)
# endif
!
!  Local variable declarations.
!
      integer :: i, j
 
# include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Initialize tangent linear bathymetry to zero.
!-----------------------------------------------------------------------
!
      DO j=jstrt,jendt
        DO i=istrt,iendt
          tl_h(i,j)=0.0_r8
        END DO
      END DO
 
      IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          tl_h)
      END IF
 
# ifdef DISTRIBUTE
      CALL mp_exchange2d (ng, tile, itlm, 1,                            &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    tl_h)
# endif
!
      RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_param::itlm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by tl_bath().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ tl_set_depth()

subroutine, public tl_set_depth_mod::tl_set_depth	(	integer, intent(in)	ng,
		integer, intent(in)	tile,
		integer, intent(in)	model )

Definition at line 40 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_coupling
      USE mod_grid
      USE mod_ocean
      USE mod_stepping
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
#  include "tile.h"
!
#  ifdef PROFILE
      CALL wclock_on (ng, model, 12, __line__, myfile)
#  endif
      CALL tl_set_depth_tile (ng, tile, model,                          &
     &                        lbi, ubi, lbj, ubj,                       &
     &                        imins, imaxs, jmins, jmaxs,               &
     &                        nstp(ng), nnew(ng),                       &
     &                        grid(ng) % h,                             &
     &                        grid(ng) % tl_h,                          &
#  ifdef ICESHELF
     &                        grid(ng) % zice,                          &
#  endif
     &                        coupling(ng) % Zt_avg1,                   &
     &                        coupling(ng) % tl_Zt_avg1,                &
     &                        grid(ng) % tl_Hz,                         &
     &                        grid(ng) % tl_z_r,                        &
     &                        grid(ng) % tl_z_w)
#  ifdef PROFILE
      CALL wclock_off (ng, model, 12, __line__, myfile)
#  endif
!
      RETURN

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

Referenced by tl_initial(), tl_main3d(), tl_nesting_mod::tl_nesting(), tl_post_initial_mod::tl_post_initial(), tl_step2d_mod::tl_step2d_tile(), and tl_step2d_mod::tl_step2d_tile().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ tl_set_depth_bry()

subroutine, public tl_set_depth_mod::tl_set_depth_bry	(	integer, intent(in)	ng,
		integer, intent(in)	tile,
		integer, intent(in)	model )

Definition at line 369 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_grid
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__//", tl_set_depth_bry"
!
#   include "tile.h"
!
#   ifdef PROFILE
      CALL wclock_on (ng, model, 12, __line__, myfile)
#   endif
      CALL tl_set_depth_bry_tile (ng, tile, model,                      &
     &                            lbi, ubi, lbj, ubj, lbij, ubij,       &
     &                            imins, imaxs, jmins, jmaxs,           &
     &                            grid(ng) % h,                         &
     &                            grid(ng) % tl_h,                      &
#   ifdef ICESHELF
     &                            grid(ng) % zice,                      &
#   endif
     &                            grid(ng) % tl_Hz_bry)
#   ifdef PROFILE
      CALL wclock_off (ng, model, 12, __line__, myfile)
#   endif
!
      RETURN

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

Referenced by tl_main3d().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ tl_set_depth_bry_tile()

subroutine tl_set_depth_mod::tl_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(in)	tl_h,
		real(r8), dimension(lbi:,lbj:), intent(in)	zice,
		real(r8), dimension(lbij:,:,:), intent(out)	tl_hz_bry )

private

Definition at line 406 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_boundary
      USE mod_ncparam
      USE mod_scalars
!
#   ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange3d_bry
#   endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
#   ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: h(LBi:,LBj:)
      real(r8), intent(in) :: tl_h(LBi:,LBj:)
#    ifdef ICESHELF
      real(r8), intent(in) :: zice(LBi:,LBj:)
#    endif
      real(r8), intent(out) :: tl_Hz_bry(LBij:,:,:)
#   else
      real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: tl_h(LBi:UBi,LBj:UBj)
#    ifdef ICESHELF
      real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
#    endif
      real(r8), intent(out) :: tl_Hz_bry(LBij:UBij,N(ng),4)
#   endif
!
!  Local variable declarations.
!
      integer :: i, ibry, j, k
 
      real(r8) :: cff_w, cff1_w, cff2_w
      real(r8) :: hinv, hwater, z_w0
      real(r8) :: tl_cff2_w, tl_hinv, tl_hwater, tl_z_w0
 
      real(r8), dimension(0:N(ng)) :: tl_Zw
 
#   include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Original formulation: Compute vertical depths (meters, negative) at
!                        RHO- and W-points, and vertical grid
!  thicknesses. Various stretching functions are possible.
!
!         z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
!
!                 Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
!
!-----------------------------------------------------------------------
!
      IF (vtransform(ng).eq.1) THEN
 
        IF (tl_lbc(iwest,isfsur,ng)%acquire.and.                        &
     &      domain(ng)%Western_Edge(tile)) THEN
          i=bounds(ng)%edge(iwest,r2dvar)
          DO j=jstrt,jendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/hwater
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
              cff1_w=scalars(ng)%Cs_w(k)
              z_w0=cff_w+cff1_w*hwater
              tl_z_w0=cff1_w*tl_hwater
!^            Zw(k)=z_w0+BOUNDARY(ng)%zeta_west(j)*(1.0_r8+z_w0*hinv)
!^
              tl_zw(k)=tl_z_w0+                                         &
     &                 boundary(ng)%tl_zeta_west(j)*                    &
     &                 (1.0_r8+z_w0*hinv)+                              &
     &                 boundary(ng)%zeta_west(j)*                       &
     &                 (tl_z_w0*hinv+z_w0*tl_hinv)
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(j,k,iwest)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(j,k,iwest)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(ieast,isfsur,ng)%acquire.and.                        &
     &      domain(ng)%Eastern_Edge(tile)) THEN
          i=bounds(ng)%edge(ieast,r2dvar)
          DO j=jstrt,jendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/hwater
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
              cff1_w=scalars(ng)%Cs_w(k)
              z_w0=cff_w+cff1_w*hwater
              tl_z_w0=cff1_w*tl_hwater
!^            Zw(k)=z_w0+BOUNDARY(ng)%zeta_east(j)*(1.0_r8+z_w0*hinv)
!^
              tl_zw(k)=tl_z_w0+                                         &
     &                 boundary(ng)%tl_zeta_east(j)*                    &
     &                 (1.0_r8+z_w0*hinv)+                              &
     &                 boundary(ng)%zeta_east(j)*                       &
     &                 (tl_z_w0*hinv+z_w0*tl_hinv)
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(j,k,ieast)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(j,k,ieast)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(isouth,isfsur,ng)%acquire.and.                       &
     &      domain(ng)%Southern_Edge(tile)) THEN
          j=bounds(ng)%edge(isouth,r2dvar)
          DO i=istrt,iendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/hwater
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
              cff1_w=scalars(ng)%Cs_w(k)
              z_w0=cff_w+cff1_w*hwater
              tl_z_w0=cff1_w*tl_hwater
!^            Zw(k)=z_w0+BOUNDARY(ng)%zeta_south(i)*(1.0_r8+z_w0*hinv)
!^
              tl_zw(k)=tl_z_w0+                                         &
     &                 boundary(ng)%tl_zeta_south(i)*                   &
     &                 (1.0_r8+z_w0*hinv)+                              &
     &                 boundary(ng)%zeta_south(i)*                      &
     &                 (tl_z_w0*hinv+z_w0*tl_hinv)
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(i,k,isouth)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(i,k,isouth)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(inorth,isfsur,ng)%acquire.and.                       &
     &      domain(ng)%Northern_Edge(tile)) THEN
          j=bounds(ng)%edge(inorth,r2dvar)
          DO i=istrt,iendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/hwater
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
              cff1_w=scalars(ng)%Cs_w(k)
              z_w0=cff_w+cff1_w*hwater
              tl_z_w0=cff1_w*tl_hwater
!^            Zw(k)=z_w0+BOUNDARY(ng)%zeta_north(i)*(1.0_r8+z_w0*hinv)
!^
              tl_zw(k)=tl_z_w0+                                         &
     &                 boundary(ng)%tl_zeta_north(i)*                   &
     &                 (1.0_r8+z_w0*hinv)+                              &
     &                 boundary(ng)%zeta_north(i)*                      &
     &                 (tl_z_w0*hinv+z_w0*tl_hinv)
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(i,k,inorth)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(i,k,inorth)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
!
!-----------------------------------------------------------------------
!  New formulation: Compute vertical depths (meters, negative) at
!                   RHO- and W-points, and vertical grid thicknesses.
!  Various stretching functions are possible.
!
!         z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
!
!                 Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
!
!-----------------------------------------------------------------------
!
      ELSE IF (vtransform(ng).eq.2) THEN
 
        IF (tl_lbc(iwest,isfsur,ng)%acquire.and.                        &
     &      domain(ng)%Western_Edge(tile)) THEN
          i=bounds(ng)%edge(iwest,r2dvar)
          DO j=jstrt,jendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/(hc(ng)+hwater)
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*scalars(ng)%sc_w(k)
              cff1_w=scalars(ng)%Cs_w(k)
              cff2_w=(cff_w+cff1_w*hwater)*hinv
              tl_cff2_w=cff1_w*tl_hwater*hinv+                          &
     &                  (cff_w+cff1_w*hwater)*tl_hinv
!^            Zw(k)=BOUNDARY(ng)%zeta_west(j)+                          &
!^   &              (BOUNDARY(ng)%zeta_west(j)+hwater)*cff2_w
!^
              tl_zw(k)=boundary(ng)%tl_zeta_west(j)+                    &
     &                 (boundary(ng)%tl_zeta_west(j)+                   &
     &                  tl_hwater)*cff2_w+                              &
     &                 (boundary(ng)%zeta_west(j)+                      &
     &                  hwater)*tl_cff2_w
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(j,k,iwest)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(j,k,iwest)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(ieast,isfsur,ng)%acquire.and.                        &
     &      domain(ng)%Eastern_Edge(tile)) THEN
          i=bounds(ng)%edge(ieast,r2dvar)
          DO j=jstrt,jendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/(hc(ng)+hwater)
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*scalars(ng)%sc_w(k)
              cff1_w=scalars(ng)%Cs_w(k)
              cff2_w=(cff_w+cff1_w*hwater)*hinv
              tl_cff2_w=cff1_w*tl_hwater*hinv+                          &
     &                  (cff_w+cff1_w*hwater)*tl_hinv
!^            Zw(k)=BOUNDARY(ng)%zeta_east(j)+                          &
!^   &              (BOUNDARY(ng)%zeta_east(j)+hwater)*cff2_w
!^
              tl_zw(k)=boundary(ng)%tl_zeta_east(j)+                    &
     &                 (boundary(ng)%tl_zeta_east(j)+                   &
     &                  tl_hwater)*cff2_w+                              &
     &                 (boundary(ng)%zeta_east(j)+                      &
     &                  hwater)*tl_cff2_w
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(j,k,ieast)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(j,k,ieast)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(isouth,isfsur,ng)%acquire.and.                       &
     &      domain(ng)%Southern_Edge(tile)) THEN
          j=bounds(ng)%edge(isouth,r2dvar)
          DO i=istrt,iendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/(hc(ng)+hwater)
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*scalars(ng)%sc_w(k)
              cff1_w=scalars(ng)%Cs_w(k)
              cff2_w=(cff_w+cff1_w*hwater)*hinv
              tl_cff2_w=cff1_w*tl_hwater*hinv+                          &
     &                  (cff_w+cff1_w*hwater)*tl_hinv
!^            Zw(k)=BOUNDARY(ng)%zeta_south(i)+                         &
!^   &              (BOUNDARY(ng)%zeta_south(i)+hwater)*cff2_w
!^
              tl_zw(k)=boundary(ng)%tl_zeta_south(i)+                   &
     &                 (boundary(ng)%tl_zeta_south(i)+                  &
     &                  tl_hwater)*cff2_w+                              &
     &                 (boundary(ng)%zeta_south(i)+                     &
     &                  hwater)*tl_cff2_w
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(i,k,isouth)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(i,k,isouth)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
 
        IF (tl_lbc(inorth,isfsur,ng)%acquire.and.                       &
     &      domain(ng)%Northern_Edge(tile)) THEN
          j=bounds(ng)%edge(inorth,r2dvar)
          DO i=istrt,iendt
            hwater=h(i,j)
#   ifdef ICESHELF
            hwater=hwater-abs(zice(i,j))
#   endif
            tl_hwater=tl_h(i,j)
            hinv=1.0_r8/(hc(ng)+hwater)
            tl_hinv=-hinv*hinv*tl_hwater
!^          Zw(0)=-h(i,j)
!^
            tl_zw(0)=-tl_h(i,j)
            DO k=1,n(ng)
              cff_w=hc(ng)*scalars(ng)%sc_w(k)
              cff1_w=scalars(ng)%Cs_w(k)
              cff2_w=(cff_w+cff1_w*hwater)*hinv
              tl_cff2_w=cff1_w*tl_hwater*hinv+                          &
     &                  (cff_w+cff1_w*hwater)*tl_hinv
!^            Zw(k)=BOUNDARY(ng)%zeta_north(i)+                         &
!^   &              (BOUNDARY(ng)%zeta_north(i)+hwater)*cff2_w
!^
              tl_zw(k)=boundary(ng)%tl_zeta_north(i)+                   &
     &                 (boundary(ng)%tl_zeta_north(i)+                  &
     &                  tl_hwater)*cff2_w+                              &
     &                 (boundary(ng)%zeta_north(i)+                     &
     &                  hwater)*tl_cff2_w
#   ifdef ICESHELF
!^            Zw(k)=Zw(k)-ABS(zice(i,j))
#   endif
!^            Hz_bry(i,k,inorth)=Zw(k)-Zw(k-1)
!^
              tl_hz_bry(i,k,inorth)=tl_zw(k)-tl_zw(k-1)
            END DO
          END DO
        END IF
      END IF
 
#   ifdef DISTRIBUTE
!
!-----------------------------------------------------------------------
!  Exchange boundary information.
!-----------------------------------------------------------------------
!
      DO ibry=1,4
!^      CALL mp_exchange3d_bry (ng, tile, model, 1, ibry,               &
!^   &                          LBij, UBij, 1, N(ng),                   &
!^   &                          NghostPoints,                           &
!^   &                          EWperiodic(ng), NSperiodic(ng),         &
!^   &                          Hz_bry(:,:,ibry))
!^
        CALL mp_exchange3d_bry (ng, tile, model, 1, ibry,               &
     &                          lbij, ubij, 1, n(ng),                   &
     &                          nghostpoints,                           &
     &                          ewperiodic(ng), nsperiodic(ng),         &
     &                          tl_hz_bry(:,:,ibry))
      END DO
#   endif
!
      RETURN

References 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, mp_exchange_mod::mp_exchange3d_bry(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::r2dvar, mod_scalars::scalars, mod_param::tl_lbc, and mod_scalars::vtransform.

Referenced by tl_set_depth_bry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ tl_set_depth_tile()

subroutine, public tl_set_depth_mod::tl_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)	tl_h,
		real(r8), dimension(lbi:,lbj:), intent(in)	zice,
		real(r8), dimension(lbi:,lbj:), intent(in)	zt_avg1,
		real(r8), dimension(lbi:,lbj:), intent(in)	tl_zt_avg1,
		real(r8), dimension(lbi:,lbj:,:), intent(out)	tl_hz,
		real(r8), dimension(lbi:,lbj:,:), intent(out)	tl_z_r,
		real(r8), dimension(lbi:,lbj:,0:), intent(out)	tl_z_w )

Definition at line 85 of file tl_set_depth.F.

!***********************************************************************
!
      USE mod_param
      USE mod_scalars
!
      USE exchange_2d_mod
      USE exchange_3d_mod
#  ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d
#  endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
      integer, intent(in) :: nstp, nnew
!
#  ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: h(LBi:,LBj:)
#   ifdef ICESHELF
      real(r8), intent(in) :: zice(LBi:,LBj:)
#   endif
      real(r8), intent(in) :: Zt_avg1(LBi:,LBj:)
      real(r8), intent(in) :: tl_Zt_avg1(LBi:,LBj:)
      real(r8), intent(inout) :: tl_h(LBi:,LBj:)
      real(r8), intent(out) :: tl_Hz(LBi:,LBj:,:)
      real(r8), intent(out) :: tl_z_r(LBi:,LBj:,:)
      real(r8), intent(out) :: tl_z_w(LBi:,LBj:,0:)
#  else
      real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
#   ifdef ICESHELF
      real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
#   endif
      real(r8), intent(in) :: Zt_avg1(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: tl_Zt_avg1(LBi:UBi,LBj:UBj)
      real(r8), intent(inout) :: tl_h(LBi:UBi,LBj:UBj)
      real(r8), intent(out) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
      real(r8), intent(out) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
      real(r8), intent(out) :: tl_z_w(LBi:UBi,LBj:UBj,0:N(ng))
#  endif
!
!  Local variable declarations.
!
      integer :: i, j, k
 
      real(r8) :: cff, cff_r, cff1_r, cff2_r, cff_w, cff1_w, cff2_w
      real(r8) :: hinv, hwater, z_r0, z_w0
      real(r8) :: tl_cff2_r, tl_cff2_w
      real(r8) :: tl_hinv, tl_hwater, tl_z_r0, tl_z_w0
 
#  ifdef WET_DRY
      real(r8), parameter :: eps = 1.0e-14_r8
#  endif
 
#  include "set_bounds.h"
!
!-----------------------------------------------------------------------
!  Original formulation: Compute vertical depths (meters, negative) at
!                        RHO- and W-points, and vertical grid
!  thicknesses. Various stretching functions are possible.
!
!         z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
!
!                 Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
!
!-----------------------------------------------------------------------
!
      IF (vtransform(ng).eq.1) THEN
        DO j=jstrt,jendt
          DO i=istrt,iendt
#  if defined WET_DRY
            IF (h(i,j).eq.0.0_r8) THEN
!^            h(i,j)=eps
!^
              tl_h(i,j)=0.0_r8
            END IF
#  endif
!^          z_w(i,j,0)=-h(i,j)
!^
            tl_z_w(i,j,0)=-tl_h(i,j)
          END DO
          DO k=1,n(ng)
            cff_r=hc(ng)*(scalars(ng)%sc_r(k)-scalars(ng)%Cs_r(k))
            cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
            cff1_r=scalars(ng)%Cs_r(k)
            cff1_w=scalars(ng)%Cs_w(k)
            DO i=istrt,iendt
              hwater=h(i,j)
#  ifdef ICESHELF
              hwater=hwater-abs(zice(i,j))
#  endif
              tl_hwater=tl_h(i,j)
              hinv=1.0_r8/hwater
              tl_hinv=-hinv*hinv*tl_hwater
 
              z_w0=cff_w+cff1_w*hwater
              tl_z_w0=cff1_w*tl_hwater
 
!^            z_w(i,j,k)=z_w0+Zt_avg1(i,j)*(1.0_r8+z_w0*hinv)
!^
              tl_z_w(i,j,k)=tl_z_w0+                                    &
     &                      tl_zt_avg1(i,j)*(1.0_r8+z_w0*hinv)+         &
     &                      zt_avg1(i,j)*(tl_z_w0*hinv+z_w0*tl_hinv)
 
              z_r0=cff_r+cff1_r*hwater
              tl_z_r0=cff1_r*tl_hwater
 
!^            z_r(i,j,k)=z_r0+Zt_avg1(i,j)*(1.0_r8+z_r0*hinv)
!^
              tl_z_r(i,j,k)=tl_z_r0+                                    &
     &                      tl_zt_avg1(i,j)*(1.0_r8+z_r0*hinv)+         &
     &                      zt_avg1(i,j)*(tl_z_r0*hinv+z_r0*tl_hinv)
#  ifdef ICESHELF
!^            z_w(i,j,k)=z_w(i,j,k)-ABS(zice(i,j))
!^            z_r(i,j,k)=z_r(i,j,k)-ABS(zice(i,j))
#  endif
!^            Hz(i,j,k)=z_w(i,j,k)-z_w(i,j,k-1)
!^
              tl_hz(i,j,k)=tl_z_w(i,j,k)-tl_z_w(i,j,k-1)
            END DO
          END DO
        END DO
!
!-----------------------------------------------------------------------
!  New formulation: Compute vertical depths (meters, negative) at
!                   RHO- and W-points, and vertical grid thicknesses.
!  Various stretching functions are possible.
!
!         z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
!
!                 Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
!
!-----------------------------------------------------------------------
!
      ELSE IF (vtransform(ng).eq.2) THEN
        DO j=jstrt,jendt
          DO i=istrt,iendt
#  if defined WET_DRY
            IF (h(i,j).eq.0.0_r8) THEN
!^            h(i,j)=eps
!^
              tl_h(i,j)=0.0_r8
            END IF
#  endif
!^          z_w(i,j,0)=-h(i,j)
!^
            tl_z_w(i,j,0)=-tl_h(i,j)
          END DO
          DO k=1,n(ng)
            cff_r=hc(ng)*scalars(ng)%sc_r(k)
            cff_w=hc(ng)*scalars(ng)%sc_w(k)
            cff1_r=scalars(ng)%Cs_r(k)
            cff1_w=scalars(ng)%Cs_w(k)
            DO i=istrt,iendt
              hwater=h(i,j)
#  ifdef ICESHELF
              hwater=hwater-abs(zice(i,j))
#  endif
              tl_hwater=tl_h(i,j)
              hinv=1.0_r8/(hc(ng)+hwater)
              tl_hinv=-hinv*hinv*tl_hwater
 
              cff2_w=(cff_w+cff1_w*hwater)*hinv
              tl_cff2_w=cff1_w*tl_hwater*hinv+                          &
     &                  (cff_w+cff1_w*hwater)*tl_hinv
 
!^            z_w(i,j,k)=Zt_avg1(i,j)+                                  &
!^   &                   (Zt_avg1(i,j)+hwater)*cff2_w
!^
              tl_z_w(i,j,k)=tl_zt_avg1(i,j)+                            &
     &                      (tl_zt_avg1(i,j)+tl_hwater)*cff2_w+         &
     &                      (zt_avg1(i,j)+hwater)*tl_cff2_w
 
              cff2_r=(cff_r+cff1_r*hwater)*hinv
              tl_cff2_r=cff1_r*tl_hwater*hinv+                          &
     &                  (cff_r+cff1_r*hwater)*tl_hinv
 
!^            z_r(i,j,k)=Zt_avg1(i,j)+                                  &
!^   &                   (Zt_avg1(i,j)+hwater)*cff2_r
!^
              tl_z_r(i,j,k)=tl_zt_avg1(i,j)+                            &
     &                      (tl_zt_avg1(i,j)+tl_hwater)*cff2_r+         &
     &                      (zt_avg1(i,j)+hwater)*tl_cff2_r
 
#  ifdef ICESHELF
!^            z_w(i,j,k)=z_w(i,j,k)-ABS(zice(i,j))
!^            z_r(i,j,k)=z_r(i,j,k)-ABS(zice(i,j))
#  endif
!^            Hz(i,j,k)=z_w(i,j,k)-z_w(i,j,k-1)
!^
              tl_hz(i,j,k)=tl_z_w(i,j,k)-tl_z_w(i,j,k-1)
            END DO
          END DO
        END DO
      END IF
!
!-----------------------------------------------------------------------
!  Exchange boundary information.
!-----------------------------------------------------------------------
!
      IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
!^      CALL exchange_r2d_tile (ng, tile,                               &
!^   &                          LBi, UBi, LBj, UBj,                     &
!^   &                          h)
!^
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          tl_h)
!^      CALL exchange_w3d_tile (ng, tile,                               &
!^   &                          LBi, UBi, LBj, UBj, 0, N(ng),           &
!^   &                          z_w)
!^
        CALL exchange_w3d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj, 0, n(ng),           &
     &                          tl_z_w)
!^      CALL exchange_r3d_tile (ng, tile,                               &
!^   &                          LBi, UBi, LBj, UBj, 1, N(ng),           &
!^   &                          z_r)
!^
        CALL exchange_r3d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj, 1, n(ng),           &
     &                          tl_z_r)
!^      CALL exchange_r3d_tile (ng, tile,                               &
!^   &                          LBi, UBi, LBj, UBj, 1, N(ng),           &
!^   &                          Hz)
!^
        CALL exchange_r3d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj, 1, n(ng),           &
     &                          tl_hz)
      END IF
 
#  ifdef DISTRIBUTE
!^    CALL mp_exchange2d (ng, tile, model, 1,                           &
!^   &                    LBi, UBi, LBj, UBj,                           &
!^   &                    NghostPoints,                                 &
!^   &                    EWperiodic(ng), NSperiodic(ng),               &
!^   &                    h)
!^
      CALL mp_exchange2d (ng, tile, model, 1,                           &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    tl_h)
!^    CALL mp_exchange3d (ng, tile, model, 1,                           &
!^   &                    LBi, UBi, LBj, UBj, 0, N(ng),                 &
!^   &                    NghostPoints,                                 &
!^   &                    EWperiodic(ng), NSperiodic(ng),               &
!^   &                    z_w)
!^
      CALL mp_exchange3d (ng, tile, model, 1,                           &
     &                    lbi, ubi, lbj, ubj, 0, n(ng),                 &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    tl_z_w)
!^    CALL mp_exchange3d (ng, tile, model, 2,                           &
!^   &                    LBi, UBi, LBj, UBj, 1, N(ng),                 &
!^   &                    NghostPoints,                                 &
!^   &                    EWperiodic(ng), NSperiodic(ng),               &
!^   &                    z_r, Hz)
!^
      CALL mp_exchange3d (ng, tile, model, 2,                           &
     &                    lbi, ubi, lbj, ubj, 1, n(ng),                 &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    tl_z_r, tl_hz)
#  endif
!
      RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), exchange_3d_mod::exchange_r3d_tile(), exchange_3d_mod::exchange_w3d_tile(), mod_scalars::hc, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mod_param::n, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::scalars, and mod_scalars::vtransform.

Referenced by ini_adjust_mod::tl_ini_perturb_tile(), and tl_set_depth().

Here is the call graph for this function:

Here is the caller graph for this function:

Functions/Subroutines

Function/Subroutine Documentation

◆ tl_bath()

◆ tl_bath_tile()

◆ tl_set_depth()

◆ tl_set_depth_bry()

◆ tl_set_depth_bry_tile()

◆ tl_set_depth_tile()