dyed_channel_initialization.F90

!> Initialization for the dyed_channel configuration
module dyed_channel_initialization
 
! This file is part of MOM6. See LICENSE.md for the license.
 
use mom_dyn_horgrid,     only : dyn_horgrid_type
use mom_error_handler,   only : mom_mesg, mom_error, fatal, warning, is_root_pe
use mom_file_parser,     only : get_param, log_version, param_file_type
use mom_get_input,       only : directories
use mom_grid,            only : ocean_grid_type
use mom_open_boundary,   only : ocean_obc_type, obc_none, obc_simple
use mom_open_boundary,   only : obc_segment_type, register_segment_tracer
use mom_open_boundary,   only : obc_registry_type, register_obc
use mom_time_manager,    only : time_type, time_type_to_real
use mom_tracer_registry, only : tracer_registry_type, tracer_name_lookup
use mom_tracer_registry, only : tracer_type
use mom_variables,       only : thermo_var_ptrs
use mom_verticalgrid,    only : verticalgrid_type
 
implicit none ; private
 
#include <MOM_memory.h>
 
public dyed_channel_set_obc_tracer_data, dyed_channel_obc_end
public register_dyed_channel_obc, dyed_channel_update_flow
 
!> Control structure for dyed-channel open boundaries.
type, public :: dyed_channel_obc_cs ; private
  real :: zonal_flow = 8.57         !< Mean inflow
  real :: tidal_amp = 0.0           !< Sloshing amplitude
  real :: frequency  = 0.0          !< Sloshing frequency
end type dyed_channel_obc_cs
 
integer :: ntr = 0 !< Number of dye tracers
                   !! \todo This is a module variable. Move this variable into the control structure.
 
contains
 
!> Add dyed channel to OBC registry.
function register_dyed_channel_obc(param_file, CS, OBC_Reg)
  type(param_file_type),     intent(in) :: param_file !< parameter file.
  type(dyed_channel_obc_cs), pointer    :: cs         !< Dyed channel control structure.
  type(obc_registry_type),   pointer    :: obc_reg    !< OBC registry.
  ! Local variables
  logical                               :: register_dyed_channel_obc
  character(len=32)  :: casename = "dyed channel"     ! This case's name.
  character(len=40)  :: mdl = "register_dyed_channel_OBC" ! This subroutine's name.
 
  if (associated(cs)) then
    call mom_error(warning, "register_dyed_channel_OBC called with an "// &
                            "associated control structure.")
    return
  endif
  allocate(cs)
 
  call get_param(param_file, mdl, "CHANNEL_MEAN_FLOW", cs%zonal_flow, &
                 "Mean zonal flow imposed at upstream open boundary.", &
                 units="m/s", default=8.57)
  call get_param(param_file, mdl, "CHANNEL_TIDAL_AMP", cs%tidal_amp, &
                 "Sloshing amplitude imposed at upstream open boundary.", &
                 units="m/s", default=0.0)
  call get_param(param_file, mdl, "CHANNEL_FLOW_FREQUENCY", cs%frequency, &
                 "Frequency of oscillating zonal flow.", &
                 units="s-1", default=0.0)
 
  ! Register the open boundaries.
  call register_obc(casename, param_file, obc_reg)
  register_dyed_channel_obc = .true.
 
end function register_dyed_channel_obc
 
!> Clean up the dyed_channel OBC from registry.
subroutine dyed_channel_obc_end(CS)
  type(dyed_channel_obc_cs), pointer :: cs    !< Dyed channel control structure.
 
  if (associated(cs)) then
    deallocate(cs)
  endif
end subroutine dyed_channel_obc_end
 
