SICOPOLIS V3.1
 All Classes Files Functions Variables Macros
calc_temp_melt.F90
Go to the documentation of this file.
1 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 !
3 ! Subroutine : c a l c _ t e m p _ m e l t
4 !
5 !> @file
6 !!
7 !! Computation of the melting temperatures.
8 !!
9 !! @section Copyright
10 !!
11 !! Copyright 2009-2013 Ralf Greve
12 !!
13 !! @section License
14 !!
15 !! This file is part of SICOPOLIS.
16 !!
17 !! SICOPOLIS is free software: you can redistribute it and/or modify
18 !! it under the terms of the GNU General Public License as published by
19 !! the Free Software Foundation, either version 3 of the License, or
20 !! (at your option) any later version.
21 !!
22 !! SICOPOLIS is distributed in the hope that it will be useful,
23 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
24 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 !! GNU General Public License for more details.
26 !!
27 !! You should have received a copy of the GNU General Public License
28 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
29 !<
30 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
31 
32 !-------------------------------------------------------------------------------
33 !> Computation of the melting temperatures.
34 !<------------------------------------------------------------------------------
35 subroutine calc_temp_melt()
36 
37 use sico_types
39 
40 implicit none
41 integer(i4b) :: i, j, kc, kt
42 real(dp) :: atm1(0:kcmax), atm2(0:ktmax)
43 
44 !-------- Term abbreviations --------
45 
46 do kc=0, kcmax
47  atm1(kc) = beta*(1.0_dp-eaz_c_quotient(kc))
48 end do
49 
50 do kt=0, ktmax
51  atm2(kt) = 1.0_dp-zeta_t(kt)
52 end do
53 
54 !-------- Compute the melting temperatures --------
55 
56 do i=0, imax
57 do j=0, jmax
58 
59  do kt=0, ktmax
60  temp_t_m(kt,j,i) = -beta*(h_c(j,i)+h_t(j,i)*atm2(kt))
61  end do
62 
63  do kc=0, kcmax
64  temp_c_m(kc,j,i) = -atm1(kc)*h_c(j,i)
65  end do
66 
67 end do
68 end do
69 
70 end subroutine calc_temp_melt
71 !