38 at4_1, at4_2, at5, at6, at7, atr1, alb1, &
39 ai1, ai2, aqtlde, am3, &
40 dtime_temp, dtt_2dxi, dtt_2deta, i, j)
50 integer(i4b),
intent(in) :: i, j
51 real(dp),
intent(in) :: at1(0:kcmax), at2_1(0:kcmax), at2_2(0:kcmax), &
52 at3_1(0:kcmax), at3_2(0:kcmax), &
53 at4_1(0:kcmax), at4_2(0:kcmax), &
54 at5(0:kcmax), at6(0:kcmax), at7, &
55 ai1(0:kcmax), ai2(0:kcmax), &
56 atr1, alb1, aqtlde(0:kcmax), am3(0:kcmax)
57 real(dp),
intent(in) :: dtime_temp, dtt_2dxi, dtt_2deta
59 integer(i4b) :: kc, kt, kr
60 real(dp) :: ct1(0:kcmax), ct2(0:kcmax), ct3(0:kcmax), ct4(0:kcmax), &
61 ce5(0:kcmax), ce6(0:kcmax), ce7(0:kcmax), ctr1, clb1
62 real(dp) :: ct1_sg(0:kcmax), ct2_sg(0:kcmax), ct3_sg(0:kcmax), &
63 ct4_sg(0:kcmax), adv_vert_sg(0:kcmax), abs_adv_vert_sg(0:kcmax)
64 real(dp) :: ci1(0:kcmax), ci2(0:kcmax)
65 real(dp) :: cqtlde(0:kcmax), cm3(0:kcmax)
66 real(dp) :: dtt_dxi, dtt_deta
67 real(dp) :: temp_c_val(0:kcmax), omega_c_val(0:kcmax)
68 real(dp) :: lgs_a0(0:kcmax+ktmax+krmax+imax+jmax), &
69 lgs_a1(0:kcmax+ktmax+krmax+imax+jmax), &
70 lgs_a2(0:kcmax+ktmax+krmax+imax+jmax), &
71 lgs_x(0:kcmax+ktmax+krmax+imax+jmax), &
72 lgs_b(0:kcmax+ktmax+krmax+imax+jmax)
74 real(dp),
parameter :: eps_omega=1.0e-12_dp
78 if ((i == 0).or.(i == imax).or.(j == 0).or.(j == jmax)) &
79 stop
' calc_temp_enth_2: Boundary points not allowed.'
84 at4_1, at4_2, at5, atr1, alb1, &
86 dtime_temp, dtt_2dxi, dtt_2deta, i, j, &
87 ct1, ct2, ct3, ct4, ce5, ctr1, clb1, &
88 ct1_sg, ct2_sg, ct3_sg, ct4_sg, &
89 adv_vert_sg, abs_adv_vert_sg, &
90 ci1, cqtlde, dtt_dxi, dtt_deta)
93 temp_c_val(kc) = temp_c(kc,j,i)
94 omega_c_val(kc) = omega_c(kc,j,i)
98 i, j, ce6, ce7, ci2, cm3)
105 lgs_a0, lgs_a1, lgs_a2, lgs_b)
109 call
tri_sle(lgs_a0, lgs_a1, lgs_a2, lgs_x, lgs_b, krmax)
114 temp_r_neu(kr,j,i) = lgs_x(kr)
122 ct1_sg, ct2_sg, ct3_sg, ct4_sg, cm3, &
123 adv_vert_sg, abs_adv_vert_sg, &
124 dtime_temp, dtt_dxi, dtt_deta, &
125 dtt_2dxi, dtt_2deta, &
127 lgs_a0, lgs_a1, lgs_a2, lgs_b)
131 call
tri_sle(lgs_a0, lgs_a1, lgs_a2, lgs_x, lgs_b, kcmax)
136 enth_c_neu(kc,j,i) = lgs_x(kc)
137 temp_c_neu(kc,j,i) =
temp_fct_enth(enth_c_neu(kc,j,i), temp_c_m(kc,j,i))
138 omega_c_neu(kc,j,i) =
omega_fct_enth(enth_c_neu(kc,j,i), temp_c_m(kc,j,i))
146 if (omega_c_neu(kc,j,i) > eps_omega)
then
157 #if (CALCMOD==3) /* ENTM scheme */
159 if (kc_cts_neu(j,i) > 0)
then
164 temp_c_val(kc) = temp_c_neu(kc,j,i)
165 omega_c_val(kc) = omega_c_neu(kc,j,i)
169 i, j, ce6, ce7, ci2, cm3)
174 ct1_sg, ct2_sg, ct3_sg, ct4_sg, cm3, &
175 adv_vert_sg, abs_adv_vert_sg, &
176 dtime_temp, dtt_dxi, dtt_deta, &
177 dtt_2dxi, dtt_2deta, &
178 i, j, kc_cts_neu(j,i), &
179 lgs_a0, lgs_a1, lgs_a2, lgs_b)
183 call
tri_sle(lgs_a0, lgs_a1, lgs_a2, lgs_x, lgs_b, kcmax)
188 enth_c_neu(kc,j,i) = lgs_x(kc)
189 temp_c_neu(kc,j,i) =
temp_fct_enth(enth_c_neu(kc,j,i), temp_c_m(kc,j,i))
190 omega_c_neu(kc,j,i) =
omega_fct_enth(enth_c_neu(kc,j,i), temp_c_m(kc,j,i))
192 do kc=kc_cts_neu(j,i)+1, kcmax
193 enth_c_neu(kc,j,i) = lgs_x(kc)
194 temp_c_neu(kc,j,i) =
temp_fct_enth(enth_c_neu(kc,j,i), temp_c_m(kc,j,i))
195 omega_c_neu(kc,j,i) = 0.0_dp
200 #elif (CALCMOD==2) /* ENTC scheme */
205 stop
' calc_temp_enth_2: CALCMOD must be either 2 or 3!'
212 do kc=0, kc_cts_neu(j,i)
214 if (omega_c_neu(kc,j,i) > omega_max)
then
216 q_tld(j,i) = q_tld(j,i) + cqtlde(kc)*(omega_c_neu(kc,j,i)-omega_max)
218 omega_c_neu(kc,j,i) = omega_max
229 enth_t_neu(kt,j,i) = enth_c_neu(0,j,i)
230 omega_t_neu(kt,j,i) = omega_c_neu(0,j,i)
238 ct1_sg, ct2_sg, ct3_sg, ct4_sg, &
239 adv_vert_sg, abs_adv_vert_sg, &
240 dtime_temp, dtt_dxi, dtt_deta, &
241 dtt_2dxi, dtt_2deta, &
243 lgs_a0, lgs_a1, lgs_a2, lgs_b)
247 call
tri_sle(lgs_a0, lgs_a1, lgs_a2, lgs_x, lgs_b, kcmax)
254 age_c_neu(kc,j,i) = lgs_x(kc)
256 if (age_c_neu(kc,j,i) < (age_min*year_sec)) &
257 age_c_neu(kc,j,i) = 0.0_dp
258 if (age_c_neu(kc,j,i) > (age_max*year_sec)) &
259 age_c_neu(kc,j,i) = age_max*year_sec
266 age_t_neu(kt,j,i) = age_c_neu(0,j,i)
276 at4_1, at4_2, at5, atr1, alb1, &
278 dtime_temp, dtt_2dxi, dtt_2deta, i, j, &
279 ct1, ct2, ct3, ct4, ce5, ctr1, clb1, &
280 ct1_sg, ct2_sg, ct3_sg, ct4_sg, &
281 adv_vert_sg, abs_adv_vert_sg, &
282 ci1, cqtlde, dtt_dxi, dtt_deta)
290 integer(i4b),
intent(in) :: i, j
291 real(dp),
intent(in) :: at1(0:kcmax), &
292 at2_1(0:kcmax), at2_2(0:kcmax), &
293 at3_1(0:kcmax), at3_2(0:kcmax), &
294 at4_1(0:kcmax), at4_2(0:kcmax), &
295 at5(0:kcmax), ai1(0:kcmax), &
296 atr1, alb1, aqtlde(0:kcmax)
297 real(dp),
intent(in) :: dtime_temp, dtt_2dxi, dtt_2deta
299 real(dp),
intent(out) :: ct1(0:kcmax), ct2(0:kcmax), ct3(0:kcmax), &
300 ct4(0:kcmax), ce5(0:kcmax), &
302 real(dp),
intent(out) :: ct1_sg(0:kcmax), ct2_sg(0:kcmax), &
303 ct3_sg(0:kcmax), ct4_sg(0:kcmax), &
304 adv_vert_sg(0:kcmax), abs_adv_vert_sg(0:kcmax)
305 real(dp),
intent(out) :: ci1(0:kcmax), cqtlde(0:kcmax)
306 real(dp),
intent(out) :: dtt_dxi, dtt_deta
324 abs_adv_vert_sg = 0.0_dp
333 clb1 = alb1*q_geo(j,i)
338 ct1(kc) = at1(kc)/h_c(j,i)*0.5_dp*(vz_c(kc,j,i)+vz_c(kc-1,j,i))
342 ct1_sg(kc) = 0.5_dp*(at1(kc)+at1(kc+1))/h_c(j,i)*vz_c(kc,j,i)
345 ct1_sg(kc) = 0.5_dp*(at1(kc)+at1(kc+1))/h_c(j,i)*vz_c(kc,j,i)
348 #elif (ADV_VERT==2 || ADV_VERT==3)
351 ct1_sg(kc) = 0.5_dp*(at1(kc)+at1(kc+1))/h_c(j,i)*vz_c(kc,j,i)
358 ct2(kc) = ( at2_1(kc)*dzm_dtau(j,i) &
359 +at2_2(kc)*dh_c_dtau(j,i) )/h_c(j,i)
360 ct3(kc) = ( at3_1(kc)*dzm_dxi_g(j,i) &
361 +at3_2(kc)*dh_c_dxi_g(j,i) )/h_c(j,i) &
362 *0.5_dp*(vx_c(kc,j,i)+vx_c(kc,j,i-1)) *insq_g11_g(j,i)
363 ct4(kc) = ( at4_1(kc)*dzm_deta_g(j,i) &
364 +at4_2(kc)*dh_c_deta_g(j,i) )/h_c(j,i) &
365 *0.5_dp*(vy_c(kc,j,i)+vy_c(kc,j-1,i)) *insq_g22_g(j,i)
366 ce5(kc) = at5(kc)/h_c(j,i)
367 ci1(kc) = ai1(kc)/h_c(j,i)
368 cqtlde(kc) = aqtlde(kc)*h_c(j,i)
375 ct2_sg(kc) = 0.5_dp*(ct2(kc)+ct2(kc+1))
376 ct3_sg(kc) = 0.5_dp*(ct3(kc)+ct3(kc+1))
377 ct4_sg(kc) = 0.5_dp*(ct4(kc)+ct4(kc+1))
378 adv_vert_sg(kc) = ct1_sg(kc)-ct2_sg(kc)-ct3_sg(kc)-ct4_sg(kc)
379 abs_adv_vert_sg(kc) = abs(adv_vert_sg(kc))
381 ct2_sg(kc) = 0.5_dp*(ct2(kc)+ct2(kc+1))
382 ct3_sg(kc) = 0.5_dp*(ct3(kc)+ct3(kc+1))
383 ct4_sg(kc) = 0.5_dp*(ct4(kc)+ct4(kc+1))
384 adv_vert_sg(kc) = ct1_sg(kc)-ct2_sg(kc)-ct3_sg(kc)-ct4_sg(kc)
385 abs_adv_vert_sg(kc) = abs(adv_vert_sg(kc))
387 #elif (ADV_VERT==2 || ADV_VERT==3)
390 ct2_sg(kc) = 0.5_dp*(ct2(kc)+ct2(kc+1))
391 ct3_sg(kc) = 0.5_dp*(ct3(kc)+ct3(kc+1))
392 ct4_sg(kc) = 0.5_dp*(ct4(kc)+ct4(kc+1))
393 adv_vert_sg(kc) = ct1_sg(kc)-ct2_sg(kc)-ct3_sg(kc)-ct4_sg(kc)
394 abs_adv_vert_sg(kc) = abs(adv_vert_sg(kc))
400 dtt_dxi = 2.0_dp*dtt_2dxi
401 dtt_deta = 2.0_dp*dtt_2deta
411 i, j, ce6, ce7, ci2, cm3)
420 integer(i4b),
intent(in) :: i, j
421 real(dp),
intent(in) :: at6(0:kcmax), at7, ai2(0:kcmax), am3(0:kcmax)
422 real(dp),
intent(in) :: temp_c_val(0:kcmax), omega_c_val(0:kcmax)
424 real(dp),
intent(out) :: ce6(0:kcmax), ce7(0:kcmax), ci2(0:kcmax), &
428 real(dp) :: temp_c_help(0:kcmax)
442 if (.not.flag_shelfy_stream(j,i))
then
446 *
ratefac_c_t(temp_c_val(kc), omega_c_val(kc), temp_c_m(kc,j,i)) &
447 *
creep(sigma_c(kc,j,i)) &
448 *sigma_c(kc,j,i)*sigma_c(kc,j,i)
451 ce7(kc) = 2.0_dp*at7 &
453 temp_c_val(kc), temp_c_m(kc,j,i), omega_c_val(kc), &
454 enh_c(kc,j,i), 2_i2b) &
459 cm3(kc) = am3(kc)*h_c(j,i)*
c_val(temp_c_val(kc))
463 do kc=0, kc_cts_neu(j,i)-1
466 ci2(kc) = ai2(kc)/h_c(j,i)
469 do kc=kc_cts_neu(j,i), kcmax-1
470 temp_c_help(kc) = 0.5_dp*(temp_c_val(kc)+temp_c_val(kc+1))
473 ci2(kc) = ai2(kc)/h_c(j,i)
484 lgs_a0, lgs_a1, lgs_a2, lgs_b)
492 integer(i4b),
intent(in) :: i, j
493 real(dp),
intent(in) :: ctr1, clb1
495 real(dp),
intent(out) :: lgs_a0(0:kcmax+ktmax+krmax+imax+jmax), &
496 lgs_a1(0:kcmax+ktmax+krmax+imax+jmax), &
497 lgs_a2(0:kcmax+ktmax+krmax+imax+jmax), &
498 lgs_b(0:kcmax+ktmax+krmax+imax+jmax)
521 lgs_a1(kr) = 1.0_dp + 2.0_dp*ctr1
523 lgs_b(kr) = temp_r(kr,j,i)
533 lgs_b(kr) = 2.0_dp*clb1
541 lgs_b(kr) = temp_t_m(0,j,i)
551 ct1_sg, ct2_sg, ct3_sg, ct4_sg, cm3, &
552 adv_vert_sg, abs_adv_vert_sg, &
553 dtime_temp, dtt_dxi, dtt_deta, &
554 dtt_2dxi, dtt_2deta, &
556 lgs_a0, lgs_a1, lgs_a2, lgs_b)
565 integer(i4b),
intent(in) :: i, j
566 integer(i2b),
intent(in) :: kcmin
567 real(dp),
intent(in) :: ct1(0:kcmax), ct2(0:kcmax), ct3(0:kcmax), &
568 ct4(0:kcmax), ce5(0:kcmax), ce6(0:kcmax), &
570 real(dp),
intent(in) :: ct1_sg(0:kcmax), ct2_sg(0:kcmax), &
571 ct3_sg(0:kcmax), ct4_sg(0:kcmax), &
572 adv_vert_sg(0:kcmax), abs_adv_vert_sg(0:kcmax)
573 real(dp),
intent(in) :: cm3(0:kcmax)
574 real(dp),
intent(in) :: dtime_temp, dtt_dxi, dtt_deta, dtt_2dxi, dtt_2deta
576 real(dp),
intent(out) :: lgs_a0(0:kcmax+ktmax+krmax+imax+jmax), &
577 lgs_a1(0:kcmax+ktmax+krmax+imax+jmax), &
578 lgs_a2(0:kcmax+ktmax+krmax+imax+jmax), &
579 lgs_b(0:kcmax+ktmax+krmax+imax+jmax)
582 real(dp) :: vx_c_help, vy_c_help
583 real(dp) :: adv_vert_help
598 if (kc_cts_neu(j,i) == 0)
then
638 do kc=kcmin+1, kcmax-1
642 lgs_a0(kc) = -0.5_dp*(ct1(kc)-ct2(kc)-ct3(kc)-ct4(kc)) &
644 lgs_a1(kc) = 1.0_dp+ce5(kc)*(ce6(kc)+ce6(kc-1))
645 lgs_a2(kc) = 0.5_dp*(ct1(kc)-ct2(kc)-ct3(kc)-ct4(kc)) &
651 = -0.5_dp*(adv_vert_sg(kc-1)+abs_adv_vert_sg(kc-1)) &
655 +0.5_dp*(adv_vert_sg(kc-1)+abs_adv_vert_sg(kc-1)) &
656 -0.5_dp*(adv_vert_sg(kc) -abs_adv_vert_sg(kc) ) &
657 +ce5(kc)*(ce6(kc)+ce6(kc-1))
659 = 0.5_dp*(adv_vert_sg(kc) -abs_adv_vert_sg(kc) ) &
664 adv_vert_help = 0.5_dp*(adv_vert_sg(kc)+adv_vert_sg(kc-1))
667 = -max(adv_vert_help, 0.0_dp) &
671 +max(adv_vert_help, 0.0_dp)-min(adv_vert_help, 0.0_dp) &
672 +ce5(kc)*(ce6(kc)+ce6(kc-1))
674 = min(adv_vert_help, 0.0_dp) &
681 lgs_b(kc) = enth_c(kc,j,i) + ce7(kc) &
683 ( (vx_c(kc,j,i)-abs(vx_c(kc,j,i))) &
684 *(enth_c(kc,j,i+1)-enth_c(kc,j,i)) &
686 +(vx_c(kc,j,i-1)+abs(vx_c(kc,j,i-1))) &
687 *(enth_c(kc,j,i)-enth_c(kc,j,i-1)) &
688 *insq_g11_sgx(j,i-1) ) &
690 ( (vy_c(kc,j,i)-abs(vy_c(kc,j,i))) &
691 *(enth_c(kc,j+1,i)-enth_c(kc,j,i)) &
693 +(vy_c(kc,j-1,i)+abs(vy_c(kc,j-1,i))) &
694 *(enth_c(kc,j,i)-enth_c(kc,j-1,i)) &
695 *insq_g22_sgy(j-1,i) )
699 vx_c_help = 0.5_dp*(vx_c(kc,j,i)+vx_c(kc,j,i-1))
700 vy_c_help = 0.5_dp*(vy_c(kc,j,i)+vy_c(kc,j-1,i))
702 lgs_b(kc) = enth_c(kc,j,i) + ce7(kc) &
704 ( min(vx_c_help, 0.0_dp) &
705 *(enth_c(kc,j,i+1)-enth_c(kc,j,i)) &
707 +max(vx_c_help, 0.0_dp) &
708 *(enth_c(kc,j,i)-enth_c(kc,j,i-1)) &
709 *insq_g11_sgx(j,i-1) ) &
711 ( min(vy_c_help, 0.0_dp) &
712 *(enth_c(kc,j+1,i)-enth_c(kc,j,i)) &
714 +max(vy_c_help, 0.0_dp) &
715 *(enth_c(kc,j,i)-enth_c(kc,j-1,i)) &
716 *insq_g22_sgy(j-1,i) )
736 ct1_sg, ct2_sg, ct3_sg, ct4_sg, &
737 adv_vert_sg, abs_adv_vert_sg, &
738 dtime_temp, dtt_dxi, dtt_deta, &
739 dtt_2dxi, dtt_2deta, &
741 lgs_a0, lgs_a1, lgs_a2, lgs_b)
749 integer(i4b),
intent(in) :: i, j
750 real(dp),
intent(in) :: ct1(0:kcmax), ct2(0:kcmax), ct3(0:kcmax), &
751 ct4(0:kcmax), ci1(0:kcmax), ci2(0:kcmax)
752 real(dp),
intent(in) :: ct1_sg(0:kcmax), ct2_sg(0:kcmax), &
753 ct3_sg(0:kcmax), ct4_sg(0:kcmax), &
754 adv_vert_sg(0:kcmax), abs_adv_vert_sg(0:kcmax)
755 real(dp),
intent(in) :: dtime_temp, dtt_dxi, dtt_deta, dtt_2dxi, dtt_2deta
757 real(dp),
intent(out) :: lgs_a0(0:kcmax+ktmax+krmax+imax+jmax), &
758 lgs_a1(0:kcmax+ktmax+krmax+imax+jmax), &
759 lgs_a2(0:kcmax+ktmax+krmax+imax+jmax), &
760 lgs_b(0:kcmax+ktmax+krmax+imax+jmax)
763 real(dp) :: vx_c_help, vy_c_help
764 real(dp) :: adv_vert_help
776 lgs_a1(kc) = 1.0_dp - min(adv_vert_sg(kc), 0.0_dp)
777 lgs_a2(kc) = min(adv_vert_sg(kc), 0.0_dp)
781 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
783 ( (vx_c(kc,j,i)-abs(vx_c(kc,j,i))) &
784 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
786 +(vx_c(kc,j,i-1)+abs(vx_c(kc,j,i-1))) &
787 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
788 *insq_g11_sgx(j,i-1) ) &
790 ( (vy_c(kc,j,i)-abs(vy_c(kc,j,i))) &
791 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
793 +(vy_c(kc,j-1,i)+abs(vy_c(kc,j-1,i))) &
794 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
795 *insq_g22_sgy(j-1,i) )
799 vx_c_help = 0.5_dp*(vx_c(kc,j,i)+vx_c(kc,j,i-1))
800 vy_c_help = 0.5_dp*(vy_c(kc,j,i)+vy_c(kc,j-1,i))
802 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
804 ( min(vx_c_help, 0.0_dp) &
805 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
807 +max(vx_c_help, 0.0_dp) &
808 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
809 *insq_g11_sgx(j,i-1) ) &
811 ( min(vy_c_help, 0.0_dp) &
812 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
814 +max(vy_c_help, 0.0_dp) &
815 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
816 *insq_g22_sgy(j-1,i) )
824 lgs_a0(kc) = -0.5_dp*(ct1(kc)-ct2(kc)-ct3(kc)-ct4(kc)) &
826 lgs_a1(kc) = 1.0_dp+ci1(kc)*(ci2(kc)+ci2(kc-1))
827 lgs_a2(kc) = 0.5_dp*(ct1(kc)-ct2(kc)-ct3(kc)-ct4(kc)) &
832 lgs_a0(kc) = -0.5_dp*(adv_vert_sg(kc-1)+abs_adv_vert_sg(kc-1))
833 lgs_a1(kc) = 1.0_dp &
834 +0.5_dp*(adv_vert_sg(kc-1)+abs_adv_vert_sg(kc-1)) &
835 -0.5_dp*(adv_vert_sg(kc) -abs_adv_vert_sg(kc) )
836 lgs_a2(kc) = 0.5_dp*(adv_vert_sg(kc) -abs_adv_vert_sg(kc) )
840 adv_vert_help = 0.5_dp*(adv_vert_sg(kc)+adv_vert_sg(kc-1))
842 lgs_a0(kc) = -max(adv_vert_help, 0.0_dp)
843 lgs_a1(kc) = 1.0_dp &
844 +max(adv_vert_help, 0.0_dp)-min(adv_vert_help, 0.0_dp)
845 lgs_a2(kc) = min(adv_vert_help, 0.0_dp)
851 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
853 ( (vx_c(kc,j,i)-abs(vx_c(kc,j,i))) &
854 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
856 +(vx_c(kc,j,i-1)+abs(vx_c(kc,j,i-1))) &
857 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
858 *insq_g11_sgx(j,i-1) ) &
860 ( (vy_c(kc,j,i)-abs(vy_c(kc,j,i))) &
861 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
863 +(vy_c(kc,j-1,i)+abs(vy_c(kc,j-1,i))) &
864 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
865 *insq_g22_sgy(j-1,i) )
869 vx_c_help = 0.5_dp*(vx_c(kc,j,i)+vx_c(kc,j,i-1))
870 vy_c_help = 0.5_dp*(vy_c(kc,j,i)+vy_c(kc,j-1,i))
872 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
874 ( min(vx_c_help, 0.0_dp) &
875 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
877 +max(vx_c_help, 0.0_dp) &
878 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
879 *insq_g11_sgx(j,i-1) ) &
881 ( min(vy_c_help, 0.0_dp) &
882 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
884 +max(vy_c_help, 0.0_dp) &
885 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
886 *insq_g22_sgy(j-1,i) )
893 if (as_perp(j,i) >= 0.0_dp)
then
898 lgs_a0(kc) = -max(adv_vert_sg(kc-1), 0.0_dp)
899 lgs_a1(kc) = 1.0_dp + max(adv_vert_sg(kc-1), 0.0_dp)
904 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
906 ( (vx_c(kc,j,i)-abs(vx_c(kc,j,i))) &
907 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
909 +(vx_c(kc,j,i-1)+abs(vx_c(kc,j,i-1))) &
910 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
911 *insq_g11_sgx(j,i-1) ) &
913 ( (vy_c(kc,j,i)-abs(vy_c(kc,j,i))) &
914 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
916 +(vy_c(kc,j-1,i)+abs(vy_c(kc,j-1,i))) &
917 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
918 *insq_g22_sgy(j-1,i) )
922 vx_c_help = 0.5_dp*(vx_c(kc,j,i)+vx_c(kc,j,i-1))
923 vy_c_help = 0.5_dp*(vy_c(kc,j,i)+vy_c(kc,j-1,i))
925 lgs_b(kc) = age_c(kc,j,i) + dtime_temp &
927 ( min(vx_c_help, 0.0_dp) &
928 *(age_c(kc,j,i+1)-age_c(kc,j,i)) &
930 +max(vx_c_help, 0.0_dp) &
931 *(age_c(kc,j,i)-age_c(kc,j,i-1)) &
932 *insq_g11_sgx(j,i-1) ) &
934 ( min(vy_c_help, 0.0_dp) &
935 *(age_c(kc,j+1,i)-age_c(kc,j,i)) &
937 +max(vy_c_help, 0.0_dp) &
938 *(age_c(kc,j,i)-age_c(kc,j-1,i)) &
939 *insq_g22_sgy(j-1,i) )
subroutine tri_sle(a0, a1, a2, x, b, nrows)
Solution of a system of linear equations Ax=b with tridiagonal matrix A.
Declarations of kind types for SICOPOLIS.
subroutine calc_temp_enth_2_a1(at1, at2_1, at2_2, at3_1, at3_2, at4_1, at4_2, at5, atr1, alb1, ai1, aqtlde, dtime_temp, dtt_2dxi, dtt_2deta, i, j, ct1, ct2, ct3, ct4, ce5, ctr1, clb1, ct1_sg, ct2_sg, ct3_sg, ct4_sg, adv_vert_sg, abs_adv_vert_sg, ci1, cqtlde, dtt_dxi, dtt_deta)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method: ...
real(dp) function viscosity(de_val, temp_val, temp_m_val, omega_val, enh_val, i_flag_cold_temp)
Ice viscosity as a function of the effective strain rate and the temperature (in cold ice) or the wat...
real(dp) function, public ratefac_c_t(temp_val, omega_val, temp_m_val)
Rate factor for cold and temperate ice: Combination of ratefac_c and ratefac_t (only for the enthalpy...
real(dp) function, public temp_fct_enth(enth_val, temp_m_val)
Temperature as a function of enthalpy.
subroutine calc_temp_enth_2_b(ctr1, clb1, i, j, lgs_a0, lgs_a1, lgs_a2, lgs_b)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method: ...
Declarations of global variables for SICOPOLIS (for the ANT domain).
subroutine calc_temp_enth_2(at1, at2_1, at2_2, at3_1, at3_2, at4_1, at4_2, at5, at6, at7, atr1, alb1, ai1, ai2, aqtlde, am3, dtime_temp, dtt_2dxi, dtt_2deta, i, j)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method...
real(dp) function, public omega_fct_enth(enth_val, temp_m_val)
Water content as a function of enthalpy.
subroutine calc_temp_enth_2_c(ct1, ct2, ct3, ct4, ce5, ce6, ce7, ct1_sg, ct2_sg, ct3_sg, ct4_sg, cm3, adv_vert_sg, abs_adv_vert_sg, dtime_temp, dtt_dxi, dtt_deta, dtt_2dxi, dtt_2deta, i, j, kcmin, lgs_a0, lgs_a1, lgs_a2, lgs_b)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method: ...
Solvers for systems of linear equations used by SICOPOLIS.
real(dp) function, public kappa_val(temp_val)
Heat conductivity of ice: Linear interpolation of tabulated values in KAPPA(.).
real(dp) function, public c_val(temp_val)
Specific heat of ice: Linear interpolation of tabulated values in C(.).
Material quantities of ice: Rate factor, heat conductivity, specific heat (heat capacity).
Declarations of global variables for SICOPOLIS.
real(dp) function creep(sigma_val)
Creep response function for ice.
subroutine calc_temp_enth_2_d(ct1, ct2, ct3, ct4, ci1, ci2, ct1_sg, ct2_sg, ct3_sg, ct4_sg, adv_vert_sg, abs_adv_vert_sg, dtime_temp, dtt_dxi, dtt_deta, dtt_2dxi, dtt_2deta, i, j, lgs_a0, lgs_a1, lgs_a2, lgs_b)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method: ...
Conversion from temperature (temp) and water content (omega) to enthalpy (enth) and vice versa...
subroutine calc_temp_enth_2_a2(at6, at7, ai2, am3, temp_c_val, omega_c_val, i, j, ce6, ce7, ci2, cm3)
Computation of temperature and age for an ice column with a temperate base with the enthalpy method: ...
real(dp) function, public enth_fct_temp_omega(temp_val, omega_val)
Enthalpy as a function of temperature and water content.