calc_temp_const.F90

Go to the documentation of this file.

!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  Subroutine :  c a l c _ t e m p _ c o n s t
!
!> @file
!!
!! Isothermal mode: Setting of the temperature and age to constant values.
!!
!! @section Copyright
!!
!! Copyright 2014-2016 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/>.
!<
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!-------------------------------------------------------------------------------
!> Isothermal mode: Setting of the temperature and age to constant values.
!<------------------------------------------------------------------------------
subroutine calc_temp_const()

use sico_types
use sico_variables
use sico_vars

implicit none

#if defined(TEMP_CONST)
   if ( temp_const > -eps ) &
      stop ' calc_temp_const: TEMP_CONST must be negative!'
   temp_c_neu  = temp_const
   temp_r_neu  = temp_const
#else
   temp_c_neu  = -10.0_dp   ! default value -10 C
   temp_r_neu  = -10.0_dp   ! default value -10 C
#endif

temp_c_neu = min(temp_c_neu, temp_c_m-eps)
             ! keep temperatures below the pressure melting point

omega_t_neu = 0.0_dp
omega_c_neu = 0.0_dp

q_tld       = 0.0_dp

#if defined(AGE_CONST)
   age_c_neu   = age_const *year_sec   ! a --> s
   age_t_neu   = age_const *year_sec   ! a --> s
#else
   age_c_neu   = 0.0_dp   ! default value 0
   age_t_neu   = 0.0_dp   ! default value 0
#endif

n_cts_neu   = -1
kc_cts_neu  = 0
zm_neu      = zb
h_c_neu     = h_c
h_t_neu     = 0.0_dp

end subroutine calc_temp_const
!