| [2849] | 1 | SUBROUTINE computeice_table(ngrid,nslope,nsoil_PEM,rhowatersurf_ave,rhowatersoil_ave,ice_table) |
|---|
| [2855] | 2 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 3 | !!! |
|---|
| 4 | !!! Purpose: Compute the ice table depth knowing the yearly average water |
|---|
| 5 | !!! density at the surface and at depth. |
|---|
| 6 | !!! Computations are made following the methods in Schorgofer et al., 2005 |
|---|
| 7 | !!! |
|---|
| 8 | !!! Author: LL |
|---|
| 9 | !!! |
|---|
| 10 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 11 | |
|---|
| [2842] | 12 | #ifndef CPP_STD |
|---|
| [2855] | 13 | USE comsoil_h_PEM, only: layer_PEM ! Depth of the vertical grid |
|---|
| [2794] | 14 | implicit none |
|---|
| 15 | |
|---|
| [2855] | 16 | integer,intent(in) :: ngrid,nslope,nsoil_PEM ! Size of the physical grid, number of subslope, number of soil layer in the PEM |
|---|
| 17 | real,intent(in) :: rhowatersurf_ave(ngrid,nslope) ! Water density at the surface, yearly averaged [kg/m^3] |
|---|
| 18 | 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] |
|---|
| 19 | real,intent(inout) :: ice_table(ngrid,nslope) ! ice table depth [m] |
|---|
| 20 | real :: z1,z2 ! intermediate variables used when doing a linear interpolation between two depths to find the root |
|---|
| 21 | integer ig, islope,isoil ! loop variables |
|---|
| 22 | real :: diff_rho(nsoil_PEM) ! difference of water vapor density between the surface and at depth [kg/m^3] |
|---|
| [2794] | 23 | |
|---|
| 24 | |
|---|
| 25 | do ig = 1,ngrid |
|---|
| [2849] | 26 | do islope = 1,nslope |
|---|
| 27 | ice_table(ig,islope) = -10. |
|---|
| [2794] | 28 | |
|---|
| 29 | do isoil = 1,nsoil_PEM |
|---|
| [2849] | 30 | diff_rho(isoil) = rhowatersurf_ave(ig,islope) - rhowatersoil_ave(ig,isoil,islope) |
|---|
| [2794] | 31 | |
|---|
| 32 | enddo |
|---|
| [2888] | 33 | if (ig.eq.400) then |
|---|
| 34 | write(*,*) 'ig,islope,diff',ig,islope,diff_rho(:) |
|---|
| 35 | write(*,*) 'rho surf',rhowatersurf_ave(ig,islope) |
|---|
| 36 | write(*,*) 'rho soil',rhowatersoil_ave(ig,:,islope) |
|---|
| 37 | endif |
|---|
| [2855] | 38 | if(diff_rho(1) > 0) then ! ice is at the surface |
|---|
| [2794] | 39 | ice_table(ig,islope) = 0. |
|---|
| 40 | else |
|---|
| [2855] | 41 | 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 |
|---|
| [2849] | 42 | if((diff_rho(isoil).lt.0).and.(diff_rho(isoil+1).gt.0.)) then |
|---|
| 43 | z1 = (diff_rho(isoil) - diff_rho(isoil+1))/(layer_PEM(isoil) - layer_PEM(isoil+1)) |
|---|
| 44 | z2 = -layer_PEM(isoil+1)*z1 + diff_rho(isoil+1) |
|---|
| [2794] | 45 | ice_table(ig,islope) = -z2/z1 |
|---|
| 46 | exit |
|---|
| 47 | endif |
|---|
| 48 | enddo |
|---|
| 49 | endif |
|---|
| 50 | enddo |
|---|
| 51 | enddo |
|---|
| 52 | !======================================================================= |
|---|
| 53 | RETURN |
|---|
| [2842] | 54 | #endif |
|---|
| [2794] | 55 | END |
|---|
