205 SUBROUTINE r_phys_var(r_qj,r_h,r_u,r_v,r_alphas,r_rho_m,r_T,r_alphal)
210 REAL*8,
INTENT(IN) :: r_qj(n_vars)
211 REAL*8,
INTENT(OUT) :: r_h
212 REAL*8,
INTENT(OUT) :: r_u
213 REAL*8,
INTENT(OUT) :: r_v
214 REAL*8,
INTENT(OUT) :: r_alphas(n_solid)
215 REAL*8,
INTENT(OUT) :: r_rho_m
216 REAL*8,
INTENT(OUT) :: r_T
217 REAL*8,
INTENT(OUT) :: r_alphal
220 REAL*8 :: r_xs(n_solid)
229 REAL*8 :: r_sp_heat_mix
232 IF ( r_qj(1) .GT. 1.d-25 )
THEN 234 r_xs(1:n_solid) = r_qj(5:4+n_solid) / r_qj(1)
238 r_xs(1:n_solid) = 0.d0
244 IF ( gas_flag .AND. liquid_flag )
THEN 247 IF ( r_qj(1) .GT. 1.d-25 )
THEN 249 r_xl = r_qj(n_vars) / r_qj(1)
258 r_xc = 1.d0 - r_xs_tot - r_xl
261 r_sp_heat_mix = sum( r_xs(1:n_solid) *
sp_heat_s(1:n_solid) ) &
267 r_xc = 1.d0 - r_xs_tot
270 r_sp_heat_mix = sum( r_xs(1:n_solid) *
sp_heat_s(1:n_solid) ) &
276 IF ( r_qj(1) .GT. 1.d-25 )
THEN 278 IF ( energy_flag )
THEN 280 r_t = ( r_qj(4) - ( r_qj(2)**2 + r_qj(3)**2 ) / ( 2.d0*r_qj(1) ) ) / &
281 ( r_qj(1) * r_sp_heat_mix )
285 r_t = r_qj(4) / ( r_qj(1) * r_sp_heat_mix )
311 IF ( gas_flag .AND. liquid_flag )
THEN 313 r_inv_rhom = ( sum(r_xs(1:n_solid) /
rho_s(1:n_solid)) + r_xl /
rho_l &
316 r_rho_m = 1.d0 / r_inv_rhom
318 r_alphal = r_xl * r_rho_m /
rho_l 322 r_inv_rhom = ( sum(r_xs(1:n_solid) /
rho_s(1:n_solid)) + r_xc / r_rho_c )
324 r_rho_m = 1.d0 / r_inv_rhom
329 r_alphas(1:n_solid) = r_xs(1:n_solid) * r_rho_m /
rho_s(1:n_solid)
332 r_alphac = r_xc * r_rho_m / r_rho_c
334 r_h = r_qj(1) / r_rho_m
342 r_u = r_qj(2) / r_qj(1)
343 r_v = r_qj(3) / r_qj(1)
347 r_u = dsqrt(2.d0) * r_qj(1) * r_qj(2) / dsqrt( r_qj(1)**4 +
eps_sing**4 )
348 r_v = dsqrt(2.d0) * r_qj(1) * r_qj(3) / dsqrt( r_qj(1)**4 +
eps_sing**4 )
353 IF ( ( r_u**2 + r_v**2 ) .GT. 0.d0 )
THEN 355 r_ri = r_red_grav * r_h / ( r_u**2 + r_v**2 )
387 SUBROUTINE c_phys_var(c_qj,h,u,v,T,rho_m,red_grav,alphas)
393 COMPLEX*16,
INTENT(IN) :: c_qj(n_vars)
394 COMPLEX*16,
INTENT(OUT) :: h
395 COMPLEX*16,
INTENT(OUT) :: u
396 COMPLEX*16,
INTENT(OUT) :: v
397 COMPLEX*16,
INTENT(OUT) :: T
398 COMPLEX*16,
INTENT(OUT) :: rho_m
399 COMPLEX*16,
INTENT(OUT) :: red_grav
400 COMPLEX*16,
INTENT(OUT) :: alphas(n_solid)
402 COMPLEX*16 :: inv_rhom
403 COMPLEX*16 :: xs(n_solid)
410 COMPLEX*16 :: sp_heat_mix
415 IF ( dble(c_qj(1)) .GT. 1.d-25 )
THEN 417 xs(1:n_solid) = c_qj(5:4+n_solid) / c_qj(1)
421 xs(1:n_solid) = dcmplx(0.d0,0.d0)
427 IF ( gas_flag .AND. liquid_flag )
THEN 430 IF ( dble(c_qj(1)) .GT. 1.d-25 )
THEN 432 xl = c_qj(n_vars) / c_qj(1)
436 xl = dcmplx(0.d0,0.d0)
441 xc = dcmplx(1.d0,0.d0) - xs_tot - xl
444 sp_heat_mix = sum( xs(1:n_solid) *
sp_heat_s(1:n_solid) ) &
450 xc = dcmplx(1.d0,0.d0) - xs_tot
458 IF ( dble(c_qj(1)) .GT. 1.d-25 )
THEN 460 IF ( energy_flag )
THEN 462 t = ( c_qj(4) - ( c_qj(2)**2 + c_qj(3)**2 ) / ( 2.d0*c_qj(1) ) ) / &
463 ( c_qj(1) * sp_heat_mix )
467 t = c_qj(4) / ( c_qj(1) * sp_heat_mix )
471 IF ( dble(t) .LE. 0.d0 ) t = dcmplx(
t_ambient,0.d0)
493 IF ( gas_flag .AND. liquid_flag )
THEN 495 inv_rhom = ( sum(xs(1:n_solid) /
rho_s(1:n_solid)) + xl /
rho_l &
498 rho_m = 1.d0 / inv_rhom
500 alphal = xl * rho_m /
rho_l 504 inv_rhom = ( sum(xs(1:n_solid) /
rho_s(1:n_solid)) + xc / rho_c )
506 rho_m = 1.d0 / inv_rhom
511 alphas(1:n_solid) = xs(1:n_solid) * rho_m /
rho_s(1:n_solid)
514 alphac = xc * rho_m / rho_c
522 IF ( dble( c_qj(1) ) .GT.
eps_sing )
THEN 524 u = c_qj(2) / c_qj(1)
525 v = c_qj(3) / c_qj(1)
529 u = dsqrt(2.d0) * c_qj(1) * c_qj(2) / cdsqrt( c_qj(1)**4 +
eps_sing**4 )
530 v = dsqrt(2.d0) * c_qj(1) * c_qj(3) / cdsqrt( c_qj(1)**4 +
eps_sing**4 )
535 IF ( dble( u**2 + v**2 ) .GT. 0.d0 )
THEN 537 ri = red_grav * h / ( u**2 + v**2 )
541 ri = dcmplx(0.d0,0.d0)
568 SUBROUTINE mixt_var(qpj,r_Ri,r_rho_m,r_rho_c,r_red_grav)
572 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
573 REAL*8,
INTENT(OUT) :: r_Ri
574 REAL*8,
INTENT(OUT) :: r_rho_m
575 REAL*8,
INTENT(OUT) :: r_rho_c
576 REAL*8,
INTENT(OUT) :: r_red_grav
580 REAL*8 :: r_alphas(n_solid)
586 IF ( qpj(1) .LE. 0.d0 )
THEN 591 r_alphas(1:n_solid) = 0.d0
595 IF ( gas_flag .AND. liquid_flag ) r_alphal = 0.d0
604 r_alphas(1:n_solid) = qpj(5:4+n_solid)
618 IF ( gas_flag .AND. liquid_flag )
THEN 620 r_alphal = qpj(n_vars)
623 r_rho_m = ( 1.d0 - sum(r_alphas) - r_alphal ) * r_rho_c &
629 r_rho_m = ( 1.d0 - sum(r_alphas) ) * r_rho_c + sum( r_alphas *
rho_s )
637 IF ( ( r_u**2 + r_v**2 ) .GT. 0.d0 )
THEN 639 r_ri = r_red_grav * r_h / ( r_u**2 + r_v**2 )
681 REAL*8,
INTENT(IN) :: qc(n_vars)
682 REAL*8,
INTENT(OUT) :: qp(n_vars+2)
687 REAL*8 :: r_alphas(n_solid)
693 IF ( qc(1) .GT. 0.d0 )
THEN 695 CALL r_phys_var(qc,r_h,r_u,r_v,r_alphas,r_rho_m,r_t,r_alphal)
703 qp(5:4+n_solid) = r_alphas(1:n_solid)
705 IF ( gas_flag .AND. liquid_flag ) qp(n_vars) = r_alphal
755 REAL*8,
INTENT(IN) :: qp(n_vars+2)
756 REAL*8,
INTENT(IN) :: B
757 REAL*8,
INTENT(OUT) :: qc(n_vars)
759 REAL*8 :: r_sp_heat_mix
767 REAL*8 :: r_alphas(n_solid)
775 REAL*8 :: r_xs(n_solid)
779 IF ( r_h .GT. 0.d0 )
THEN 802 r_alphas(1:n_solid) = qp(5:4+n_solid)
818 IF ( gas_flag .AND. liquid_flag )
THEN 821 r_alphal = qp(n_vars)
824 IF ( ( sum(r_alphas) + r_alphal ) .GT. 1.d0 )
THEN 826 sum_sl = sum(r_alphas) + r_alphal
827 r_alphas(1:n_solid) = r_alphas(1:n_solid) / sum_sl
828 r_alphal = r_alphal / sum_sl
830 ELSEIF ( ( sum(r_alphas) + r_alphal ) .LT. 0.d0 )
THEN 832 r_alphas(1:n_solid) = 0.d0
838 r_alphac = 1.d0 - sum(r_alphas) - r_alphal
841 r_rho_m = r_alphac * r_rho_c + sum( r_alphas *
rho_s ) + r_alphal *
rho_l 844 r_xl = r_alphal *
rho_l / r_rho_m
847 r_xs(1:n_solid) = r_alphas(1:n_solid) *
rho_s(1:n_solid) / r_rho_m
850 r_xc = r_alphac * r_rho_c / r_rho_m
860 IF ( sum(r_alphas) .GT. 1.d0 )
THEN 862 r_alphas(1:n_solid) = r_alphas(1:n_solid) / sum(r_alphas)
864 ELSEIF ( sum(r_alphas).LT. 0.d0 )
THEN 866 r_alphas(1:n_solid) = 0.d0
871 r_alphac = 1.d0 - sum(r_alphas)
874 r_rho_m = r_alphac * r_rho_c + sum( r_alphas *
rho_s )
877 r_xs(1:n_solid) = r_alphas(1:n_solid) *
rho_s(1:n_solid) / r_rho_m
880 r_xc = r_alphac * r_rho_c / r_rho_m
887 qc(1) = r_rho_m * r_h
888 qc(2) = r_rho_m * r_hu
889 qc(3) = r_rho_m * r_hv
891 IF ( energy_flag )
THEN 893 IF ( r_h .GT. 0.d0 )
THEN 896 qc(4) = r_h * r_rho_m * ( r_sp_heat_mix * r_t &
897 + 0.5d0 * ( r_hu**2 + r_hv**2 ) / r_h**2 )
908 qc(4) = r_h * r_rho_m * r_sp_heat_mix * r_t
912 qc(5:4+n_solid) = r_h * r_alphas(1:n_solid) *
rho_s(1:n_solid)
914 IF ( gas_flag .AND. liquid_flag ) qc(n_vars) = r_h * r_alphal *
rho_l 937 REAL*8,
INTENT(IN) :: qpj(n_vars)
938 REAL*8,
INTENT(IN) :: Bj
939 REAL*8,
INTENT(OUT) :: qp2j(3)
941 qp2j(1) = qpj(1) + bj
943 IF ( qpj(1) .LE. 0.d0 )
THEN 950 qp2j(2) = qpj(2)/qpj(1)
951 qp2j(3) = qpj(3)/qpj(1)
976 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
978 REAL*8,
INTENT(OUT) :: vel_min(n_vars) , vel_max(n_vars)
988 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
994 IF ( r_red_grav * r_h .LT. 0.d0 )
THEN 996 vel_min(1:n_eqns) = r_u
997 vel_max(1:n_eqns) = r_u
1001 vel_min(1:n_eqns) = r_u - dsqrt( r_red_grav * r_h )
1002 vel_max(1:n_eqns) = r_u + dsqrt( r_red_grav * r_h )
1027 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
1028 REAL*8,
INTENT(OUT) :: vel_min(n_vars) , vel_max(n_vars)
1036 REAL*8 :: r_red_grav
1038 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
1044 IF ( r_red_grav * r_h .LT. 0.d0 )
THEN 1046 vel_min(1:n_eqns) = r_v
1047 vel_max(1:n_eqns) = r_v
1051 vel_min(1:n_eqns) = r_v - dsqrt( r_red_grav * r_h )
1052 vel_max(1:n_eqns) = r_v + dsqrt( r_red_grav * r_h )
1080 REAL*8,
INTENT(IN) :: qcj(n_vars)
1081 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
1082 INTEGER,
INTENT(IN) :: dir
1084 REAL*8,
INTENT(OUT) :: flux(n_eqns)
1092 REAL*8 :: r_red_grav
1094 pos_thick:
IF ( qcj(1) .GT. 0.d0 )
THEN 1100 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
1102 IF ( dir .EQ. 1 )
THEN 1105 flux(1) = r_u * qcj(1)
1108 flux(2) = r_u * qcj(2) + 0.5d0 * r_rho_m * r_red_grav * r_h**2
1111 flux(3) = r_u * qcj(3)
1113 IF ( energy_flag )
THEN 1116 flux(4) = r_u * ( qcj(4) + 0.5d0 * r_rho_m * r_red_grav * r_h**2 )
1121 flux(4) = r_u * qcj(4)
1126 flux(5:4+n_solid) = r_u * qcj(5:4+n_solid)
1129 IF ( ( flux(1) .GT. 0.d0 ) .AND. ( sum(flux(5:4+n_solid)) / flux(1) &
1132 flux(5:4+n_solid) = &
1133 flux(5:4+n_solid) / sum(flux(5:4+n_solid)) * flux(1)
1138 IF ( gas_flag .AND. liquid_flag ) flux(n_vars) = r_u * qcj(n_vars)
1140 ELSEIF ( dir .EQ. 2 )
THEN 1143 flux(1) = r_v * qcj(1)
1145 flux(2) = r_v * qcj(2)
1147 flux(3) = r_v * qcj(3) + 0.5d0 * r_rho_m * r_red_grav * r_h**2
1149 IF ( energy_flag )
THEN 1152 flux(4) = r_v * ( qcj(4) + 0.5d0 * r_rho_m * r_red_grav * r_h**2 )
1157 flux(4) = r_v * qcj(4)
1162 flux(5:4+n_solid) = r_v * qcj(5:4+n_solid)
1165 IF ( ( flux(1) .GT. 0.d0 ) .AND. ( sum(flux(5:4+n_solid)) / flux(1) &
1168 flux(5:4+n_solid) = &
1169 flux(5:4+n_solid) / sum(flux(5:4+n_solid)) * flux(1)
1174 IF ( gas_flag .AND. liquid_flag ) flux(n_vars) = r_v * qcj(n_vars)
1180 flux(1:n_eqns) = 0.d0
1213 COMPLEX*16,
INTENT(IN),
OPTIONAL :: c_qj(n_vars)
1214 COMPLEX*16,
INTENT(OUT),
OPTIONAL :: c_nh_term_impl(n_eqns)
1215 REAL*8,
INTENT(IN),
OPTIONAL :: r_qj(n_vars)
1216 REAL*8,
INTENT(OUT),
OPTIONAL :: r_nh_term_impl(n_eqns)
1223 COMPLEX*16 :: red_grav
1224 COMPLEX*16 :: alphas(n_solid)
1226 COMPLEX*16 :: qj(n_vars)
1227 COMPLEX*16 :: nh_term(n_eqns)
1228 COMPLEX*16 :: forces_term(n_eqns)
1230 COMPLEX*16 :: mod_vel
1232 REAL*8 :: h_threshold
1241 COMPLEX*16 :: expA , expB
1244 COMPLEX*16 :: alpha1
1247 COMPLEX*16 :: fluid_visc
1260 h_threshold = 1.d-10
1268 IF (
present(c_qj) .AND.
present(c_nh_term_impl) )
THEN 1272 ELSEIF (
present(r_qj) .AND.
present(r_nh_term_impl) )
THEN 1276 qj(i) = dcmplx( r_qj(i) )
1282 WRITE(*,*)
'Constitutive, eval_fluxes: problem with arguments' 1288 forces_term(1:n_eqns) = dcmplx(0.d0,0.d0)
1290 IF (rheology_flag)
THEN 1292 CALL c_phys_var(qj,h,u,v,t,rho_m,red_grav,alphas)
1294 mod_vel = cdsqrt( u**2 + v**2 )
1297 IF ( rheology_model .EQ. 1 )
THEN 1299 IF ( dble(mod_vel) .NE. 0.d0 )
THEN 1302 forces_term(2) = forces_term(2) - rho_m * ( u / mod_vel ) * &
1303 (
grav /
xi ) * mod_vel ** 2
1305 forces_term(3) = forces_term(3) - rho_m * ( v / mod_vel ) * &
1306 (
grav /
xi ) * mod_vel ** 2
1311 ELSEIF ( rheology_model .EQ. 2 )
THEN 1313 IF ( dble(mod_vel) .NE. 0.d0 )
THEN 1315 forces_term(2) = forces_term(2) - rho_m *
tau * (u/mod_vel)
1317 forces_term(3) = forces_term(3) - rho_m *
tau * (v/mod_vel)
1322 ELSEIF ( rheology_model .EQ. 3 )
THEN 1324 IF ( dble(h) .GT. h_threshold )
THEN 1337 IF ( dble(mod_vel) .NE. 0.d0 )
THEN 1340 forces_term(2) = forces_term(2) - rho_m * gamma * u
1343 forces_term(3) = forces_term(3) - rho_m * gamma * v
1348 ELSEIF ( rheology_model .EQ. 4 )
THEN 1354 h_threshold = 1.d-20
1365 IF ( tc .LT. 20.d0 )
THEN 1367 expa = 1301.d0 / ( 998.333d0 + 8.1855d0 * ( tc - 20.d0 ) &
1368 + 0.00585d0 * ( tc - 20.d0 )**2 ) - 1.30223d0
1374 expb = ( 1.3272d0 * ( 20.d0 - tc ) - 0.001053d0 * &
1375 ( tc - 20.d0 )**2 ) / ( tc + 105.0d0 )
1382 fluid_visc = alpha1 * cdexp(
beta1 * sum(alphas) )
1384 IF ( dble(h) .GT. h_threshold )
THEN 1387 s_v =
kappa * fluid_visc * mod_vel / ( 8.d0 * rho_m *
grav *h**2 )
1390 s_td =
n_td**2 * mod_vel**2 / ( h**(4.d0/3.d0) )
1395 s_v =
kappa * fluid_visc * mod_vel / ( 8.d0 * h_threshold**2 )
1398 s_td =
n_td**2 * (mod_vel**2) / ( h_threshold**(4.d0/3.d0) )
1405 IF ( mod_vel .GT. 0.d0 )
THEN 1408 forces_term(2) = forces_term(2) -
grav * rho_m * h * &
1409 ( u / mod_vel ) * s_f
1412 forces_term(3) = forces_term(3) -
grav * rho_m * h * &
1413 ( v / mod_vel ) * s_f
1417 ELSEIF ( rheology_model .EQ. 5 )
THEN 1419 tau = 1.d-3 / ( 1.d0 + 10.d0 * h ) * mod_vel
1421 IF ( dble(mod_vel) .NE. 0.d0 )
THEN 1423 forces_term(2) = forces_term(2) - rho_m *
tau * ( u / mod_vel )
1424 forces_term(3) = forces_term(3) - rho_m *
tau * ( v / mod_vel )
1429 ELSEIF ( rheology_model .EQ. 6 )
THEN 1431 IF ( dble(mod_vel) .NE. 0.d0 )
THEN 1433 forces_term(2) = forces_term(2) - rho_m * ( u / mod_vel ) * &
1436 forces_term(3) = forces_term(3) - rho_m * ( v / mod_vel ) * &
1445 nh_term = forces_term
1447 IF (
present(c_qj) .AND.
present(c_nh_term_impl) )
THEN 1449 c_nh_term_impl = nh_term
1451 ELSEIF (
present(r_qj) .AND.
present(r_nh_term_impl) )
THEN 1453 r_nh_term_impl = dble( nh_term )
1481 REAL*8,
INTENT(IN) :: grav3_surf
1483 REAL*8,
INTENT(IN) :: qcj(n_vars)
1484 REAL*8,
INTENT(OUT) :: nh_semi_impl_term(n_eqns)
1486 REAL*8 :: forces_term(n_eqns)
1490 REAL*8 :: h_threshold
1501 REAL*8 :: r_alphas(n_solid)
1508 forces_term(1:n_eqns) = 0.d0
1510 IF (rheology_flag)
THEN 1512 CALL r_phys_var(qcj,r_h,r_u,r_v,r_alphas,r_rho_m,r_t,r_alphal)
1514 mod_vel = dsqrt( r_u**2 + r_v**2 )
1517 IF ( rheology_model .EQ. 1 )
THEN 1519 IF ( mod_vel .GT. 0.d0 )
THEN 1522 forces_term(2) = forces_term(2) - r_rho_m * ( r_u / mod_vel ) * &
1523 mu * r_h * ( -
grav * grav3_surf )
1526 forces_term(3) = forces_term(3) - r_rho_m * ( r_v / mod_vel ) * &
1527 mu * r_h * ( -
grav * grav3_surf )
1532 ELSEIF ( rheology_model .EQ. 2 )
THEN 1536 ELSEIF ( rheology_model .EQ. 3 )
THEN 1540 ELSEIF ( rheology_model .EQ. 4 )
THEN 1542 h_threshold = 1.d-20
1547 IF ( r_h .GT. h_threshold )
THEN 1550 s_y = tau_y / (
grav * r_rho_m * r_h )
1555 s_y = tau_y / (
grav * r_rho_m * h_threshold )
1559 IF ( mod_vel .GT. 0.d0 )
THEN 1562 forces_term(2) = forces_term(2) -
grav * r_rho_m * r_h * &
1563 ( r_u / mod_vel ) * s_y
1566 forces_term(3) = forces_term(3) -
grav * r_rho_m * r_h * &
1567 ( r_v / mod_vel ) * s_y
1571 ELSEIF ( rheology_model .EQ. 5 )
THEN 1577 nh_semi_impl_term = forces_term
1602 SUBROUTINE eval_expl_terms( Bprimej_x , Bprimej_y , source_xy , qpj , qcj , &
1607 REAL*8,
INTENT(IN) :: Bprimej_x
1608 REAL*8,
INTENT(IN) :: Bprimej_y
1609 REAL*8,
INTENT(IN) :: source_xy
1611 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
1612 REAL*8,
INTENT(IN) :: qcj(n_vars)
1613 REAL*8,
INTENT(OUT) :: expl_term(n_eqns)
1621 REAL*8 :: r_red_grav
1623 expl_term(1:n_eqns) = 0.d0
1625 IF ( qpj(1) .LE. 0.d0 )
RETURN 1631 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
1633 expl_term(2) = r_red_grav * r_rho_m * r_h * bprimej_x
1635 expl_term(3) = r_red_grav * r_rho_m * r_h * bprimej_y
1637 IF ( energy_flag )
THEN 1639 expl_term(4) = r_red_grav * r_rho_m * r_h * ( r_u * bprimej_x &
1671 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
1672 REAL*8,
INTENT(IN) :: dt
1674 REAL*8,
INTENT(OUT) :: erosion_term(n_solid)
1675 REAL*8,
INTENT(OUT) :: deposition_term(n_solid)
1687 REAL*8 :: r_alphas(n_solid)
1691 REAL*8 :: r_red_grav
1698 deposition_term(1:n_solid) = 0.d0
1699 erosion_term(1:n_solid) = 0.d0
1701 IF ( qpj(1) .LE. 0.d0 )
RETURN 1706 r_alphas(1:n_solid) = qpj(5:4+n_solid)
1708 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
1710 DO i_solid=1,n_solid
1712 IF ( ( r_alphas(i_solid) .GT. 0.d0 ) .AND. (
settling_flag ) )
THEN 1717 deposition_term(i_solid) = r_alphas(i_solid) *
settling_vel * &
1718 ( 1.d0 - min( 1.d0 , sum( r_alphas ) / alpha_max ) )**hind_exp
1720 deposition_term(i_solid) = min( deposition_term(i_solid) , &
1721 r_h * r_alphas(i_solid) / dt )
1723 IF ( deposition_term(i_solid) .LT. 0.d0 )
THEN 1725 WRITE(*,*)
'eval_erosion_dep_term' 1726 WRITE(*,*)
'deposition_term(i_solid)',deposition_term(i_solid)
1733 mod_vel = dsqrt( r_u**2 + r_v**2 )
1735 IF ( r_h .GT. 1.d-2)
THEN 1740 erosion_term(i_solid) =
erosion_coeff(i_solid) * mod_vel * r_h &
1741 * ( 1.d0 - sum(r_alphas) )
1745 erosion_term(i_solid) = 0.d0
1772 SUBROUTINE eval_topo_term( qpj , deposition_avg_term , erosion_avg_term , &
1773 eqns_term, deposit_term )
1777 REAL*8,
INTENT(IN) :: qpj(n_vars+2)
1778 REAL*8,
INTENT(IN) :: deposition_avg_term(n_solid)
1779 REAL*8,
INTENT(IN) :: erosion_avg_term(n_solid)
1781 REAL*8,
INTENT(OUT):: eqns_term(n_eqns)
1782 REAL*8,
INTENT(OUT):: deposit_term(n_solid)
1784 REAL*8 :: entr_coeff
1795 REAL*8 :: r_red_grav
1798 IF ( qpj(1) .LE. 0.d0 )
THEN 1800 eqns_term(1:n_eqns) = 0.d0
1801 deposit_term(1:n_solid) = 0.d0
1807 CALL mixt_var(qpj,r_ri,r_rho_m,r_rho_c,r_red_grav)
1814 mag_vel = dsqrt( r_u**2.d0 + r_v**2.d0 )
1817 ( r_h .GT. 0.d0 ) )
THEN 1819 entr_coeff = 0.075d0 / dsqrt( 1.d0 + 718.d0 * max(0.d0,r_ri)**2.4 )
1821 air_entr = entr_coeff * mag_vel
1829 eqns_term(1:n_eqns) = 0.d0
1832 eqns_term(1) = sum(
rho_s * ( erosion_avg_term - deposition_avg_term ) ) + &
1836 eqns_term(2) = - r_u * sum(
rho_s * deposition_avg_term )
1839 eqns_term(3) = - r_v * sum(
rho_s * deposition_avg_term )
1842 IF ( energy_flag )
THEN 1844 eqns_term(4) = - r_t * sum(
rho_s *
sp_heat_s * deposition_avg_term ) &
1845 - 0.5d0 * mag_vel**2 * sum(
rho_s * deposition_avg_term ) &
1851 eqns_term(4) = - r_t * sum(
rho_s *
sp_heat_s * deposition_avg_term ) &
1858 eqns_term(5:4+n_solid) =
rho_s(1:n_solid) * ( erosion_avg_term(1:n_solid) &
1859 - deposition_avg_term(1:n_solid) )
1862 deposit_term(1:n_solid) = deposition_avg_term(1:n_solid) &
1863 - erosion_avg_term(1:n_solid)
1894 REAL*8,
INTENT(IN) :: time
1895 REAL*8,
INTENT(IN) :: vect_x
1896 REAL*8,
INTENT(IN) :: vect_y
1897 REAL*8,
INTENT(OUT) :: source_bdry(n_vars)
1906 source_bdry(1) = 0.d0
1907 source_bdry(2) = 0.d0
1908 source_bdry(3) = 0.d0
1912 IF ( gas_flag .AND. liquid_flag )
THEN 1918 source_bdry(n_vars+1) = 0.d0
1919 source_bdry(n_vars+2) = 0.d0
1927 pi_g = 4.d0 * datan(1.d0)
1933 IF ( t_rem .LE.
time_param(2) ) t_coeff = 1.d0
1939 t_coeff = 0.5d0 * ( 1.d0 - dcos( pi_g * t_rem /
time_param(3) ) )
1947 t_coeff = 0.5d0 * ( 1.d0 + dcos( pi_g * ( ( t_rem -
time_param(2) ) &
1955 source_bdry(1) = t_coeff *
h_source 1961 IF ( gas_flag .AND. liquid_flag )
THEN 1967 source_bdry(n_vars+1) = t_coeff**0.5d0 *
vel_source * vect_x
1968 source_bdry(n_vars+2) = t_coeff**0.5d0 *
vel_source * vect_y
1994 REAL*8,
INTENT(IN) :: diam
1995 REAL*8,
INTENT(IN) :: rhos
1996 REAL*8,
INTENT(IN) :: rhoc
1997 INTEGER,
INTENT(IN) :: i_solid
2004 REAL*8 :: const_part
2006 REAL*8 :: set_vel_old
2012 const_part = dsqrt( 0.75d0 * ( rhos / rhoc - 1.d0 ) * diam *
grav )
2018 IF ( rey .LE. 1000.d0 )
THEN 2024 c_d = 24.d0 / rey * ( 1.d0 + 0.15d0 * rey**(0.687) )
2032 dig = floor(log10(set_vel_old))
2034 * floor( 10.0**(-dig+3)*set_vel_old )
real *8 kin_visc_a
Kinematic viscosity of air (units: m2 s-1)
real *8 emissivity
emissivity (eps in Costa & Macedonio, 2005)
subroutine r_phys_var(r_qj, r_h, r_u, r_v, r_alphas, r_rho_m, r_T, r_alphal)
Physical variables.
real *8 sp_heat_l
Sepcific heat of liquid (units: J K-1 kg-1)
real *8 nu_ref
reference kinematic viscosity [m2/s]
real *8 t_ground
temperature of lava-ground interface
subroutine eval_local_speeds_x(qpj, vel_min, vel_max)
Local Characteristic speeds x direction.
real *8 beta2
2nd param for yield strenght empirical relationship (O'Brian et al, 1993)
real *8, parameter sbconst
Stephan-Boltzmann constant [W m-2 K-4].
logical rheology_flag
Flag to choose if we add the rheology.
subroutine mixt_var(qpj, r_Ri, r_rho_m, r_rho_c, r_red_grav)
Physical variables.
logical entrainment_flag
flag to activate air entrainment
real *8 rad_coeff
radiative coefficient
real *8 c_p
specific heat [J kg-1 K-1]
subroutine c_phys_var(c_qj, h, u, v, T, rho_m, red_grav, alphas)
Physical variables.
subroutine qp_to_qp2(qpj, Bj, qp2j)
Additional Physical variables.
real *8 kin_visc_l
Kinematic viscosity of liquid (units: m2 s-1)
integer rheology_model
choice of the rheology model
real *8 sp_gas_const_a
Specific gas constant of air (units: J kg-1 K-1)
real *8 thermal_conductivity
thermal conductivity [W m-1 K-1] (k in Costa & Macedonio, 2005)
real *8 t_s_substrate
temperature of solid substrate (units: K)
real *8 sp_heat_a
Specific heat of air (units: J K-1 kg-1)
subroutine eval_nh_semi_impl_terms(grav3_surf, qcj, nh_semi_impl_term)
Non-Hyperbolic semi-implicit terms.
real *8 beta1
2nd param for fluid viscosity empirical relationship (O'Brian et al, 1993)
real *8 kin_visc_c
Kinematic viscosity of carrier phase (units: m2 s-1)
real *8, dimension(4) time_param
integer n_vars
Number of conservative variables.
real *8, dimension(:), allocatable alphas_source
real *8 sp_heat_c
Specific heat of carrier phase (gas or liquid)
subroutine eval_expl_terms(Bprimej_x, Bprimej_y, source_xy, qpj, qcj, expl_term)
Explicit Forces term.
real *8 enne
thermal boundary layer fraction of total thickness
subroutine eval_fluxes(qcj, qpj, dir, flux)
Hyperbolic Fluxes.
real *8 grav
gravitational acceleration
real *8 mu
drag coefficients (Voellmy-Salm model)
real *8 visc_par
viscosity parameter [K-1] (b in Table 1 Costa & Macedonio, 2005)
real *8 alpha1_coeff
ratio between reference value from input and computed values from eq.
logical, dimension(:), allocatable implicit_flag
flag used for size of implicit non linear-system
real *8, dimension(:), allocatable diam_s
Diameter of sediments ( units: m )
real *8 n_td
Mannings roughness coefficient ( units: T L^(-1/3) )
real *8, dimension(:), allocatable erosion_coeff
erosion model coefficient (units: m-1 )
logical settling_flag
Flag to determine if sedimentation is active.
subroutine eval_source_bdry(time, vect_x, vect_y, source_bdry)
Internal boundary source fluxes.
real *8 rho_l
liquid density (units: kg m-3)
subroutine eval_local_speeds_y(qpj, vel_min, vel_max)
Local Characteristic speeds y direction.
subroutine init_problem_param
Initialization of relaxation flags.
real *8 t_env
evironment temperature [K]
real *8 alpha2
1st param for yield strenght empirical relationship (O'Brian et al, 1993)
subroutine eval_erosion_dep_term(qpj, dt, erosion_term, deposition_term)
Erosion/Deposition term.
real *8 atm_heat_transf_coeff
atmospheric heat trasnfer coefficient [W m-2 K-1] (lambda in C&M, 2005)
real *8 settling_vel
Hindered settling velocity (units: m s-1 )
real *8 rho_a_amb
Ambient density of air ( units: kg m-3 )
real *8 pres
ambient pressure (units: Pa)
real *8 t_ref
reference temperature [K]
subroutine qc_to_qp(qc, qp)
Conservative to physical variables.
logical energy_flag
Flag to choose the equation for temperature to solve.
real *8 exp_area_fract
fractional area of the exposed inner core (f in C&M, 2005)
real *8, dimension(:), allocatable sp_heat_s
Specific heat of solids (units: J K-1 kg-1)
integer n_eqns
Number of equations.
subroutine qp_to_qc(qp, B, qc)
Physical to conservative variables.
real *8 t_ambient
Temperature of ambient air (units: K)
subroutine eval_nonhyperbolic_terms(c_qj, c_nh_term_impl, r_qj, r_nh_term_impl)
Non-Hyperbolic terms.
real *8 emme
velocity boundary layer fraction of total thickness
real *8 eps_sing
parameter for desingularization
real *8 tau
drag coefficients (plastic model)
real *8 friction_factor
drag coefficients (B&W model)
real *8 frict_coeff
friction coefficient
real *8 kappa
Empirical resistance parameter (dimensionless, input parameter)
integer n_solid
Number of solid classes.
real *8, dimension(:), allocatable rho_s
Density of sediments ( units: kg m-3 )
subroutine eval_topo_term(qpj, deposition_avg_term, erosion_avg_term, eqns_term, deposit_term)
Topography modification related term.
integer n_nh
Number of non-hyperbolic terms.
real *8 function settling_velocity(diam, rhos, rhoc, i_solid)
Settling velocity function.
real *8, dimension(:), allocatable sed_vol_perc