Changeset 3525 for trunk/LMDZ.COMMON/libf
- Timestamp:
- Nov 19, 2024, 5:44:27 PM (2 days ago)
- Location:
- trunk/LMDZ.COMMON/libf/evolution
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/evolution/changelog.txt
r3518 r3525 489 489 == 14/11/2024 == JBC 490 490 Committing the right correction in previous commit (r3516) would have been better... 491 492 == 19/11/2024 == JBC 493 Computation of <soil thermal intertia> and <H2O mass subsurface/surface exchange> according to the presence of subsurface ice provided by the (Norbert's) dynamic method + few cleanings. -
trunk/LMDZ.COMMON/libf/evolution/compute_soiltemp_mod.F90
r3178 r3525 90 90 endif ! of if (firstcall) 91 91 92 IF(.not. firstcall) THEN92 if (.not. firstcall) THEN 93 93 ! 2. Compute soil temperatures 94 94 ! First layer: … … 120 120 END SUBROUTINE compute_tsoil_pem 121 121 122 122 !======================================================================= 123 123 124 124 SUBROUTINE ini_tsoil_pem(ngrid,nsoil,therm_i,tsurf,tsoil) … … 221 221 END SUBROUTINE ini_tsoil_pem 222 222 223 224 225 223 END MODULE compute_soiltemp_mod -
trunk/LMDZ.COMMON/libf/evolution/ice_table_mod.F90
r3512 r3525 18 18 !----------------------------------------------------------------------- 19 19 contains 20 20 21 !----------------------------------------------------------------------- 21 22 SUBROUTINE ini_ice_table(ngrid,nslope,nsoil) … … 45 46 46 47 !------------------------------------------------------------------------------------------------------ 47 SUBROUTINE computeice_table_equilibrium(ngrid,nslope,nsoil _PEM,watercaptag,rhowatersurf_ave,rhowatersoil_ave,regolith_inertia,ice_table_beg,ice_table_thickness)48 SUBROUTINE computeice_table_equilibrium(ngrid,nslope,nsoil,watercaptag,rhowatersurf_ave,rhowatersoil_ave,regolith_inertia,ice_table_beg,ice_table_thickness) 48 49 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 49 50 !!! … … 51 52 !!! density at the surface and at depth. 52 53 !!! Computations are made following the methods in Schorgofer et al., 2005 53 !!! This SUBROUTINEonly gives the ice table at equilibrium and does not consider exchange with the atmosphere54 !!! This subroutine only gives the ice table at equilibrium and does not consider exchange with the atmosphere 54 55 !!! 55 56 !!! Author: LL … … 64 65 ! Inputs 65 66 ! ------ 66 integer, intent(in) :: ngrid, nslope, nsoil_PEM! Size of the physical grid, number of subslope, number of soil layer in the PEM67 logical, dimension(ngrid), intent(in) :: watercaptag! Boolean to check the presence of a perennial glacier68 real, dimension(ngrid,nslope), intent(in) :: rhowatersurf_ave! Water density at the surface, yearly averaged [kg/m^3]69 real, dimension(ngrid,nsoil _PEM,nslope), intent(in) :: rhowatersoil_ave ! Water density at depth, computed from clapeyron law's (Murchy and Koop 2005), yearly averaged[kg/m^3]70 real, dimension(ngrid,nslope), intent(in) :: regolith_inertia! Thermal inertia of the regolith layer [SI]67 integer, intent(in) :: ngrid, nslope, nsoil ! Size of the physical grid, number of subslope, number of soil layer in the PEM 68 logical, dimension(ngrid), intent(in) :: watercaptag ! Boolean to check the presence of a perennial glacier 69 real, dimension(ngrid,nslope), intent(in) :: rhowatersurf_ave ! Water density at the surface, yearly averaged [kg/m^3] 70 real, dimension(ngrid,nsoil,nslope), intent(in) :: rhowatersoil_ave ! Water density at depth, computed from clapeyron law's (Murchy and Koop 2005), yearly averaged [kg/m^3] 71 real, dimension(ngrid,nslope), intent(in) :: regolith_inertia ! Thermal inertia of the regolith layer [SI] 71 72 ! Ouputs 72 73 ! ------ … … 76 77 ! ------ 77 78 integer :: ig, islope, isoil, isoilend ! loop variables 78 real, dimension(nsoil _PEM):: diff_rho ! difference of water vapor density between the surface and at depth [kg/m^3]79 real, dimension(nsoil) :: diff_rho ! difference of water vapor density between the surface and at depth [kg/m^3] 79 80 real :: ice_table_end ! depth of the end of the ice table [m] 80 81 real, dimension(ngrid,nslope) :: previous_icetable_depth ! Ice table computed at previous ice depth [m] … … 87 88 if (watercaptag(ig)) then 88 89 ice_table_beg(ig,:) = 0. 89 ice_table_thickness(ig,:) = layer_PEM(nsoil _PEM) ! Let's assume an infinite ice table (true when geothermal flux is set to 0.)90 ice_table_thickness(ig,:) = layer_PEM(nsoil) ! Let's assume an infinite ice table (true when geothermal flux is set to 0.) 90 91 else 91 92 do islope = 1,nslope 92 93 ice_table_beg(ig,islope) = -1. 93 94 ice_table_thickness(ig,islope) = 0. 94 do isoil = 1,nsoil _PEM95 do isoil = 1,nsoil 95 96 diff_rho(isoil) = rhowatersurf_ave(ig,islope) - rhowatersoil_ave(ig,isoil,islope) 96 97 enddo 97 98 if (diff_rho(1) > 0) then ! ice is at the surface 98 99 ice_table_beg(ig,islope) = 0. 99 do isoilend = 2,nsoil _PEM- 1100 do isoilend = 2,nsoil - 1 100 101 if (diff_rho(isoilend) > 0 .and. diff_rho(isoilend + 1) < 0.) then 101 102 call findroot(diff_rho(isoilend),diff_rho(isoilend + 1),mlayer_PEM(isoilend),mlayer_PEM(isoilend + 1),ice_table_end) … … 105 106 enddo 106 107 else 107 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 root108 do isoil = 1,nsoil - 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 108 109 if (diff_rho(isoil) < 0 .and. diff_rho(isoil + 1) > 0.) then 109 110 call findroot(diff_rho(isoil),diff_rho(isoil + 1),mlayer_PEM(isoil),mlayer_PEM(isoil + 1),ice_table_beg(ig,islope)) 110 111 ! Now let's find the end of the ice table 111 ice_table_thickness(ig,islope) = layer_PEM(nsoil _PEM) ! Let's assume an infinite ice table (true when geothermal flux is set to 0.)112 do isoilend = isoil + 1,nsoil _PEM- 1112 ice_table_thickness(ig,islope) = layer_PEM(nsoil) ! Let's assume an infinite ice table (true when geothermal flux is set to 0.) 113 do isoilend = isoil + 1,nsoil - 1 113 114 if (diff_rho(isoilend) > 0 .and. diff_rho(isoilend + 1) < 0.) then 114 115 call findroot(diff_rho(isoilend),diff_rho(isoilend + 1),mlayer_PEM(isoilend),mlayer_PEM(isoilend + 1),ice_table_end) … … 140 141 141 142 !----------------------------------------------------------------------- 142 SUBROUTINE compute_massh2o_exchange_ssi(ngrid,nslope,nsoil _PEM,former_ice_table_thickness,new_ice_table_thickness,ice_table_depth,tsurf,tsoil,delta_m_h2o)143 SUBROUTINE compute_massh2o_exchange_ssi(ngrid,nslope,nsoil,icetable_thickness_old,ice_porefilling_old,tsurf,tsoil,delta_m_h2o) 143 144 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 144 145 !!! … … 161 162 ! Inputs 162 163 ! ------ 163 integer, intent(in) :: ngrid, nslope, nsoil_PEM ! Size of the physical grid, number of subslope, number of soil layer in the PEM 164 real, dimension(ngrid,nslope), intent(in) :: former_ice_table_thickness ! ice table thickness at the former iteration [m] 165 real, dimension(ngrid,nslope), intent(in) :: new_ice_table_thickness ! ice table thickness at the current iteration [m] 166 real, dimension(ngrid,nslope), intent(in) :: ice_table_depth ! ice table depth [m] 167 real, dimension(ngrid,nslope), intent(in) :: tsurf ! Surface temperature [K] 168 real, dimension(ngrid,nsoil_PEM,nslope), intent(in) :: tsoil ! Soil temperature [K] 164 integer, intent(in) :: ngrid, nslope, nsoil ! Size of the physical grid, number of subslope, number of soil layer in the PEM 165 real, dimension(ngrid,nslope), intent(in) :: icetable_thickness_old ! Ice table thickness at the previous iteration [m] 166 real, dimension(ngrid,nsoil,nslope), intent(in) :: ice_porefilling_old ! Ice pore filling at the previous iteration [m] 167 real, dimension(ngrid,nslope), intent(in) :: tsurf ! Surface temperature [K] 168 real, dimension(ngrid,nsoil,nslope), intent(in) :: tsoil ! Soil temperature [K] 169 169 ! Outputs 170 170 ! ------- … … 172 172 ! Locals 173 173 !------- 174 integer :: ig, islope, ilay, iref! loop index175 real , dimension(ngrid,nslope) :: rho! density of water ice [kg/m^3]176 real , dimension(ngrid,nslope) :: Tice! ice temperature [k]174 integer :: ig, islope, isoil ! loop index 175 real :: rho ! density of water ice [kg/m^3] 176 real :: Tice ! ice temperature [k] 177 177 ! Code 178 178 ! ---- 179 rho = 0. 180 Tice = 0. 181 !1. First let's compute Tice using a linear interpolation between the mlayer level 182 do ig = 1,ngrid 183 do islope = 1,nslope 184 call compute_Tice_pem(nsoil_PEM,tsoil(ig,:,islope),tsurf(ig,islope),ice_table_depth(ig,islope),Tice(ig,islope)) 185 rho(ig,islope) = -3.5353e-4*Tice(ig,islope)**2 + 0.0351* Tice(ig,islope) + 933.5030 ! Rottgers, 2012 186 enddo 187 enddo 188 189 !2. Let's compute the amount of ice that has sublimated in each subslope 190 do ig = 1,ngrid 191 do islope = 1,nslope 192 delta_m_h2o(ig) = delta_m_h2o(ig) + porosity*rho(ig,islope)*(new_ice_table_thickness(ig,islope) - former_ice_table_thickness(ig,islope)) & ! convention > 0. <=> it condenses 193 *subslope_dist(ig,islope)/cos(def_slope_mean(islope)*pi/180.) 194 enddo 195 enddo 179 180 ! Let's compute the amount of ice that has sublimated in each subslope 181 if (icetable_equilibrium) then 182 delta_m_h2o = 0. 183 do ig = 1,ngrid 184 do islope = 1,nslope 185 call compute_Tice_pem(nsoil,tsoil(ig,:,islope),tsurf(ig,islope),icetable_depth(ig,islope),Tice) 186 rho = -3.5353e-4*Tice**2 + 0.0351*Tice + 933.5030 ! Rottgers, 2012 187 delta_m_h2o(ig) = delta_m_h2o(ig) + porosity*rho*(icetable_thickness(ig,islope) - icetable_thickness_old(ig,islope)) & ! convention > 0. <=> it condenses 188 *subslope_dist(ig,islope)/cos(def_slope_mean(islope)*pi/180.) 189 enddo 190 enddo 191 else if (icetable_dynamic) then 192 delta_m_h2o = 0. 193 do ig = 1,ngrid 194 do islope = 1,nslope 195 do isoil = 1,nsoil 196 call compute_Tice_pem(nsoil,tsoil(ig,:,islope),tsurf(ig,islope),mlayer_PEM(isoil - 1),Tice) 197 rho = -3.5353e-4*Tice**2 + 0.0351*Tice + 933.5030 ! Rottgers, 2012 198 delta_m_h2o(ig) = delta_m_h2o(ig) + rho*(ice_porefilling(ig,isoil,islope) - ice_porefilling_old(ig,isoil,islope)) & ! convention > 0. <=> it condenses 199 *subslope_dist(ig,islope)/cos(def_slope_mean(islope)*pi/180.) 200 enddo 201 enddo 202 enddo 203 endif 196 204 197 205 END SUBROUTINE compute_massh2o_exchange_ssi … … 285 293 286 294 ! 2. Compute d_z (eta* d_z(rho)) (last term in Eq. 13 of Schorgofer, Icarus (2010)) 287 ! 2.0 preliminary: depth to shallowest 295 ! 2.0 preliminary: depth to shallowest ice (discontinuity at interface) 288 296 index_firstice = -1 289 297 do ilay = 1,nsoilmx_PEM … … 294 302 enddo 295 303 296 ! 2.1: now we can compute Compute d_z (eta* d_z(rho))304 ! 2.1: now we can compute 297 305 call deriv1(mlayer_PEM,nsoilmx_PEM,eta,1.,eta(nsoilmx_PEM - 1),dz_eta) 298 306 … … 368 376 369 377 !----------------------------------------------------------------------- 370 SUBROUTINE compute_Tice_pem(nsoil, ptsoil, ptsurf, ice_depth,Tice)378 SUBROUTINE compute_Tice_pem(nsoil,ptsoil,ptsurf,ice_depth,Tice) 371 379 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 372 380 !!! … … 383 391 ! Inputs 384 392 ! ------ 385 integer, 386 real, dimension(nsoil), 387 real, intent(in) :: ptsurf ! Soiltemperature (K)388 real, 393 integer, intent(in) :: nsoil ! Number of soil layers 394 real, dimension(nsoil), intent(in) :: ptsoil ! Soil temperature (K) 395 real, intent(in) :: ptsurf ! Surface temperature (K) 396 real, intent(in) :: ice_depth ! Ice depth (m) 389 397 390 398 ! Outputs 391 ! ------ 399 ! ------- 392 400 real, intent(out) :: Tice ! Ice temperatures (K) 393 401 -
trunk/LMDZ.COMMON/libf/evolution/pem.F90
r3516 r3525 223 223 logical :: bool_sublim ! logical to check if there is sublimation or not 224 224 logical, dimension(:,:), allocatable :: co2ice_disappeared ! logical to check if a co2 ice reservoir already disappeared at a previous timestep 225 real, dimension(:,:), allocatable :: icetable_thickness_prev_iter ! ngrid x nslope: Thickness of the ice table at the previous iteration [m] 225 real, dimension(:,:), allocatable :: icetable_thickness_old ! ngrid x nslope: Thickness of the ice table at the previous iteration [m] 226 real, dimension(:,:,:), allocatable :: ice_porefilling_old ! ngrid x nslope: Ice pore filling at the previous iteration [m] 226 227 real, dimension(:), allocatable :: delta_h2o_icetablesublim ! ngrid x Total mass of the H2O that has sublimated / condenses from the ice table [kg] 227 228 real, dimension(:), allocatable :: porefill ! Pore filling (output) to compute the dynamic ice table … … 555 556 allocate(delta_co2_adsorbded(ngrid)) 556 557 allocate(co2ice_disappeared(ngrid,nslope)) 557 allocate(icetable_thickness_prev_iter(ngrid,nslope)) 558 allocate(icetable_thickness_old(ngrid,nslope)) 559 allocate(ice_porefilling_old(ngrid,nsoilmx_PEM,nslope)) 558 560 allocate(delta_h2o_icetablesublim(ngrid)) 559 561 allocate(delta_h2o_adsorbded(ngrid)) … … 927 929 if (icetable_equilibrium) then 928 930 write(*,*) "Compute ice table (equilibrium method)" 929 icetable_thickness_ prev_iter= icetable_thickness931 icetable_thickness_old = icetable_thickness 930 932 call computeice_table_equilibrium(ngrid,nslope,nsoilmx_PEM,watercaptag,watersurf_density_avg,watersoil_density_PEM_avg,TI_PEM(:,1,:),icetable_depth,icetable_thickness) 931 call compute_massh2o_exchange_ssi(ngrid,nslope,nsoilmx_PEM,icetable_thickness_ prev_iter,icetable_thickness,icetable_depth,tsurf_avg,tsoil_PEM,delta_h2o_icetablesublim) ! Mass of H2O exchange between the ssi and the atmosphere933 call compute_massh2o_exchange_ssi(ngrid,nslope,nsoilmx_PEM,icetable_thickness_old,ice_porefilling_old,tsurf_avg,tsoil_PEM,delta_h2o_icetablesublim) ! Mass of H2O exchange between the ssi and the atmosphere 932 934 else if (icetable_dynamic) then 933 935 write(*,*) "Compute ice table (dynamic method)" 936 ice_porefilling_old = ice_porefilling 934 937 allocate(porefill(nsoilmx_PEM)) 935 938 do ig = 1,ngrid … … 941 944 enddo 942 945 deallocate(porefill) 943 !call compute_massh2o_exchange_ssi(ngrid,nslope,nsoilmx_PEM,icetable_thickness_prev_iter,icetable_thickness,icetable_depth,tsurf_avg, tsoil_PEM,delta_h2o_icetablesublim) ! Mass of H2O exchange between the ssi and the atmosphere946 call compute_massh2o_exchange_ssi(ngrid,nslope,nsoilmx_PEM,icetable_thickness_old,ice_porefilling_old,tsurf_avg, tsoil_PEM,delta_h2o_icetablesublim) ! Mass of H2O exchange between the ssi and the atmosphere 944 947 endif 945 948 946 949 ! II_d.4 Update the soil thermal properties 947 call update_soil_thermalproperties(ngrid,nslope,nsoilmx_PEM,d_h2oice,h2o_ice,global_avg_press_new,icetable_depth,icetable_thickness, TI_PEM)950 call update_soil_thermalproperties(ngrid,nslope,nsoilmx_PEM,d_h2oice,h2o_ice,global_avg_press_new,icetable_depth,icetable_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 948 951 949 952 ! II_d.5 Update the mass of the regolith adsorbed … … 1230 1233 deallocate(watersurf_density_avg,watersoil_density_timeseries,Tsurfavg_before_saved) 1231 1234 deallocate(tsoil_phys_PEM_timeseries,watersoil_density_PEM_timeseries,watersoil_density_PEM_avg) 1232 deallocate(delta_co2_adsorbded,delta_h2o_adsorbded,vmr_co2_PEM_phys,delta_h2o_icetablesublim,icetable_thickness_prev_iter) 1235 deallocate(delta_co2_adsorbded,delta_h2o_adsorbded,vmr_co2_PEM_phys,delta_h2o_icetablesublim) 1236 deallocate(icetable_thickness_old,ice_porefilling_old) 1233 1237 deallocate(is_co2ice_ini,co2ice_disappeared,ini_co2ice_sublim,ini_h2oice_sublim,stratif) 1234 1238 !----------------------------- END OUTPUT ------------------------------ -
trunk/LMDZ.COMMON/libf/evolution/pemetat0.F90
r3512 r3525 7 7 !======================================================================= 8 8 9 SUBROUTINE pemetat0(filename,ngrid,nsoil_PCM,nsoil_PEM,nslope,timelen,timestep,TI_PEM,tsoil_PEM,ice_table_depth,ice_table_thickness, 10 ice_porefilling,tsurf_avg_yr1,tsurf_avg_yr2,q_co2,q_h2o,ps_inst,tsoil_inst,d_h2oice,d_co2ice,co2_ice,h2o_ice, &11 global_avg_pressure,watersurf_avg,watersoil_avg,m_co2_regolith_phys,deltam_co2_regolith_phys, 9 SUBROUTINE pemetat0(filename,ngrid,nsoil_PCM,nsoil_PEM,nslope,timelen,timestep,TI_PEM,tsoil_PEM,ice_table_depth,ice_table_thickness, & 10 ice_porefilling,tsurf_avg_yr1,tsurf_avg_yr2,q_co2,q_h2o,ps_inst,tsoil_inst,d_h2oice,d_co2ice,co2_ice,h2o_ice, & 11 global_avg_pressure,watersurf_avg,watersoil_avg,m_co2_regolith_phys,deltam_co2_regolith_phys, & 12 12 m_h2o_regolith_phys,deltam_h2o_regolith_phys,stratif) 13 13 … … 16 16 use comsoil_h, only: volcapa, inertiedat 17 17 use adsorption_mod, only: regolith_adsorption, adsorption_pem 18 use ice_table_mod, only: computeice_table_equilibrium, icetable_ equilibrium, icetable_dynamic18 use ice_table_mod, only: computeice_table_equilibrium, icetable_depth, icetable_thickness, icetable_equilibrium, icetable_dynamic 19 19 use constants_marspem_mod, only: alpha_clap_h2o, beta_clap_h2o, TI_breccia, TI_bedrock 20 20 use soil_thermalproperties_mod, only: update_soil_thermalproperties … … 315 315 write(*,*)'will reconstruct the values of the ice table given the current state' 316 316 call computeice_table_equilibrium(ngrid,nslope,nsoil_PEM,watercaptag,watersurf_avg,watersoil_avg, TI_PEM(:,1,:),ice_table_depth,ice_table_thickness) 317 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness, TI_PEM)317 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 318 318 do islope = 1,nslope 319 319 call ini_tsoil_pem(ngrid,nsoil_PEM,TI_PEM(:,:,islope),tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) … … 327 327 write(*,*)'will reconstruct the values of the ice table given the current state' 328 328 ice_table_depth = -9999. 329 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness, TI_PEM)329 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 330 330 do islope = 1,nslope 331 331 call ini_tsoil_pem(ngrid,nsoil_PEM,TI_PEM(:,:,islope),tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) … … 504 504 if (icetable_equilibrium) then 505 505 call computeice_table_equilibrium(ngrid,nslope,nsoil_PEM,watercaptag,watersurf_avg,watersoil_avg,TI_PEM(:,1,:),ice_table_depth,ice_table_thickness) 506 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness, TI_PEM)506 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 507 507 do islope = 1,nslope 508 508 call ini_tsoil_pem(ngrid,nsoil_PEM,TI_PEM(:,:,islope),tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) … … 512 512 ice_porefilling = 1. 513 513 ice_table_depth = -9999. 514 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness, TI_PEM)514 call update_soil_thermalproperties(ngrid,nslope,nsoil_PEM,d_h2oice,h2o_ice,global_avg_pressure,ice_table_depth,ice_table_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 515 515 do islope = 1,nslope 516 516 call ini_tsoil_pem(ngrid,nsoil_PEM,TI_PEM(:,:,islope),tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) -
trunk/LMDZ.COMMON/libf/evolution/soil_thermalproperties_mod.F90
r3347 r3525 9 9 !!! 10 10 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 11 12 ! Constants: 13 real, parameter :: reg_inertie_thresold = 370. ! Above this thermal inertia, the regolith has too much cementation to be dependant on the pressure [J/m^2/K/s^1/2] 14 real, parameter :: reg_inertie_minvalue = 50. ! Minimum value of the Thermal Inertia at low pressure (Piqueux & Christensen 2009) [J/m^2/K/s^1/2] 15 real, parameter :: reg_inertie_maxvalue = 370. ! Maximum value of the Thermal Inertia at low pressure (Piqueux & Christensen 2009) [J/m^2/K/s^1/2] 16 real, parameter :: P610 = 610.0 ! current average pressure on Mars [Pa] 17 real, parameter :: C = 0.0015 ! Constant to derive TI as a function of P, from Presley and Christensen 1997 [unitless] 18 real, parameter :: K = 8.1*1e4 ! Constant to derive TI as a function of P, from Presley and Christensen 1997 [Torr, or 133.3Pa] 19 real, parameter :: Pa2Torr = 1./133.3 ! Conversion from Pa to tor [Pa/Torr] 11 20 12 21 !======================================================================= … … 50 59 ice_thermalinertia = inertie_purewaterice 51 60 else 52 ice_thermalinertia = sqrt(surf_thermalinertia**2 + porosity*pore_filling*inertie_purewaterice**2) 61 ice_thermalinertia = sqrt(surf_thermalinertia**2 + porosity*pore_filling*inertie_purewaterice**2) ! Siegler et al., 2012 53 62 endif 54 63 … … 56 65 !======================================================================= 57 66 58 SUBROUTINE update_soil_thermalproperties(ngrid,nslope,nsoil _PEM,tendencies_waterice,waterice,p_avg_new,ice_depth,ice_thickness,TI_PEM)67 SUBROUTINE update_soil_thermalproperties(ngrid,nslope,nsoil,tendencies_waterice,waterice,p_avg_new,icetable_depth,icetable_thickness,ice_porefilling,icetable_equilibrium,icetable_dynamic,TI_PEM) 59 68 60 69 use comsoil_h, only: volcapa … … 65 74 66 75 ! Input: 67 integer, intent(in) :: ngrid, nslope, nsoil_PEM ! Shape of the arrays: physical grid, number of sub-grid slopes, number of layer in the soil 68 real, intent(in) :: p_avg_new ! Global average surface pressure [Pa] 69 real, dimension(ngrid,nslope), intent(in) :: tendencies_waterice ! Tendencies on the water ice [kg/m^2/year] 70 real, dimension(ngrid,nslope), intent(in) :: waterice ! Surface Water ice [kg/m^2] 71 real, dimension(ngrid,nslope), intent(in) :: ice_depth ! Ice table depth [m] 72 real, dimension(ngrid,nslope), intent(in) :: ice_thickness ! Ice table thickness [m] 76 integer, intent(in) :: ngrid, nslope, nsoil ! Shape of the arrays: physical grid, number of sub-grid slopes, number of layer in the soil 77 real, intent(in) :: p_avg_new ! Global average surface pressure [Pa] 78 real, dimension(ngrid,nslope), intent(in) :: tendencies_waterice ! Tendencies on the water ice [kg/m^2/year] 79 real, dimension(ngrid,nslope), intent(in) :: waterice ! Surface Water ice [kg/m^2] 80 real, dimension(ngrid,nslope), intent(in) :: icetable_depth ! Ice table depth [m] 81 real, dimension(ngrid,nslope), intent(in) :: icetable_thickness ! Ice table thickness [m] 82 real, dimension(ngrid,nsoil,nslope), intent(in) :: ice_porefilling ! Ice porefilling [m^3/m^3] 83 logical, intent(in) :: icetable_equilibrium, icetable_dynamic ! Computing method for ice table 73 84 74 85 ! Outputs: 75 real, dimension(ngrid,nsoil_PEM,nslope), intent(inout) :: TI_PEM ! Soil Thermal Inertia [J/m^2/K/s^1/2] 76 77 ! Constants: 78 real :: reg_inertie_thresold = 370. ! Above this thermal inertia, the regolith has too much cementation to be dependant on the pressure [J/m^2/K/s^1/2] 79 real :: reg_inertie_minvalue = 50. ! Minimum value of the Thermal Inertia at low pressure (Piqueux & Christensen 2009) [J/m^2/K/s^1/2] 80 real :: reg_inertie_maxvalue = 370. ! Maximum value of the Thermal Inertia at low pressure (Piqueux & Christensen 2009) [J/m^2/K/s^1/2] 81 real :: ice_inertia ! Inertia of water ice [SI] 82 real :: P610 = 610.0 ! current average pressure on Mars [Pa] 83 real :: C = 0.0015 ! Constant to derive TI as a function of P, from Presley and Christensen 1997 [uniteless] 84 real :: K = 8.1*1e4 ! Constant to derive TI as a function of P, from Presley and Christensen 1997 [tor, or 133.3Pa] 85 real :: Pa2Tor = 1./133.3 ! Conversion from Pa to tor [Pa/tor] 86 real, dimension(ngrid,nsoil,nslope), intent(inout) :: TI_PEM ! Soil Thermal Inertia [J/m^2/K/s^1/2] 86 87 87 88 ! Local variables: … … 91 92 real :: ice_bottom_depth ! Bottom depth of the subsurface ice [m] 92 93 real :: d_part ! Regolith particle size [micrometer] 94 real :: ice_inertia ! Inertia of water ice [SI] 93 95 94 96 write(*,*) "Update soil properties" … … 101 103 if (reg_thprop_dependp) then 102 104 if (TI_PEM(ig,1,islope) < reg_inertie_thresold) then 103 d_part = (regolith_inertia(ig,islope)**2/(volcapa*C*(P610*Pa2Tor )**(0.6)))**(-1./(0.11*log10(P610*Pa2Tor/K))) ! compute particle size, in micrometer104 regolith_inertia(ig,islope) = sqrt(volcapa*C*(p_avg_new*Pa2Tor )**(0.6)*d_part**(-0.11*log10(p_avg_new*Pa2Tor/K)))105 d_part = (regolith_inertia(ig,islope)**2/(volcapa*C*(P610*Pa2Torr)**(0.6)))**(-1./(0.11*log10(P610*Pa2Torr/K))) ! compute particle size, in micrometer 106 regolith_inertia(ig,islope) = sqrt(volcapa*C*(p_avg_new*Pa2Torr)**(0.6)*d_part**(-0.11*log10(p_avg_new*Pa2Torr/K))) 105 107 if (regolith_inertia(ig,islope) > reg_inertie_maxvalue) regolith_inertia(ig,islope) = reg_inertie_maxvalue 106 108 if (regolith_inertia(ig,islope) < reg_inertie_minvalue) regolith_inertia(ig,islope) = reg_inertie_minvalue … … 135 137 (((delta - layer_PEM(index_bedrock))/(TI_PEM(ig,index_bedrock,islope)**2)) + & 136 138 ((layer_PEM(index_bedrock + 1) - delta)/(TI_bedrock**2)))) 137 do isoil = index_bedrock + 2,nsoil _PEM139 do isoil = index_bedrock + 2,nsoil 138 140 TI_PEM(ig,isoil,islope) = TI_bedrock 139 141 enddo … … 141 143 enddo ! islope 142 144 143 ! 145 ! 3. Build new TI in case of ice table 144 146 do ig = 1,ngrid 145 147 do islope = 1,nslope 146 if (ice _depth(ig,islope) > -1.e-6) then148 if (icetable_depth(ig,islope) > -1.e-6) then 147 149 ! 3.0 Case where it is perennial ice 148 if (ice _depth(ig,islope) < 1.e-10) then150 if (icetable_depth(ig,islope) < 1.e-10) then 149 151 call ice_thermal_properties(.true.,1.,0.,ice_inertia) 150 do isoil = 1,nsoil _PEM152 do isoil = 1,nsoil 151 153 TI_PEM(ig,isoil,islope) = ice_inertia 152 154 enddo 153 155 else 154 call ice_thermal_properties(.false.,1.,regolith_inertia(ig,islope),ice_inertia) 155 ! 3.1.1 find the index of the mixed layer 156 iref = 0 ! initialize iref 157 do isoil = 1,nsoil_PEM ! loop on layers to find the beginning of the ice table 158 if (ice_depth(ig,islope) >= layer_PEM(isoil)) then 159 iref = isoil ! pure regolith layer up to here 160 else 161 exit ! correct iref was obtained in previous cycle 162 endif 163 enddo 164 ! 3.1.2 find the index of the end of the ice table 165 iend = 0 ! initialize iend 166 ice_bottom_depth = ice_depth(ig,islope) + ice_thickness(ig,islope) 167 do isoil = 1,nsoil_PEM ! loop on layers to find the end of the ice table 168 if (ice_bottom_depth >= layer_PEM(isoil)) then 169 iend = isoil ! pure regolith layer up to here 170 else 171 exit ! correct iref was obtained in previous cycle 172 endif 173 enddo 174 ! 3.2 Build the new ti 175 if (iref < nsoil_PEM) then 176 if (iref == iend) then 177 ! Ice table begins and end in the same mixture Mixtures with three components 178 if (iref /= 0) then ! mixed layer 179 TI_PEM(ig,iref + 1,islope) = sqrt((layer_PEM(iref + 1) - layer_PEM(iref))/ & 180 (((ice_depth(ig,islope) - layer_PEM(iref))/(TI_PEM(ig,iref,islope)**2)) + & 181 ((ice_bottom_depth - ice_depth(ig,islope))/(ice_inertia**2)) + & 182 ((layer_PEM(iref + 1) - ice_bottom_depth)/(TI_PEM(ig,iref + 1,islope)**2)))) 183 else ! first layer is already a mixed layer 184 ! (ie: take layer(iref=0)=0) 185 TI_PEM(ig,1,islope) = sqrt((layer_PEM(1))/ & 186 (((ice_depth(ig,islope))/(TI_PEM(ig,1,islope)**2)) + & 187 ((ice_bottom_depth - ice_depth(ig,islope))/(ice_inertia**2)) + & 188 ((layer_PEM(2) - ice_bottom_depth)/(TI_PEM(ig,2,islope)**2)))) 189 endif ! of if (iref /= 0) 190 else 191 if (iref /= 0) then ! mixed layer 192 TI_PEM(ig,iref + 1,islope) = sqrt((layer_PEM(iref + 1) - layer_PEM(iref))/ & 193 (((ice_depth(ig,islope) - layer_PEM(iref))/(TI_PEM(ig,iref,islope)**2)) + & 194 ((layer_PEM(iref + 1) - ice_depth(ig,islope))/(ice_inertia**2)))) 195 else ! first layer is already a mixed layer 196 ! (ie: take layer(iref=0)=0) 197 TI_PEM(ig,1,islope) = sqrt((layer_PEM(1))/ & 198 (((ice_depth(ig,islope))/(TI_PEM(ig,1,islope)**2)) + & 199 ((layer_PEM(1) - ice_depth(ig,islope))/(ice_inertia**2)))) 200 endif ! of if (iref /= 0) 201 endif ! iref == iend 202 ! 3.3 Build the new ti 203 do isoil = iref + 2,iend 204 TI_PEM(ig,isoil,islope) = ice_inertia 156 if (icetable_equilibrium) then 157 call ice_thermal_properties(.false.,1.,regolith_inertia(ig,islope),ice_inertia) 158 ! 3.1.1 find the index of the mixed layer 159 iref = 0 ! initialize iref 160 do isoil = 1,nsoil ! loop on layers to find the beginning of the ice table 161 if (icetable_depth(ig,islope) >= layer_PEM(isoil)) then 162 iref = isoil ! pure regolith layer up to here 163 else 164 exit ! correct iref was obtained in previous cycle 165 endif 205 166 enddo 206 if (iend < nsoil_PEM) then 207 TI_PEM(ig,iend + 1,islope) = sqrt((layer_PEM(iend + 1) - layer_PEM(iend))/ & 208 (((ice_bottom_depth - layer_PEM(iend))/(TI_PEM(ig,iend,islope)**2)) + & 209 ((layer_PEM(iend + 1) - ice_bottom_depth)/(ice_inertia**2)))) 210 endif 211 endif ! of if (iref < nsoilmx) 167 ! 3.1.2 find the index of the end of the ice table 168 iend = 0 ! initialize iend 169 ice_bottom_depth = icetable_depth(ig,islope) + icetable_thickness(ig,islope) 170 do isoil = 1,nsoil ! loop on layers to find the end of the ice table 171 if (ice_bottom_depth >= layer_PEM(isoil)) then 172 iend = isoil ! pure regolith layer up to here 173 else 174 exit ! correct iref was obtained in previous cycle 175 endif 176 enddo 177 ! 3.2 Build the new ti 178 if (iref < nsoil) then 179 if (iref == iend) then 180 ! Ice table begins and end in the same mixture with three components 181 if (iref /= 0) then ! mixed layer 182 TI_PEM(ig,iref + 1,islope) = sqrt((layer_PEM(iref + 1) - layer_PEM(iref))/ & 183 (((icetable_depth(ig,islope) - layer_PEM(iref))/(TI_PEM(ig,iref,islope)**2)) + & 184 ((ice_bottom_depth - icetable_depth(ig,islope))/(ice_inertia**2)) + & 185 ((layer_PEM(iref + 1) - ice_bottom_depth)/(TI_PEM(ig,iref + 1,islope)**2)))) 186 else ! first layer is already a mixed layer 187 ! (ie: take layer(iref=0)=0) 188 TI_PEM(ig,1,islope) = sqrt((layer_PEM(1))/ & 189 (((icetable_depth(ig,islope))/(TI_PEM(ig,1,islope)**2)) + & 190 ((ice_bottom_depth - icetable_depth(ig,islope))/(ice_inertia**2)) + & 191 ((layer_PEM(2) - ice_bottom_depth)/(TI_PEM(ig,2,islope)**2)))) 192 endif ! of if (iref /= 0) 193 else 194 if (iref /= 0) then ! mixed layer 195 TI_PEM(ig,iref + 1,islope) = sqrt((layer_PEM(iref + 1) - layer_PEM(iref))/ & 196 (((icetable_depth(ig,islope) - layer_PEM(iref))/(TI_PEM(ig,iref,islope)**2)) + & 197 ((layer_PEM(iref + 1) - icetable_depth(ig,islope))/(ice_inertia**2)))) 198 else ! first layer is already a mixed layer 199 ! (ie: take layer(iref=0)=0) 200 TI_PEM(ig,1,islope) = sqrt((layer_PEM(1))/ & 201 (((icetable_depth(ig,islope))/(TI_PEM(ig,1,islope)**2)) + & 202 ((layer_PEM(1) - icetable_depth(ig,islope))/(ice_inertia**2)))) 203 endif ! of if (iref /= 0) 204 endif ! iref == iend 205 206 TI_PEM(ig,iref + 2:iend,islope) = ice_inertia 207 if (iend < nsoil) then 208 TI_PEM(ig,iend + 1,islope) = sqrt((layer_PEM(iend + 1) - layer_PEM(iend))/ & 209 (((ice_bottom_depth - layer_PEM(iend))/(TI_PEM(ig,iend,islope)**2)) + & 210 ((layer_PEM(iend + 1) - ice_bottom_depth)/(ice_inertia**2)))) 211 endif 212 endif ! of if (iref < nsoilmx) 213 else if (icetable_dynamic) then 214 do isoil = 1,nsoil 215 call ice_thermal_properties(.false.,ice_porefilling(ig,isoil,islope),regolith_inertia(ig,islope),TI_PEM(ig,isoil,islope)) 216 enddo 217 endif ! of if icetable_equilibrium 212 218 endif ! permanent glaciers 213 endif ! ice_depth(ig,islope) > 0. 214 ! write(*,*) 'TI=', TI_PEM(ig,:,islope) 219 endif ! icetable_depth(ig,islope) > 0. 215 220 enddo !islope 216 221 enddo !ig
Note: See TracChangeset
for help on using the changeset viewer.