| [2888] | 1 | module ice_table_mod |
|---|
| 2 | |
|---|
| 3 | implicit none |
|---|
| 4 | |
|---|
| 5 | contains |
|---|
| 6 | |
|---|
| 7 | |
|---|
| 8 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 9 | !!! |
|---|
| 10 | !!! Purpose: Compute the ice table in two ways: dynamic and at equilibrium |
|---|
| 11 | !!! Author: LL, 02/2023 |
|---|
| 12 | !!! |
|---|
| 13 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 14 | |
|---|
| 15 | |
|---|
| 16 | |
|---|
| 17 | SUBROUTINE computeice_table_equilibrium(ngrid,nslope,nsoil_PEM,watercaptag,rhowatersurf_ave,rhowatersoil_ave,ice_table) |
|---|
| 18 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 19 | !!! |
|---|
| 20 | !!! Purpose: Compute the ice table depth knowing the yearly average water |
|---|
| 21 | !!! density at the surface and at depth. |
|---|
| 22 | !!! Computations are made following the methods in Schorgofer et al., 2005 |
|---|
| 23 | !!! This subroutine only gives the ice table at equilibrium and does not consider exchange with the atmosphere |
|---|
| 24 | !!! |
|---|
| 25 | !!! Author: LL |
|---|
| 26 | !!! |
|---|
| 27 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 28 | |
|---|
| 29 | #ifndef CPP_STD |
|---|
| 30 | USE comsoil_h_PEM, only: layer_PEM ! Depth of the vertical grid |
|---|
| 31 | implicit none |
|---|
| 32 | |
|---|
| 33 | integer,intent(in) :: ngrid,nslope,nsoil_PEM ! Size of the physical grid, number of subslope, number of soil layer in the PEM |
|---|
| 34 | logical,intent(in) :: watercaptag(ngrid) ! Boolean to check the presence of a perennial glacier |
|---|
| 35 | real,intent(in) :: rhowatersurf_ave(ngrid,nslope) ! Water density at the surface, yearly averaged [kg/m^3] |
|---|
| 36 | real,intent(in) :: rhowatersoil_ave(ngrid,nsoil_PEM,nslope) ! Water density at depth, computed from clapeyron law's (Murchy and Koop 2005), yearly averaged [kg/m^3] |
|---|
| 37 | real,intent(inout) :: ice_table(ngrid,nslope) ! ice table depth [m] |
|---|
| 38 | real :: z1,z2 ! intermediate variables used when doing a linear interpolation between two depths to find the root |
|---|
| 39 | integer ig, islope,isoil ! loop variables |
|---|
| 40 | real :: diff_rho(nsoil_PEM) ! difference of water vapor density between the surface and at depth [kg/m^3] |
|---|
| 41 | |
|---|
| 42 | |
|---|
| 43 | do ig = 1,ngrid |
|---|
| 44 | if(watercaptag(ig)) then |
|---|
| 45 | ice_table(ig,:) = 0. |
|---|
| 46 | else |
|---|
| 47 | do islope = 1,nslope |
|---|
| 48 | ice_table(ig,islope) = -10. |
|---|
| 49 | |
|---|
| 50 | do isoil = 1,nsoil_PEM |
|---|
| 51 | diff_rho(isoil) = rhowatersurf_ave(ig,islope) - rhowatersoil_ave(ig,isoil,islope) |
|---|
| 52 | |
|---|
| 53 | enddo |
|---|
| 54 | if(diff_rho(1) > 0) then ! ice is at the surface |
|---|
| 55 | ice_table(ig,islope) = 0. |
|---|
| 56 | else |
|---|
| 57 | do isoil = 1,nsoil_PEM -1 ! general case, we find the ice table depth by doing a linear approximation between the two depth, and then solve the first degree equation to find the root |
|---|
| 58 | if((diff_rho(isoil).lt.0).and.(diff_rho(isoil+1).gt.0.)) then |
|---|
| 59 | z1 = (diff_rho(isoil) - diff_rho(isoil+1))/(layer_PEM(isoil) - layer_PEM(isoil+1)) |
|---|
| 60 | z2 = -layer_PEM(isoil+1)*z1 + diff_rho(isoil+1) |
|---|
| 61 | ice_table(ig,islope) = -z2/z1 |
|---|
| 62 | exit |
|---|
| 63 | endif !diff_rho(z) <0 & diff_rho(z+1) > 0 |
|---|
| 64 | enddo |
|---|
| 65 | endif ! diff_rho(1) > 0 |
|---|
| 66 | enddo |
|---|
| 67 | endif ! watercaptag |
|---|
| 68 | enddo |
|---|
| 69 | !======================================================================= |
|---|
| 70 | RETURN |
|---|
| 71 | #endif |
|---|
| 72 | END |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | |
|---|
| 76 | end module |
|---|
