Changeset 3532 for trunk/LMDZ.COMMON/libf/evolution
- Timestamp:
- Dec 4, 2024, 4:04:54 PM (3 weeks ago)
- Location:
- trunk/LMDZ.COMMON/libf/evolution
- Files:
-
- 1 deleted
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/evolution/NS_dyn_ss_ice_m.F90
r3527 r3532 11 11 !!! 12 12 !!! 13 !!! Author: EV, updated NS MSIM dynamical program for the PEM 13 !!! Author: EV, updated NS MSIM dynamical program for the PEM 14 14 !!! 15 15 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 37 37 real(8) ssi_depth_in, ssi_depth, T1 38 38 real(8), dimension(NP) :: zdepthF, zdepthE, zdepthT, zdepthG 39 real(8), dimension(NMAX,NP) :: porefill, porefill_in 39 real(8), dimension(NMAX,NP) :: porefill, porefill_in 40 40 real(8), dimension(nz) :: Tb 41 41 real(8), dimension(NP) :: Tmean1, Tmean3, avrho1 … … 68 68 !read(21,*) latitude(k),albedo(k),thIn(k),htopo(k) 69 69 ! empirical relation from Mellon & Jakosky 70 rhoc(k) = 800.*(150.+100.*sqrt(34.2+0.714*thIn(k))) 70 rhoc(k) = 800.*(150.+100.*sqrt(34.2+0.714*thIn(k))) 71 71 enddo 72 72 !close(21) … … 80 80 z(iloop + 1) = l1*(1+iloop**2.9*(1-exp(-real(iloop)/20.))) 81 81 enddo 82 82 83 83 84 84 !open(unit=30,file='z.'//ext,action='write',status='unknown') … … 95 95 timestep = 1 ! must be integer fraction of 1 ka 96 96 icetime = -tmax-timestep ! earth years 97 98 ! initializations 97 98 ! initializations 99 99 !Tb = -9999. 100 100 zdepthF(:) = -9999. … … 152 152 !print *,'Zt0= ',ZdepthT 153 153 call icelayer_mars(timestep,nz,NP,thIn,rhoc,z,porosity,pfrost,Tb,zdepthF, & 154 & zdepthE,porefill(1:nz,:),Tmean1,Tmean3,zdepthG, & 154 & zdepthE,porefill(1:nz,:),Tmean1,Tmean3,zdepthG, & 155 155 & albedo,p0,icefrac,zdepthT,avrho1, & 156 156 & avrho1prescribed) … … 164 164 !write(36,*) icetime,latitude(k),zdepthF(k),porefill(1:nz,k) 165 165 ! compact output format 166 ! write(36,'(f10.0,2x,f7.3,1x,f11.5,1x)',advance='no') & 166 ! write(36,'(f10.0,2x,f7.3,1x,f11.5,1x)',advance='no') & 167 167 ! & icetime,latitude(k),zdepthF(k) 168 168 ! call compactoutput(36,porefill(:,k),nz) … … 179 179 180 180 !501 format (f10.0,2x,f7.3,2x,f10.4,2(2x,f6.2),2x,f9.3,2x,g11.4) 181 181 182 182 end subroutine dyn_ss_ice_m 183 183 … … 232 232 endif 233 233 newti = sqrt(newrhoc*k) 234 234 235 235 case (2) ! massive ice (pure or dirty ice) 236 236 newrhoc = rhocobs*(1.-icefrac)/(1.-porosity) + icefrac*icedensity*cice 237 237 k = icefrac*kice + (1.-icefrac)*kw 238 238 newti = sqrt(newrhoc*k) 239 239 240 240 case (3) ! all ice, special case of layertype 2, which doesn't use porosity 241 241 newrhoc = icedensity*cice 242 k = kice 243 newti = sqrt(newrhoc*k) 244 242 k = kice 243 newti = sqrt(newrhoc*k) 244 245 245 case (4) ! pores completely filled with ice, special case of layertype 1 246 246 newrhoc = rhocobs + porosity*icedensity*cice 247 k = porosity*kice + kobs ! option A, end-member case of type 1, option A 247 k = porosity*kice + kobs ! option A, end-member case of type 1, option A 248 248 !k = kw*kice/((1-porosity)*kice+porosity*kw) ! option B, harmonic average 249 249 newti = sqrt(newrhoc*k) … … 257 257 case default 258 258 error stop 'invalid layer type' 259 259 260 260 end select 261 261 262 262 end subroutine soilthprop 263 263 264 264 265 265 !======================================================================= 266 266 267 267 real*8 function frostpoint(p) 268 268 ! inverse of psv … … 271 271 implicit none 272 272 real*8 p 273 273 274 274 !-----inverse of parametrization 1 275 275 ! real*8 DHmelt,DHvap,DHsub,R,pt,Tt … … 278 278 ! parameter (R=8.314,pt=6.11e2,Tt=273.16) 279 279 ! frostpoint = 1./(1./Tt-R/DHsub*log(p/pt)) 280 280 281 281 !-----inverse of parametrization 2 282 282 ! inverse of eq. (2) in Murphy & Koop (2005) … … 288 288 ! eq. (8) in Murphy & Koop (2005) 289 289 ! frostpoint = (1.814625*log(p) + 6190.134)/(29.120 - log(p)) 290 290 291 291 end function frostpoint 292 292 -
trunk/LMDZ.COMMON/libf/evolution/NS_fast_subs_mars.F90
r3527 r3532 11 11 real(8), parameter :: emiss0 = 1. ! emissivity of dry surface 12 12 integer, parameter :: EQUILTIME =15 ! [Mars years] 13 13 14 14 integer, parameter :: NMAX = 1000 15 15 … … 59 59 B = Diff*bigstep*86400.*365.24/(porosity*927.) 60 60 !B = Diff*bigstep*86400.*365.24/(porosity*rho_ice(Tb(),'h2o')) 61 61 62 62 typeT = -9 63 63 if (zdepthT(k)>=0. .and. zdepthT(k)<z(nz)) then … … 72 72 ! call assignthermalproperties(nz,thIn(k),rhoc(k),ti,rhocv, & 73 73 ! & typeT,icefrac,porosity,porefill(:,k)) 74 74 75 75 !----run thermal model 76 call ajsub_mars(typeT, albedo(k), pfrost(k), nz, z, & 76 call ajsub_mars(typeT, albedo(k), pfrost(k), nz, z, & 77 77 & ti, rhocv, fracIR, fracDust, p0(k), & 78 78 & avdrho(k), avdrhoP(k), avrho1(k), Tb(k), zdepthE(k), typeF, & … … 90 90 jump = -9 91 91 endif 92 if (zdepthT(k)>=0. .and. avdrho(k)*avdrho_old(k)<0.) then 92 if (zdepthT(k)>=0. .and. avdrho(k)*avdrho_old(k)<0.) then 93 93 write(34,*) '# zdepth arrested' 94 94 if (jump>1) write(34,*) '# previous step was too large',jump … … 99 99 avdrho_old(k) = avdrho(k) 100 100 101 !----mode 2 growth 101 !----mode 2 growth 102 102 typeP = -9; mode2 = .FALSE. 103 103 do j=1,nz … … 111 111 & zdepthE(k)<z(typeP) .and. & 112 112 & z(typeP)-zdepthE(k)>2*(z(typeP)-z(typeP-1))) then ! trick that avoids oscillations 113 deltaz = -avdrhoP(k)/z(typeP)*18./8314.*B ! conservation of mass 113 deltaz = -avdrhoP(k)/z(typeP)*18./8314.*B ! conservation of mass 114 114 if (deltaz>z(typeP)-z(typeP-1)) then ! also implies avdrhoP<0. 115 115 mode2 = .TRUE. … … 143 143 ! 144 144 ! Tb<0 initializes temperatures 145 ! Tb>0 initializes temperatures with Tb 145 ! Tb>0 initializes temperatures with Tb 146 146 !*********************************************************************** 147 147 use fast_subs_univ, only: depths_avmeth, equildepth … … 158 158 real(8), intent(INOUT) :: Tb(nz) 159 159 integer, intent(OUT) :: typeF ! index of depth below which filling occurs 160 real(8), intent(OUT) :: zdepthE, zdepthF 160 real(8), intent(OUT) :: zdepthE, zdepthF 161 161 real(8), intent(OUT) :: ypp(nz) ! (d rho/dt)/Diff 162 162 real(8), intent(OUT) :: Tmean3, zdepthG … … 171 171 real(8) Told(nz), Fsurfold, Tsurfold, Tmean0, avrho2 172 172 real(8) rhosatav0, rhosatav(nz), rlow 173 173 174 174 tmax = EQUILTIME*sols_per_my 175 175 nsteps = int(tmax/dt) ! calculate total number of timesteps 176 176 177 Tco2frost = tfrostco2(patm) 177 Tco2frost = tfrostco2(patm) 178 178 179 179 !if (Tb<=0.) then ! initialize … … 182 182 !Tmean0 = Tmean0-5. 183 183 !write(34,*) '# initialized with temperature estimate at',latitude/d2r,'of',Tmean0,'K' 184 !T(1:nz) = Tmean0 184 !T(1:nz) = Tmean0 185 185 !else 186 186 T(1:nz) = Tb 187 187 ! not so good when Fgeotherm is on 188 188 !endif 189 189 190 190 albedo = albedo0 191 191 emiss = emiss0 … … 207 207 ! Qn=flux(marsR,marsDec,latitude,HA,albedo,fracir,fracdust,0.d0,0.d0) 208 208 !Qn = flux_mars77(marsR,marsDec,latitude,HA,albedo,fracir,fracdust) 209 !----loop over time steps 209 !----loop over time steps 210 210 do n=0,nsteps-1 211 time = (n+1)*dt ! time at n+1 211 time = (n+1)*dt ! time at n+1 212 212 ! tdays = time*(sec_per_sol/earthDay) ! parenthesis may improve roundoff 213 213 ! call generalorbit(tdays,a,ecc,omega,eps,marsLs,marsDec,marsR) … … 215 215 ! Qnp1=flux(marsR,marsDec,latitude,HA,albedo,fracir,fracdust,0.d0,0.d0) 216 216 !Qnp1 = flux_mars77(marsR,marsDec,latitude,HA,albedo,fracir,fracdust) 217 217 218 218 Tsurfold = Tsurf 219 219 Fsurfold = Fsurf … … 226 226 T(1:nz) = Told(1:nz) 227 227 !call conductionT(nz,z,dt*sec_per_sol,T,Tsurfold,Tco2frost,ti, & 228 !& rhocv,Fgeotherm,Fsurf) 228 !& rhocv,Fgeotherm,Fsurf) 229 229 Tsurf = Tco2frost 230 230 ! dE = (- Qn - Qnp1 + Fsurfold + Fsurf + & … … 240 240 endif 241 241 !Qn=Qnp1 242 242 243 243 if (time>=tmax-sols_per_my) then 244 244 Tmean1 = Tmean1 + Tsurf … … 253 253 254 254 enddo ! end of time loop 255 255 256 256 avrho1 = avrho1/nm 257 257 if (present(avrho1prescribed)) then … … 266 266 endif 267 267 avdrho = avrho2-avrho1 268 typeP = -9 268 typeP = -9 269 269 do i=1,nz 270 270 if (porefill(i)>0.) then … … 275 275 if (typeP>0) then 276 276 avdrhoP = rhosatav(typeP) - avrho1 277 else 277 else 278 278 avdrhoP = -9999. 279 279 end if … … 282 282 283 283 if (Fgeotherm>0.) then 284 Tb = Tmean1 284 Tb = Tmean1 285 285 typeG = 1 ! will be overwritten by depths_avmeth 286 286 rlow = 2*rhosatav(nz)-rhosatav(nz-1) … … 328 328 psv = exp(A/T+B) ! Clapeyron 329 329 330 !-----parametrization 3 330 !-----parametrization 3 331 331 ! eq. (7) in Murphy & Koop, Q. J. R. Meteor. Soc. 131, 1539 (2005) 332 332 ! psv = exp(9.550426 - 5723.265/T + 3.53068*log(T) - 0.00728332*T) 333 333 334 334 end function psv 335 335 -
trunk/LMDZ.COMMON/libf/evolution/NS_fast_subs_univ.F90
r3527 r3532 32 32 real(8) equildepth ! =zdepthE 33 33 !real(8), external :: zint ! defined in allinterfaces.mod 34 34 35 35 typeE = -9; equildepth = -9999. 36 do i=1,nz 36 do i=1,nz 37 37 if (rhosatav(i) <= avrho1) then 38 38 typeE=i … … 67 67 integer, intent(OUT) :: typeF ! index of depth below which filling occurs 68 68 real(8), intent(INOUT) :: zdepthF 69 real(8), intent(IN) :: B 69 real(8), intent(IN) :: B 70 70 real(8), intent(OUT) :: ypp(nz), zdepthG 71 71 integer, intent(INOUT) :: typeG ! positive on input when Fgeotherm>0 … … 112 112 113 113 !-depth to shallowest perennial ice 114 typeP = -9 114 typeP = -9 115 115 do i=1,nz 116 116 if (porefill(i)>0.) then … … 157 157 endif 158 158 if (typeG>0 .and. typeT<0) then 159 call colint(porefill(:)/eta(:),z,nz,typeG-1,nz,cumfillabove) 159 call colint(porefill(:)/eta(:),z,nz,typeG-1,nz,cumfillabove) 160 160 newtypeG = -9 161 161 do i=typeG,nz … … 178 178 if (newtypeG>0) typeG=newtypeG 179 179 end if 180 ! if typeG>0, then all ice at and below typeG should be erased 180 ! if typeG>0, then all ice at and below typeG should be erased 181 181 end subroutine depths_avmeth 182 182 … … 204 204 205 205 ! advance ice table, avdrho>0 is retreat 206 if (zdepthT>=0. .and. avdrho>0.) then 206 if (zdepthT>=0. .and. avdrho>0.) then 207 207 typeP=-9999; typeT=-9999 208 208 do j=1,nz … … 226 226 endif 227 227 if (zdepthT>z(nz)) zdepthT=-9999. 228 228 229 229 ! advance interface, avdrhoP>0 is loss from zdepthP 230 230 if (avdrhoP>0.) then … … 232 232 do j=1,nz 233 233 if (typeF>0 .and. j>=typeF) exit ! don't retreat beyond typeF 234 if (zdepthT>=0. .and. z(j)>zdepthT) exit 234 if (zdepthT>=0. .and. z(j)>zdepthT) exit 235 235 call colint(porefill(1:nz)*z(1:nz),z(1:nz),nz,1,j,integ) 236 236 erase = j … … 241 241 242 242 ! new depth 243 newtypeP = -9 243 newtypeP = -9 244 244 do j=1,nz 245 245 if (zdepthT>=0. .and. z(j)>zdepthT) exit … … 253 253 ub = typeF 254 254 if (newtypeP>0 .and. typeF>0 .and. newtypeP<ub) ub=newtypeP 255 if (ub>0) then 255 if (ub>0) then 256 256 do j=ub,nz 257 257 porefill(j) = porefill(j) + B*ypp(j) -
trunk/LMDZ.COMMON/libf/evolution/changelog.txt
r3527 r3532 501 501 - Cleaning of "glaciers_mod.F90"; 502 502 - Optimization for the computation of ice density according to temperature by using a function. 503 504 == 04/12/2024 == JBC 505 Removing unecessary module/subroutine "interpol_TI_PEM2PCM.F90" + Few small corrections/cleanings. -
trunk/LMDZ.COMMON/libf/evolution/compute_soiltemp_mod.F90
r3525 r3532 4 4 !----------------------------------------------------------------------- 5 5 ! Author: LL 6 ! Purpose: This module gathers the different routines used in the PEM to compute the soil temperature evolution and initialisation. 7 ! 8 ! Note: depths of layers and mid-layers, soil thermal inertia and 6 ! Purpose: This module gathers the different routines used in the PEM to compute the soil temperature evolution and initialisation. 7 ! 8 ! Note: depths of layers and mid-layers, soil thermal inertia and 9 9 ! heat capacity are commons in comsoil_PEM.h 10 10 !----------------------------------------------------------------------- … … 12 12 !======================================================================= 13 13 14 15 16 14 SUBROUTINE compute_tsoil_pem(ngrid,nsoil,firstcall,therm_i,timestep,tsurf,tsoil) 17 15 … … 24 22 ! Author: LL 25 23 ! Purpose: Compute soil temperature using an implict 1st order scheme 26 ! 27 ! Note: depths of layers and mid-layers, soil thermal inertia and 24 ! 25 ! Note: depths of layers and mid-layers, soil thermal inertia and 28 26 ! heat capacity are commons in comsoil_PEM.h 29 27 !----------------------------------------------------------------------- … … 31 29 #include "dimensions.h" 32 30 33 !----------------------------------------------------------------------- 34 ! arguments 35 ! --------- 36 ! inputs: 37 integer, intent(in) :: ngrid ! number of (horizontal) grid-points 38 integer, intent(in) :: nsoil ! number of soil layers 39 logical, intent(in) :: firstcall ! identifier for initialization call 31 ! Inputs: 32 ! ------- 33 integer, intent(in) :: ngrid ! number of (horizontal) grid-points 34 integer, intent(in) :: nsoil ! number of soil layers 35 logical, intent(in) :: firstcall ! identifier for initialization call 40 36 real, dimension(ngrid,nsoil), intent(in) :: therm_i ! thermal inertia [SI] 41 37 real, intent(in) :: timestep ! time step [s] 42 38 real, dimension(ngrid), intent(in) :: tsurf ! surface temperature [K] 43 44 ! outputs:39 ! Outputs: 40 !--------- 45 41 real, dimension(ngrid,nsoil), intent(inout) :: tsoil ! soil (mid-layer) temperature [K] 46 ! local variables: 47 integer :: ig, ik 42 ! Local: 43 !------- 44 integer :: ig, ik 48 45 49 46 ! 0. Initialisations and preprocessing step … … 52 49 do ig = 1,ngrid 53 50 do ik = 0,nsoil - 1 54 mthermdiff_PEM(ig,ik) = therm_i(ig,ik + 1)*therm_i(ig,ik + 1)/volcapa 51 mthermdiff_PEM(ig,ik) = therm_i(ig,ik + 1)*therm_i(ig,ik + 1)/volcapa 55 52 enddo 56 53 enddo … … 64 61 enddo 65 62 66 ! 0.3 Build coefficients mu_PEM, q_{k+1/2}, d_k, alph_PEM a_k and capcal63 ! 0.3 Build coefficients mu_PEM, q_{k+1/2}, d_k, alph_PEM 67 64 ! mu_PEM 68 65 mu_PEM = mlayer_PEM(0)/(mlayer_PEM(1) - mlayer_PEM(0)) … … 99 96 ! Other layers: 100 97 do ik = 1,nsoil - 1 101 tsoil(ig,ik + 1) = alph_PEM(ig,ik)*tsoil(ig,ik) + beta_PEM(ig,ik) 98 tsoil(ig,ik + 1) = alph_PEM(ig,ik)*tsoil(ig,ik) + beta_PEM(ig,ik) 102 99 enddo 103 100 enddo … … 139 136 #include "dimensions.h" 140 137 141 !----------------------------------------------------------------------- 142 ! arguments 143 ! --------- 144 ! inputs: 138 ! Inputs: 139 !-------- 145 140 integer, intent(in) :: ngrid ! number of (horizontal) grid-points 146 141 integer, intent(in) :: nsoil ! number of soil layers 147 142 real, dimension(ngrid,nsoil), intent(in) :: therm_i ! thermal inertia [SI] 148 143 real, dimension(ngrid), intent(in) :: tsurf ! surface temperature [K] 149 150 ! outputs:144 ! Outputs: 145 !--------- 151 146 real, dimension(ngrid,nsoil), intent(inout) :: tsoil ! soil (mid-layer) temperature [K] 152 ! local variables: 147 ! Local: 148 !------- 153 149 integer :: ig, ik, iloop 154 150 … … 169 165 enddo 170 166 171 ! 0.3 Build coefficients mu_PEM, q_{k+1/2}, d_k, alph_PEM a_k and capcal167 ! 0.3 Build coefficients mu_PEM, q_{k+1/2}, d_k, alph_PEM 172 168 ! mu_PEM 173 169 mu_PEM = mlayer_PEM(0)/(mlayer_PEM(1) - mlayer_PEM(0)) … … 179 175 do ig = 1,ngrid 180 176 ! d_k 181 do ik = 1,nsoil -1177 do ik = 1,nsoil - 1 182 178 coefd_PEM(ig,ik) = thermdiff_PEM(ig,ik)/(mlayer_PEM(ik) - mlayer_PEM(ik - 1)) 183 179 enddo … … 207 203 ! 2. Compute soil temperatures 208 204 do iloop = 1,10 !just convergence 209 ! First layer: 210 do ig = 1,ngrid 211 tsoil(ig,1)=(tsurf(ig) + mu_PEM*beta_PEM(ig,1)*thermdiff_PEM(ig,1)/mthermdiff_PEM(ig,0))/ & 212 (1. + mu_PEM*(1. - alph_PEM(ig,1))*thermdiff_PEM(ig,1)/mthermdiff_PEM(ig,0)) 213 ! Other layers: 214 do ik = 1,nsoil - 1 215 tsoil(ig,ik + 1) = alph_PEM(ig,ik)*tsoil(ig,ik) + beta_PEM(ig,ik) 216 enddo 217 enddo 218 205 do ig = 1,ngrid 206 ! First layer: 207 tsoil(ig,1) = (tsurf(ig) + mu_PEM*beta_PEM(ig,1)*thermdiff_PEM(ig,1)/mthermdiff_PEM(ig,0))/ & 208 (1. + mu_PEM*(1. - alph_PEM(ig,1))*thermdiff_PEM(ig,1)/mthermdiff_PEM(ig,0)) 209 ! Other layers: 210 do ik = 1,nsoil - 1 211 tsoil(ig,ik + 1) = alph_PEM(ig,ik)*tsoil(ig,ik) + beta_PEM(ig,ik) 212 enddo 213 enddo 219 214 enddo ! iloop 220 215 -
trunk/LMDZ.COMMON/libf/evolution/comsoil_h_PEM.F90
r3161 r3532 3 3 implicit none 4 4 5 integer, parameter 6 real, allocatable, dimension(:) , save:: layer_PEM ! soil layer depths [m]7 real, allocatable, dimension(:) , save:: mlayer_PEM ! soil mid-layer depths [m]8 real, allocatable, dimension(:,:,:) , save:: TI_PEM ! soil thermal inertia [SI]9 real, allocatable, dimension(:,:) , save:: inertiedat_PEM ! soil thermal inertia saved as reference for current climate [SI]5 integer, parameter :: nsoilmx_PEM = 68 ! number of layers in the PEM 6 real, allocatable, dimension(:) :: layer_PEM ! soil layer depths [m] 7 real, allocatable, dimension(:) :: mlayer_PEM ! soil mid-layer depths [m] 8 real, allocatable, dimension(:,:,:) :: TI_PEM ! soil thermal inertia [SI] 9 real, allocatable, dimension(:,:) :: inertiedat_PEM ! soil thermal inertia saved as reference for current climate [SI] 10 10 ! Variables (FC: built in firstcall in soil.F) 11 real, allocatable, dimension(:,:,:) , save:: tsoil_PEM ! sub-surface temperatures [K]12 real, allocatable, dimension(:,:) , save:: mthermdiff_PEM ! (FC) mid-layer thermal diffusivity [SI]13 real, allocatable, dimension(:,:) , save:: thermdiff_PEM ! (FC) inter-layer thermal diffusivity [SI]14 real, allocatable, dimension(:) , save:: coefq_PEM ! (FC) q_{k+1/2} coefficients [SI]15 real, allocatable, dimension(:,:) , save:: coefd_PEM ! (FC) d_k coefficients [SI]16 real, allocatable, dimension(:,:) , save:: alph_PEM ! (FC) alpha_k coefficients [SI]17 real, allocatable, dimension(:,:) , save:: beta_PEM ! beta_k coefficients [SI]18 real , save:: mu_PEM ! mu coefficient [SI]19 real , save:: fluxgeo ! Geothermal flux [W/m^2]20 real , save:: depth_breccia ! Depth at which we have breccia [m]21 real , save:: depth_bedrock ! Depth at which we have bedrock [m]22 integer , save:: index_breccia ! last index of the depth grid before having breccia23 integer , save:: index_bedrock ! last index of the depth grid before having bedrock24 logical 25 real , save:: ini_huge_h2oice ! Initial value for huge reservoirs of H2O ice [kg/m^2]26 logical , save:: reg_thprop_dependp ! thermal properites of the regolith vary with the surface pressure11 real, allocatable, dimension(:,:,:) :: tsoil_PEM ! sub-surface temperatures [K] 12 real, allocatable, dimension(:,:) :: mthermdiff_PEM ! (FC) mid-layer thermal diffusivity [SI] 13 real, allocatable, dimension(:,:) :: thermdiff_PEM ! (FC) inter-layer thermal diffusivity [SI] 14 real, allocatable, dimension(:) :: coefq_PEM ! (FC) q_{k+1/2} coefficients [SI] 15 real, allocatable, dimension(:,:) :: coefd_PEM ! (FC) d_k coefficients [SI] 16 real, allocatable, dimension(:,:) :: alph_PEM ! (FC) alpha_k coefficients [SI] 17 real, allocatable, dimension(:,:) :: beta_PEM ! beta_k coefficients [SI] 18 real :: mu_PEM ! mu coefficient [SI] 19 real :: fluxgeo ! Geothermal flux [W/m^2] 20 real :: depth_breccia ! Depth at which we have breccia [m] 21 real :: depth_bedrock ! Depth at which we have bedrock [m] 22 integer :: index_breccia ! last index of the depth grid before having breccia 23 integer :: index_bedrock ! last index of the depth grid before having bedrock 24 logical :: soil_pem ! True by default, to run with the subsurface physic. Read in pem.def 25 real :: ini_huge_h2oice ! Initial value for huge reservoirs of H2O ice [kg/m^2] 26 logical :: reg_thprop_dependp ! thermal properites of the regolith vary with the surface pressure 27 27 28 28 !======================================================================= -
trunk/LMDZ.COMMON/libf/evolution/glaciers_mod.F90
r3527 r3532 24 24 !!! Purpose: Main for CO2 glaciers evolution: compute maximum thickness, and do 25 25 !!! the ice transfer 26 !!! 27 !!! 26 !!! 27 !!! 28 28 !!! Author: LL 29 29 !!! … … 47 47 real, dimension(ngrid,nslope), intent(inout) :: flag_co2flow ! flag to see if there is flow on the subgrid slopes 48 48 real, dimension(ngrid), intent(inout) :: flag_co2flow_mesh ! same but within the mesh 49 ! Local 49 ! Local 50 50 !------ 51 51 real, dimension(ngrid,nslope) :: Tcond ! Physical field: CO2 condensation temperature [K] 52 real, dimension(ngrid,nslope) :: hmax ! Physical x Slope field: maximum thickness for co2 glacier before flow 52 real, dimension(ngrid,nslope) :: hmax ! Physical x Slope field: maximum thickness for co2 glacier before flow 53 53 54 54 write(*,*) "Flow of CO2 glaciers" … … 67 67 !!! Purpose: Main for H2O glaciers evolution: compute maximum thickness, and do 68 68 !!! the ice transfer 69 !!! 70 !!! 69 !!! 70 !!! 71 71 !!! Author: LL 72 72 !!! … … 87 87 real, dimension(ngrid,nslope), intent(inout) :: flag_h2oflow ! flag to see if there is flow on the subgrid slopes 88 88 real, dimension(ngrid), intent(inout) :: flag_h2oflow_mesh ! same but within the mesh 89 ! Local 90 real, dimension(ngrid,nslope) :: hmax ! Physical x Slope field: maximum thickness for co2 glacier before flow 89 ! Local 90 real, dimension(ngrid,nslope) :: hmax ! Physical x Slope field: maximum thickness for co2 glacier before flow 91 91 92 92 write(*,*) "Flow of H2O glaciers" … … 111 111 !!! 112 112 !!! Purpose: Compute the maximum thickness of CO2 and H2O glaciers given a slope angle before initating flow 113 !!! 113 !!! 114 114 !!! Author: LL,based on work by A.Grau Galofre (LPG) and Isaac Smith (JGR Planets 2022) 115 115 !!! … … 222 222 endif ! co2ice > hmax 223 223 endif ! iflat 224 enddo !islope 224 enddo !islope 225 225 enddo !ig 226 226 … … 237 237 !!! 238 238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 239 239 240 240 use constants_marspem_mod, only: alpha_clap_co2,beta_clap_co2 241 241 242 implicit none 242 implicit none 243 243 244 244 ! arguments: … … 253 253 254 254 ! OUTPUT 255 real, dimension(ngrid,nslope), intent(out) :: Tcond ! Physical points: condensation temperature of CO2, yearly averaged 255 real, dimension(ngrid,nslope), intent(out) :: Tcond ! Physical points: condensation temperature of CO2, yearly averaged 256 256 257 257 ! LOCAL -
trunk/LMDZ.COMMON/libf/evolution/ice_table_mod.F90
r3527 r3532 401 401 ! Locals 402 402 ! ------ 403 integer :: ik ! Loop variables 403 integer :: ik ! Loop variables 404 404 integer :: indexice ! Index of the ice 405 405 … … 412 412 if(ice_depth < mlayer_PEM(0)) then 413 413 indexice = 0. 414 else 414 else 415 415 do ik = 0,nsoil - 2 ! go through all the layers to find the ice locations 416 416 if (mlayer_PEM(ik) <= ice_depth .and. mlayer_PEM(ik + 1) > ice_depth) then -
trunk/LMDZ.COMMON/libf/evolution/info_PEM_mod.F90
r3512 r3532 31 31 logical :: ok 32 32 integer :: cstat 33 character( 10) ::frmt33 character(50) :: info_frmt 34 34 character(20) :: ich1, ich2, ich3, ich4, fch1, fch2, fch3 35 35 … … 53 53 ! Martian date, Number of Martians years done by the PEM run, Number of Martians years done by the chainded simulation, Code of the stopping criterion 54 54 ! The conversion ratio from Planetary years to Earth years is given in the header of the file 55 write(1,*) year_bp_ini + i_myear, i_myear_leg, i_myear, stopPEM 55 info_frmt = '(f'//int2str(nb_digits(year_bp_ini + i_myear) + 5)//'.4,'//'f'//int2str(nb_digits(i_myear_leg) + 5)//'.4,'//'f'//int2str(nb_digits(i_myear) + 5)//'.4,'//'i0)' 56 write(1,trim(adjustl(info_frmt))) year_bp_ini + i_myear, i_myear_leg, i_myear, stopPEM 56 57 close(1) 57 58 else -
trunk/LMDZ.COMMON/libf/evolution/math_mod.F90
r3526 r3532 3 3 !!! 4 4 !!! Purpose: The module contains all the mathematical SUBROUTINE used in the PEM 5 !!! 5 !!! 6 6 !!! Author: Adapted from Schorgofer MSIM (N.S, Icarus 2010), impletented here by LL 7 7 !!! … … 17 17 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 18 18 !!! 19 !!! Purpose: Compute the first derivative of a function y(z) on an irregular grid 20 !!! 19 !!! Purpose: Compute the first derivative of a function y(z) on an irregular grid 20 !!! 21 21 !!! Author: From N.S (N.S, Icarus 2010), impletented here by LL 22 22 !!! … … 59 59 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 60 60 !!! 61 !!! Purpose: Compute the second derivative of a function y(z) on an irregular grid 62 !!! 61 !!! Purpose: Compute the second derivative of a function y(z) on an irregular grid 62 !!! 63 63 !!! Author: N.S (raw copy/paste from MSIM) 64 64 !!! … … 97 97 !!! 98 98 !!! Purpose: First derivative of function y(z) at z(j) one-sided derivative on irregular grid 99 !!! 99 !!! 100 100 !!! Author: N.S (raw copy/paste from MSIM) 101 101 !!! … … 128 128 !!! 129 129 !!! Purpose: Column integrates y on irregular grid 130 !!! 130 !!! 131 131 !!! Author: N.S (raw copy/paste from MSIM) 132 132 !!! 133 133 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 134 134 135 135 implicit none 136 136 137 137 integer, intent(in) :: nz, i1, i2 138 138 real, intent(in) :: y(nz), z(nz) … … 156 156 !!! 157 157 !!! Purpose: Compute the root zr, between two values y1 and y2 at depth z1,z2 158 !!! 158 !!! 159 159 !!! Author: LL 160 160 !!! -
trunk/LMDZ.COMMON/libf/evolution/pem.F90
r3527 r3532 62 62 use compute_tend_mod, only: compute_tend 63 63 use info_PEM_mod, only: info_PEM 64 use interpol_TI_PEM2PCM_mod, only: interpol_TI_PEM2PCM65 64 use nb_time_step_PCM_mod, only: nb_time_step_PCM 66 65 use pemetat0_mod, only: pemetat0 … … 298 297 call execute_command_line('squeue -j '//trim(job_id)//' -h --Format TimeLimit > tmp_cmdout.txt',cmdstat = cstat) 299 298 if (cstat /= 0) then 300 call execute_command_line('qstat -f '//trim(job_id)//' | grep "Walltime" | awk ''{print $3}'' > tmp_cmdout.txt', 299 call execute_command_line('qstat -f '//trim(job_id)//' | grep "Walltime" | awk ''{print $3}'' > tmp_cmdout.txt',cmdstat = cstat) 301 300 if (cstat > 0) then 302 301 error stop 'pem: command execution failed!' … … 939 938 do ig = 1,ngrid 940 939 do islope = 1,nslope 941 call dyn_ss_ice_m(icetable_depth(ig,islope),tsurf_avg(ig,islope),tsoil_PEM(ig,:,islope),nsoilmx_PEM,TI_PEM(ig,1,nslope),ps(ig), sum(q_h2o_PEM_phys(ig,:))/size(q_h2o_PEM_phys,2),ice_porefilling(ig,:,islope),porefill,ssi_depth)940 call dyn_ss_ice_m(icetable_depth(ig,islope),tsurf_avg(ig,islope),tsoil_PEM(ig,:,islope),nsoilmx_PEM,TI_PEM(ig,1,nslope),ps(ig),(/sum(q_h2o_PEM_phys(ig,:))/size(q_h2o_PEM_phys,2)/),ice_porefilling(ig,:,islope),porefill,ssi_depth) 942 941 icetable_depth(ig,islope) = ssi_depth 943 942 ice_porefilling(ig,:,islope) = porefill … … 961 960 do ig = 1,ngrid 962 961 do islope = 1,nslope 963 do l = 1,nsoilmx_PEM 962 do l = 1,nsoilmx_PEM 964 963 if (l == 1) then 965 964 totmassco2_adsorbded = totmassco2_adsorbded + co2_adsorbded_phys(ig,l,islope)*(layer_PEM(l))* & … … 1008 1007 call writediagsoilpem(ngrid,'co2_ads_slope'//str2,'co2_ads','K',3,co2_adsorbded_phys(:,:,islope)) 1009 1008 call writediagsoilpem(ngrid,'h2o_ads_slope'//str2,'h2o_ads','K',3,h2o_adsorbded_phys(:,:,islope)) 1010 endif 1009 endif 1011 1010 endif 1012 1011 enddo … … 1101 1100 ! III_a.2 Tsoil update (for startfi) 1102 1101 if (soil_pem) then 1103 call interpol_TI_PEM2PCM(ngrid,nslope,nsoilmx_PEM,nsoilmx,TI_PEM,inertiesoil)1102 inertiesoil = TI_PEM(:,:nsoilmx,:) 1104 1103 tsoil = tsoil_PEM(:,1:nsoilmx,:) + tsoil_anom(:,:,:,timelen) 1105 1104 #ifndef CPP_STD -
trunk/LMDZ.COMMON/libf/evolution/pemetat0.F90
r3525 r3532 45 45 real, intent(in) :: global_avg_pressure ! mean average pressure on the planet [Pa] 46 46 real, dimension(ngrid,nslope), intent(in) :: tsurf_avg_yr1 ! surface temperature at the first year of PCM call [K] 47 real, dimension(ngrid,nslope), intent(in) :: tsurf_avg_yr2 ! surface temperature at the second 47 real, dimension(ngrid,nslope), intent(in) :: tsurf_avg_yr2 ! surface temperature at the second year of PCM call [K] 48 48 real, dimension(ngrid,timelen), intent(in) :: q_co2 ! MMR tracer co2 [kg/kg] 49 49 real, dimension(ngrid,timelen), intent(in) :: q_h2o ! MMR tracer h2o [kg/kg] … … 281 281 call compute_tsoil_pem(ngrid,nsoil_PEM,.true.,TI_PEM(:,:,islope),timestep,tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) 282 282 else 283 ! predictor corrector: restart from year 1 of the PCM and build the evolution of 284 ! tsoil at depth 283 ! predictor corrector: restart from year 1 of the PCM and build the evolution of tsoil at depth 285 284 tsoil_tmp_yr1(:,:,islope) = tsoil_startPEM(:,:,islope) 286 285 call compute_tsoil_pem(ngrid,nsoil_PEM,.true.,TI_PEM(:,:,islope),timestep,tsurf_avg_yr1(:,islope),tsoil_tmp_yr1(:,:,islope)) … … 289 288 call compute_tsoil_pem(ngrid,nsoil_PEM,.false.,TI_PEM(:,:,islope),timestep,tsurf_avg_yr2(:,islope),tsoil_tmp_yr2(:,:,islope)) 290 289 291 do iloop = nsoil_PCM +1,nsoil_PEM290 do iloop = nsoil_PCM + 1,nsoil_PEM 292 291 tsoil_PEM(:,iloop,islope) = tsoil_tmp_yr2(:,iloop,islope) 293 292 enddo … … 295 294 296 295 do it = 1,timelen 297 do isoil = nsoil_PCM+1,nsoil_PEM 298 tsoil_inst(:,isoil,islope,it) = tsoil_PEM(:,isoil,islope) 299 enddo 300 enddo 301 do isoil = nsoil_PCM+1,nsoil_PEM 302 do ig = 1,ngrid 303 watersoil_avg(ig,isoil,islope) = exp(beta_clap_h2o/tsoil_PEM(ig,isoil,islope) + alpha_clap_h2o)/tsoil_PEM(ig,isoil,islope)*mmol(igcm_h2o_vap)/(mugaz*r) 304 enddo 296 tsoil_inst(:,nsoil_PCM + 1:nsoil_PEM,islope,it) = tsoil_PEM(:,nsoil_PCM + 1:nsoil_PEM,islope) 297 enddo 298 do isoil = nsoil_PCM + 1,nsoil_PEM 299 watersoil_avg(:,isoil,islope) = exp(beta_clap_h2o/tsoil_PEM(:,isoil,islope) + alpha_clap_h2o)/tsoil_PEM(:,isoil,islope)*mmol(igcm_h2o_vap)/(mugaz*r) 305 300 enddo 306 301 enddo ! islope … … 314 309 write(*,*)'PEM settings: failed loading <ice_table_depth>' 315 310 write(*,*)'will reconstruct the values of the ice table given the current state' 316 call computeice_table_equilibrium(ngrid,nslope,nsoil_PEM,watercaptag,watersurf_avg,watersoil_avg, 311 call computeice_table_equilibrium(ngrid,nslope,nsoil_PEM,watercaptag,watersurf_avg,watersoil_avg,TI_PEM(:,1,:),ice_table_depth,ice_table_thickness) 317 312 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 313 do islope = 1,nslope … … 322 317 write(*,*) 'PEMETAT0: ICE TABLE done' 323 318 else if (icetable_dynamic) then 319 call get_field("ice_porefilling",ice_porefilling,found) 320 if (.not. found) then 321 write(*,*)'PEM settings: failed loading <ice_porefilling>' 322 ice_porefilling = 0. 323 endif 324 324 call get_field("ice_table_depth",ice_table_depth,found) 325 325 if (.not. found) then … … 331 331 call ini_tsoil_pem(ngrid,nsoil_PEM,TI_PEM(:,:,islope),tsurf_avg_yr2(:,islope),tsoil_PEM(:,:,islope)) 332 332 enddo 333 endif334 call get_field("ice_porefilling",ice_porefilling,found)335 if (.not. found) then336 write(*,*)'PEM settings: failed loading <ice_porefilling>'337 ice_porefilling = 1.338 333 endif 339 334 write(*,*) 'PEMETAT0: ICE TABLE done' … … 510 505 write(*,*) 'PEMETAT0: Ice table done' 511 506 else if (icetable_dynamic) then 512 ice_porefilling = 1.507 ice_porefilling = 0. 513 508 ice_table_depth = -9999. 514 509 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) … … 518 513 write(*,*) 'PEMETAT0: Ice table done' 519 514 endif 520 515 521 516 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 522 517 !d) Regolith adsorbed -
trunk/LMDZ.COMMON/libf/evolution/recomp_tend_co2_slope_mod.F90
r3498 r3532 41 41 42 42 write(*,*) "Update of the CO2 tendency from the current pressure" 43 43 44 44 ! Evolution of the water ice for each physical point 45 45 do i = 1,ngrid -
trunk/LMDZ.COMMON/libf/evolution/soil_settings_PEM_mod.F90
r3206 r3532 15 15 16 16 !======================================================================= 17 ! Author: LL, based on work by 17 ! Author: LL, based on work by Ehouarn Millour (07/2006) 18 18 ! 19 19 ! Purpose: Read and/or initialise soil depths and properties … … 53 53 alpha = 2 54 54 do iloop = 0,nsoil_PCM - 1 55 mlayer_PEM(iloop) = lay1*(1 +iloop**2.9*(1-exp(-real(iloop)/20.)))55 mlayer_PEM(iloop) = lay1*(1 + iloop**2.9*(1 - exp(-real(iloop)/20.))) 56 56 enddo 57 57 58 do iloop = 0, nsoil_PEM-159 if(lay1*(alpha**(iloop-0.5)) > mlayer_PEM(nsoil_PCM -1)) then58 do iloop = 0,nsoil_PEM - 1 59 if(lay1*(alpha**(iloop-0.5)) > mlayer_PEM(nsoil_PCM - 1)) then 60 60 index_powerlaw = iloop 61 61 exit … … 63 63 enddo 64 64 65 do iloop = nsoil_PCM, nsoil_PEM-166 mlayer_PEM(iloop) = lay1*(alpha**(index_powerlaw + (iloop -nsoil_PCM)-0.5))65 do iloop = nsoil_PCM,nsoil_PEM - 1 66 mlayer_PEM(iloop) = lay1*(alpha**(index_powerlaw + (iloop - nsoil_PCM) - 0.5)) 67 67 enddo 68 68 69 69 ! Build layer_PEM() 70 do iloop =1,nsoil_PEM-171 layer_PEM(iloop) =(mlayer_PEM(iloop)+mlayer_PEM(iloop-1))/2.70 do iloop = 1,nsoil_PEM - 1 71 layer_PEM(iloop) = (mlayer_PEM(iloop) + mlayer_PEM(iloop - 1))/2. 72 72 enddo 73 layer_PEM(nsoil_PEM) =2*mlayer_PEM(nsoil_PEM-1) - mlayer_PEM(nsoil_PEM-2)73 layer_PEM(nsoil_PEM) = 2*mlayer_PEM(nsoil_PEM - 1) - mlayer_PEM(nsoil_PEM - 2) 74 74 75 75 -
trunk/LMDZ.COMMON/libf/evolution/writediagpem.F90
r3512 r3532 680 680 call abort_physic("writediagsoilpem","firstname too short",1) 681 681 endif 682 682 683 683 ! Set output sample rate 684 684 isample = int(ecritpem) ! same as for diagpem outputs 685 685 686 686 ! Create output NetCDF file 687 687 if (is_master) then … … 724 724 enddo 725 725 endif 726 726 727 727 ! write "header" of file (longitudes, latitudes, geopotential, ...) 728 728 if (klon_glo>1) then ! general 3D case … … 733 733 734 734 endif ! of if (is_master) 735 735 736 736 ! set zitau to -1 to be compatible with zitau incrementation step below 737 737 zitau=-1 738 738 739 739 else 740 740 ! If not an initialization call, simply open the NetCDF file … … 757 757 ntime=ntime+1 758 758 date = float(zitau + 1) 759 759 760 760 if (is_master) then 761 761 ! Get NetCDF ID for "time" … … 769 769 if (ierr.ne.NF_NOERR) then 770 770 write(*,*)"writediagsoilpem: Failed writing date to time variable" 771 call abort_physic("writediagsoilpem","failed writing time",1) 771 call abort_physic("writediagsoilpem","failed writing time",1) 772 772 endif 773 773 endif ! of if (is_master) … … 810 810 data3_1d(1,1:nsoilmx_PEM)=px(1,1:nsoilmx_PEM) 811 811 endif 812 812 813 813 ! B. Write (append) the variable to the NetCDF file 814 814 if (is_master) then … … 828 828 call def_var(nid,name,title,units,4,id,varid,ierr) 829 829 endif ! of if (ierr.ne.NF_NOERR) 830 830 831 831 ! B.2. Prepare things to be able to write/append the variable 832 832 corners(1)=1 … … 834 834 corners(3)=1 835 835 corners(4)=ntime 836 836 837 837 if (klon_glo==1) then 838 838 edges(1)=1 … … 843 843 edges(3)=nsoilmx_PEM 844 844 edges(4)=1 845 845 846 846 ! B.3. Write the slab of data 847 847 !#ifdef NC_DOUBLE … … 917 917 corners(2)=1 918 918 corners(3)=ntime 919 919 920 920 if (klon_glo==1) then 921 921 edges(1)=1 … … 925 925 edges(2)=nbp_lat 926 926 edges(3)=1 927 927 928 928 ! B.3. Write the slab of data 929 929 !#ifdef NC_DOUBLE … … 966 966 ! B.2. Prepare things to be able to write/append the variable 967 967 corners(1)=ntime 968 968 969 969 edges(1)=1 970 970
Note: See TracChangeset
for help on using the changeset viewer.