calc_enhance_m.F90

Go to the documentation of this file.

!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  Module :  c a l c _ e n h a n c e _ m
!
!> @file
!!
!! Computation of the flow enhancement factor.
!!
!! @section Copyright
!!
!! Copyright 2009-2017 Ralf Greve
!!
!! @section License
!!
!! This file is part of SICOPOLIS.
!!
!! SICOPOLIS is free software: you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation, either version 3 of the License, or
!! (at your option) any later version.
!!
!! SICOPOLIS is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with SICOPOLIS.  If not, see <http://www.gnu.org/licenses/>.
!<
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!<------------------------------------------------------------------------------
module calc_enhance_m

  use sico_types_m
  use sico_variables_m
  use sico_vars_m

  implicit none

  private
  public :: calc_enhance_1, calc_enhance_2, calc_enhance_3
  public :: calc_enhance_4, calc_enhance_5

contains

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!! Case ENHMOD==1:
!! constant for grounded ice, constant for floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_1()

  implicit none

  enh_t = enh_fact
  enh_c = enh_fact

#if (MARGIN==3)   /* floating ice */
  call calc_enhance_floating_const()
#endif

#if (defined(NMARS) || defined(SMARS))   /* Martian polar caps */
  call mod_enhance_dust()
#endif

  end subroutine calc_enhance_1

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!! Case ENHMOD==2:
!! two different values depending on age for grounded ice,
!! constant for floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_2()

  implicit none

  integer(i4b) :: i, j, kc, kt
  real(dp)     :: age_trans

  age_trans = age_trans_0*year_sec

  do i=0, imax
  do j=0, jmax

     do kt=0, ktmax
        if (age_t(kt,j,i) < age_trans) then
           enh_t(kt,j,i) = enh_intg   ! Holocene ice
        else
           enh_t(kt,j,i) = enh_fact   ! Pleistocene ice
        end if
     end do

     do kc=0, kcmax
        if (age_c(kc,j,i) < age_trans) then
           enh_c(kc,j,i) = enh_intg   ! Holocene ice
        else
           enh_c(kc,j,i) = enh_fact   ! Pleistocene ice
        end if
     end do

  end do
  end do

#if (MARGIN==3)   /* floating ice */
  call calc_enhance_floating_const()
#endif

#if (defined(NMARS) || defined(SMARS))   /* Martian polar caps */
  call mod_enhance_dust()
#endif

  end subroutine calc_enhance_2

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!! Case ENHMOD==3:
!! two different values depending on time of deposition for grounded ice,
!! constant for floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_3(time)

  implicit none

  real(dp), intent(in) :: time

  integer(i4b) :: i, j, kc, kt
  real(dp)     :: date_trans1, date_trans2, date_trans3

  date_trans1 = date_trans1_0*year_sec
  date_trans2 = date_trans2_0*year_sec
  date_trans3 = date_trans3_0*year_sec

  do i=0, imax
  do j=0, jmax

     do kt=0, ktmax
        if ( (time-age_t(kt,j,i)) < date_trans1 ) then
           enh_t(kt,j,i) = enh_fact   ! pre-Eemian ice
        else if ( ((time-age_t(kt,j,i)) >= date_trans1).and. &
                  ((time-age_t(kt,j,i)) <  date_trans2) ) then
           enh_t(kt,j,i) = enh_intg   ! Eemian ice
        else if ( ((time-age_t(kt,j,i)) >= date_trans2).and. &
                  ((time-age_t(kt,j,i)) <  date_trans3) ) then
           enh_t(kt,j,i) = enh_fact   ! Weichselian ice
        else
           enh_t(kt,j,i) = enh_intg   ! Holocene ice
        end if
     end do

     do kc=0, kcmax
        if ( (time-age_c(kc,j,i)) < date_trans1 ) then
           enh_c(kc,j,i) = enh_fact   ! pre-Eemian ice
        else if ( ((time-age_c(kc,j,i)) >= date_trans1).and. &
                  ((time-age_c(kc,j,i)) <  date_trans2) ) then
           enh_c(kc,j,i) = enh_intg   ! Eemian ice
        else if ( ((time-age_c(kc,j,i)) >= date_trans2).and. &
                  ((time-age_c(kc,j,i)) <  date_trans3) ) then
           enh_c(kc,j,i) = enh_fact   ! Weichselian ice
        else
           enh_c(kc,j,i) = enh_intg   ! Holocene ice
        end if
     end do

  end do
  end do