!> This subroutine sets the dye and flow properties at open boundary conditions.
subroutine dyed_channel_set_obc_tracer_data(OBC, G, GV, param_file, tr_Reg)
  type(ocean_obc_type),       pointer    :: obc !< This open boundary condition type specifies
                                                !! whether, where, and what open boundary
                                                !! conditions are used.
  type(ocean_grid_type),      intent(in) :: g   !< The ocean's grid structure.
  type(verticalgrid_type),    intent(in) :: gv  !< The ocean's vertical grid structure.
  type(param_file_type),      intent(in) :: param_file !< A structure indicating the open file
                                                !! to parse for model parameter values.
  type(tracer_registry_type), pointer    :: tr_reg !< Tracer registry.
  ! Local variables
  character(len=40)  :: mdl = "dyed_channel_set_OBC_tracer_data" ! This subroutine's name.
  character(len=80)  :: name, longname
  integer :: i, j, k, l, itt, isd, ied, jsd, jed, m, n
  integer :: isdb, iedb, jsdb, jedb
  real :: dye
  type(obc_segment_type), pointer :: segment => null()
  type(tracer_type), pointer      :: tr_ptr => null()
 
  if (.not.associated(obc)) call mom_error(fatal, 'dyed_channel_initialization.F90: '// &
        'dyed_channel_set_OBC_data() was called but OBC type was not initialized!')
 
  call get_param(param_file, mdl, "NUM_DYE_TRACERS", ntr, &
                 "The number of dye tracers in this run. Each tracer "//&
                 "should have a separate boundary segment.", default=0,   &
                 do_not_log=.true.)
 
  if (obc%number_of_segments < ntr) then
    call mom_error(warning, "Error in dyed_obc segment setup")
    return   !!! Need a better error message here
  endif
 
! ! Set the inflow values of the dyes, one per segment.
! ! We know the order: north, south, east, west
  do m=1,ntr
    write(name,'("dye_",I2.2)') m
    write(longname,'("Concentration of dyed_obc Tracer ",I2.2, " on segment ",I2.2)') m, m
    call tracer_name_lookup(tr_reg, tr_ptr, name)
 
    do n=1,obc%number_of_segments
      if (n == m) then
        dye = 1.0
      else
        dye = 0.0
      endif
      call register_segment_tracer(tr_ptr, param_file, gv, &
                                   obc%segment(n), obc_scalar=dye)
    enddo
  enddo
 
end subroutine dyed_channel_set_obc_tracer_data
 
!> This subroutine updates the long-channel flow
subroutine dyed_channel_update_flow(OBC, CS, G, Time)
  type(ocean_obc_type),       pointer    :: obc !< This open boundary condition type specifies
                                                !! whether, where, and what open boundary
                                                !! conditions are used.
  type(dyed_channel_obc_cs),  pointer    :: cs  !< Dyed channel control structure.
  type(ocean_grid_type),      intent(in) :: g   !< The ocean's grid structure.
  type(time_type),            intent(in) :: time !< model time.
  ! Local variables
  character(len=40)  :: mdl = "dyed_channel_update_flow" ! This subroutine's name.
  character(len=80)  :: name
  real :: flow, time_sec, pi
  integer :: i, j, k, l, itt, isd, ied, jsd, jed, m, n
  integer :: isdb, iedb, jsdb, jedb
  type(obc_segment_type), pointer :: segment => null()
 
  if (.not.associated(obc)) call mom_error(fatal, 'dyed_channel_initialization.F90: '// &
        'dyed_channel_update_flow() was called but OBC type was not initialized!')
 
  time_sec = time_type_to_real(time)
  pi = 4.0*atan(1.0)
 
  do l=1, obc%number_of_segments
    segment => obc%segment(l)
    if (.not. segment%on_pe) cycle
    if (segment%gradient) cycle
    if (segment%oblique .and. .not. segment%nudged .and. .not. segment%Flather) cycle
 
    if (segment%is_E_or_W) then
      jsd = segment%HI%jsd ; jed = segment%HI%jed
      isdb = segment%HI%IsdB ; iedb = segment%HI%IedB
      if (cs%frequency == 0.0) then
        flow = cs%zonal_flow
      else
        flow = cs%zonal_flow + cs%tidal_amp * cos(2 * pi * cs%frequency * time_sec)
      endif
      do k=1,g%ke
        do j=jsd,jed ; do i=isdb,iedb
          if (segment%specified .or. segment%nudged) then
            segment%normal_vel(i,j,k) = flow
          endif
          if (segment%specified) then
            segment%normal_trans(i,j,k) = flow * g%dyCu(i,j)
          endif
        enddo ; enddo
      enddo
      do j=jsd,jed ; do i=isdb,iedb
        segment%normal_vel_bt(i,j) = flow
      enddo ; enddo
    else
      isd = segment%HI%isd ; ied = segment%HI%ied
      jsdb = segment%HI%JsdB ; jedb = segment%HI%JedB
      do j=jsdb,jedb ; do i=isd,ied
        segment%normal_vel_bt(i,j) = 0.0
      enddo ; enddo
    endif
  enddo
 
end subroutine dyed_channel_update_flow
 
!> \namespace dyed_channel_initialization
!!
!! Setting dyes, one for painting the inflow on each side.
end module dyed_channel_initialization