36 at4_1, at4_2, at5, at6, at7, atr1, am1, am2, alb1, &
37 aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, &
38 ai1, ai2, ai3, dzeta_t, &
39 dtime_temp, dtt_2dxi, dtt_2deta, dtime_temp_inv, &
48 integer(i4b),
intent(in) :: i, j
49 real(dp),
intent(in) :: at1(0:kcmax), at2_1(0:kcmax), at2_2(0:kcmax), &
50 at3_1(0:kcmax), at3_2(0:kcmax), at4_1(0:kcmax), &
51 at4_2(0:kcmax), at5(0:kcmax), at6(0:kcmax), at7, &
52 ai1(0:kcmax), ai2(0:kcmax), ai3, &
54 real(dp),
intent(in) :: aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld
55 real(dp),
intent(in) :: dzeta_t
56 real(dp),
intent(in) :: dtt_2dxi, dtt_2deta, dtime_temp, dtime_temp_inv
59 real(dp) :: difftemp_a, difftemp_b, interpol
66 difftemp_a = temp_c_neu(0,j,i)-(-beta*h_c_neu(j,i))
67 if (difftemp_a >= 0.0_dp)
return
73 zm_neu(j,i) = zm_neu(j,i) - zm_shift
77 if (zm_neu(j,i) <= zb(j,i))
then
79 zm_shift = (zm_neu(j,i)+zm_shift)-(zb(j,i)+0.001_dp)
80 zm_neu(j,i) = zb(j,i)+0.001_dp
81 h_c_neu(j,i) = h_c_neu(j,i)+h_t_neu(j,i)-0.001_dp
82 h_t_neu(j,i) = 0.001_dp
85 dh_t_dtau(j,i) = (zm_neu(j,i)-zm(j,i))*dtime_temp_inv
86 dzm_dtau(j,i) = dzb_dtau(j,i)+dh_t_dtau(j,i)
87 dh_c_dtau(j,i) = dzs_dtau(j,i)-dzm_dtau(j,i)
89 am_perp(j,i) = am_perp_st(j,i) + dzm_dtau(j,i)
91 call
calc_temp3(at1, at2_1, at2_2, at3_1, at3_2, &
92 at4_1, at4_2, at5, at6, at7, atr1, &
94 aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, &
95 ai1, ai2, ai3, dzeta_t, &
96 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
98 difftemp_b = difftemp_a
99 difftemp_a = temp_c_neu(0,j,i)-(-beta*h_c_neu(j,i))
101 if (difftemp_a >= 0.0_dp)
then
107 interpol = difftemp_a/(difftemp_a-difftemp_b)*zm_shift
109 zm_neu(j,i) = zm_neu(j,i) + interpol
110 h_c_neu(j,i) = h_c_neu(j,i) - interpol
111 h_t_neu(j,i) = h_t_neu(j,i) + interpol
113 dh_t_dtau(j,i) = (zm_neu(j,i)-zm(j,i))*dtime_temp_inv
114 dzm_dtau(j,i) = dzb_dtau(j,i)+dh_t_dtau(j,i)
115 dh_c_dtau(j,i) = dzs_dtau(j,i)-dzm_dtau(j,i)
117 am_perp(j,i) = am_perp_st(j,i) + dzm_dtau(j,i)
119 call
calc_temp3(at1, at2_1, at2_2, at3_1, at3_2, &
120 at4_1, at4_2, at5, at6, at7, atr1, &
122 aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, &
123 ai1, ai2, ai3, dzeta_t, &
124 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
129 zm_neu(j,i) = zb(j,i)
130 h_c_neu(j,i) = h_c_neu(j,i)+h_t_neu(j,i)
131 h_t_neu(j,i) = 0.0_dp
133 dh_t_dtau(j,i) = (zm_neu(j,i)-zm(j,i))*dtime_temp_inv
134 dzm_dtau(j,i) = dzb_dtau(j,i)+dh_t_dtau(j,i)
135 dh_c_dtau(j,i) = dzs_dtau(j,i)-dzm_dtau(j,i)
137 am_perp(j,i) = am_perp_st(j,i) + dzm_dtau(j,i)
139 call
calc_temp2(at1, at2_1, at2_2, at3_1, at3_2, &
140 at4_1, at4_2, at5, at6, at7, atr1, alb1, &
142 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
151 h_c_neu(j,i) = h_c_neu(j,i) + zm_shift
152 h_t_neu(j,i) = h_t_neu(j,i) - zm_shift
154 dh_t_dtau(j,i) = (zm_neu(j,i)-zm(j,i))*dtime_temp_inv
155 dzm_dtau(j,i) = dzb_dtau(j,i)+dh_t_dtau(j,i)
156 dh_c_dtau(j,i) = dzs_dtau(j,i)-dzm_dtau(j,i)
158 am_perp(j,i) = am_perp_st(j,i) + dzm_dtau(j,i)
160 call
calc_temp3(at1, at2_1, at2_2, at3_1, at3_2, &
161 at4_1, at4_2, at5, at6, at7, atr1, &
163 aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, &
164 ai1, ai2, ai3, dzeta_t, &
165 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
167 difftemp_b = difftemp_a
168 difftemp_a = temp_c_neu(0,j,i)-(-beta*h_c_neu(j,i))
170 if (difftemp_a < 0.0_dp) go to 10
176 interpol = difftemp_a/(difftemp_a-difftemp_b)*zm_shift
178 zm_neu(j,i) = zm_neu(j,i) + interpol
179 h_c_neu(j,i) = h_c_neu(j,i) - interpol
180 h_t_neu(j,i) = h_t_neu(j,i) + interpol
182 dh_t_dtau(j,i) = (zm_neu(j,i)-zm(j,i))*dtime_temp_inv
183 dzm_dtau(j,i) = dzb_dtau(j,i)+dh_t_dtau(j,i)
184 dh_c_dtau(j,i) = dzs_dtau(j,i)-dzm_dtau(j,i)
186 am_perp(j,i) = am_perp_st(j,i) + dzm_dtau(j,i)
188 call
calc_temp3(at1, at2_1, at2_2, at3_1, at3_2, &
189 at4_1, at4_2, at5, at6, at7, atr1, &
191 aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, &
192 ai1, ai2, ai3, dzeta_t, &
193 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
subroutine calc_temp3(at1, at2_1, at2_2, at3_1, at3_2, at4_1, at4_2, at5, at6, at7, atr1, am1, am2, alb1, aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, ai1, ai2, ai3, dzeta_t, dtime_temp, dtt_2dxi, dtt_2deta, i, j)
Computation of temperature, water content and age for an ice column with a temperate base overlain by...
Declarations of kind types for SICOPOLIS.
subroutine shift_cts_downward(at1, at2_1, at2_2, at3_1, at3_2, at4_1, at4_2, at5, at6, at7, atr1, am1, am2, alb1, aw1, aw2, aw3, aw4, aw5, aw7, aw8, aw9, aqtld, ai1, ai2, ai3, dzeta_t, dtime_temp, dtt_2dxi, dtt_2deta, dtime_temp_inv, i, j)
Downward shifting of the CTS.
Declarations of global variables for SICOPOLIS (for the ANT domain).
Declarations of global variables for SICOPOLIS.
subroutine calc_temp2(at1, at2_1, at2_2, at3_1, at3_2, at4_1, at4_2, at5, at6, at7, atr1, alb1, ai1, ai2, dtime_temp, dtt_2dxi, dtt_2deta, i, j)
Computation of temperature and age for an ice column with a temperate base overlain by cold ice...