#if (MARGIN==3)   /* floating ice */
  call calc_enhance_floating_const()
#endif

#if (defined(NMARS) || defined(SMARS))   /* Martian polar caps */
  call mod_enhance_dust()
#endif

  end subroutine calc_enhance_3

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!! Case ENHMOD==4:
!! minimal anisotropic enhancement factor for grounded ice,
!! constant for floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_4()

  implicit none

  call calc_enhance_aniso()

#if (MARGIN==3)   /* floating ice */
  call calc_enhance_floating_const()
#endif

#if (defined(NMARS) || defined(SMARS))   /* Martian polar caps */
  call mod_enhance_dust()
#endif

  end subroutine calc_enhance_4

!-------------------------------------------------------------------------------
!> Computation of the flow enhancement factor.
!! Case ENHMOD==5:
!! minimal anisotropic enhancement factor for grounded and floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_5()

  implicit none

  call calc_enhance_aniso()

#if (defined(NMARS) || defined(SMARS))   /* Martian polar caps */
  call mod_enhance_dust()
#endif

  end subroutine calc_enhance_5

!-------------------------------------------------------------------------------
!> Minimal anisotropic flow enhancement factor.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_aniso()

  implicit none

  integer(i4b) :: i, j, kc, kt
  real(dp)     :: enh_shear, enh_compr
  real(dp)     :: enh_shear_compr_diff

#if (defined(ENH_SHEAR))
  enh_shear = enh_shear
#else
  enh_shear = 1.0_dp
#endif

#if (defined(ENH_COMPR))
  enh_compr = enh_compr
#else
  enh_compr = 1.0_dp
#endif

  enh_shear_compr_diff = enh_shear-enh_compr

  do i=0, imax
  do j=0, jmax

     do kt=0, ktmax
        enh_t(kt,j,i) = enh_compr &
                        + enh_shear_compr_diff*lambda_shear_t(kt,j,i)**2
     end do

     do kc=0, kcmax
        enh_c(kc,j,i) = enh_compr &
                        + enh_shear_compr_diff*lambda_shear_c(kc,j,i)**2
     end do

  end do
  end do

  end subroutine calc_enhance_aniso

!-------------------------------------------------------------------------------
!> Constant, prescribed flow enhancement factor for floating ice.
!<------------------------------------------------------------------------------
  subroutine calc_enhance_floating_const()

  implicit none

  integer(i4b) :: i, j, kc, kt
  real(dp)     :: enh_shelf

#if (defined(ENH_SHELF))
  enh_shelf = enh_shelf
#else
  enh_shelf = 1.0_dp
#endif

  do i=0, imax
  do j=0, jmax

     if ( maske(j,i)==3_i2b ) then   ! floating ice

        do kt=0, ktmax
           enh_t(kt,j,i) = enh_shelf
        end do

        do kc=0, kcmax
           enh_c(kc,j,i) = enh_shelf
        end do

     end if

  end do
  end do

  end subroutine calc_enhance_floating_const

!-------------------------------------------------------------------------------
!> Modification of the flow enhancement factor due to dust content
!! (for the Martian polar caps).
!<------------------------------------------------------------------------------
  subroutine mod_enhance_dust()

  implicit none

  real(dp) :: frac_dust
  real(dp) :: enh_mult

#if (defined(FRAC_DUST))
  frac_dust = frac_dust
#else
  frac_dust = 0.0_dp
#endif

#if (FLOW_LAW==1)
  enh_mult = exp(-3.0_dp*2.0_dp*frac_dust)
#elif (FLOW_LAW==2)
  enh_mult = exp(-1.8_dp*2.0_dp*frac_dust)
#elif (FLOW_LAW==3)
  enh_mult = exp(-4.0_dp*2.0_dp*frac_dust)
#elif (FLOW_LAW==4)
  stop ' >>> mod_enhance_dust: FLOW_LAW==4 has not been implemented yet!'
#endif

  enh_t = enh_t * enh_mult
  enh_c = enh_c * enh_mult

  end subroutine mod_enhance_dust

!-------------------------------------------------------------------------------

end module calc_enhance_m
!