4 SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, &
5 ptsoil, pcapcal, pfluxgrd)
61 REAL,
INTENT(IN) :: ptimestep
62 INTEGER,
INTENT(IN) :: indice, knon
63 REAL,
DIMENSION(klon),
INTENT(IN) :: snow
64 REAL,
DIMENSION(klon),
INTENT(IN) :: ptsrf
66 REAL,
DIMENSION(klon,nsoilmx),
INTENT(INOUT) :: ptsoil
67 REAL,
DIMENSION(klon),
INTENT(OUT) :: pcapcal
68 REAL,
DIMENSION(klon),
INTENT(OUT) :: pfluxgrd
73 INTEGER :: ig, jk, ierr
74 REAL :: min_period,dalph_soil
75 REAL,
DIMENSION(nsoilmx) :: zdz2
77 REAL,
DIMENSION(klon) :: ztherm_i
78 REAL,
DIMENSION(klon,nsoilmx,nbsrf) :: C_coef, D_coef
84 REAL,
DIMENSION(nsoilmx),
SAVE :: dz1, dz2
86 LOGICAL,
SAVE :: firstcall=.
true.
92 REAL fz,rk,fz1,rk1,rk2
93 fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
110 IF (is_mpi_root)
THEN
111 OPEN(99,file=
'soil.def',status=
'old',form=
'formatted',iostat=ierr)
113 READ(99,*) min_period
114 READ(99,*) dalph_soil
115 WRITE(
lunout,*)
'Discretization for the soil model'
116 WRITE(
lunout,*)
'First level e-folding depth',min_period, &
122 CALL bcast(min_period)
123 CALL bcast(dalph_soil)
126 fz1=sqrt(min_period/3.14)
131 dz2(jk)=fz(rk1)-fz(rk2)
136 dz1(jk)=1./(fz(rk1)-fz(rk2))
139 WRITE(
lunout,*)
'full layers, intermediate layers (seconds)'
145 fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
159 IF (indice ==
is_sic)
THEN
161 ztherm_i(ig) = inertie_ice
164 ELSE IF (indice ==
is_lic)
THEN
166 ztherm_i(ig) = inertie_ice
169 ELSE IF (indice ==
is_ter)
THEN
174 ELSE IF (indice ==
is_oce)
THEN
176 ztherm_i(ig) = inertie_ice
179 WRITE(
lunout,*)
"valeur d indice non prevue", indice
193 zdz2(jk)=dz2(jk)/ptimestep
197 z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
198 c_coef(ig,nsoilmx-1,indice)= &
199 zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
200 d_coef(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1s
205 z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
206 *(1.-d_coef(ig,jk,indice)))
207 c_coef(ig,jk-1,indice)= &
208 (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*c_coef(ig,jk,indice)) * z1s
209 d_coef(ig,jk-1,indice)=dz1(jk-1)*z1s
222 ptsoil(ig,1)=(lambda*c_coef(ig,1,indice)+ptsrf(ig))/ &
223 (lambda*(1.-d_coef(ig,1,indice))+1.)
229 ptsoil(ig,jk+1)=c_coef(ig,jk,indice)+d_coef(ig,jk,indice) &
234 IF (indice ==
is_sic)
THEN
236 ptsoil(ig,nsoilmx) = rtt - 1.8
246 z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
247 c_coef(ig,nsoilmx-1,indice) = zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
248 d_coef(ig,nsoilmx-1,indice) = dz1(nsoilmx-1)/z1s
253 z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
254 *(1.-d_coef(ig,jk,indice)))
255 c_coef(ig,jk-1,indice) = &
256 (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*c_coef(ig,jk,indice)) * z1s
257 d_coef(ig,jk-1,indice) = dz1(jk-1)*z1s
267 pfluxgrd(ig) = ztherm_i(ig)*dz1(1)* &
268 (c_coef(ig,1,indice)+(d_coef(ig,1,indice)-1.)*ptsoil(ig,1))
269 pcapcal(ig) = ztherm_i(ig)* &
270 (dz2(1)+ptimestep*(1.-d_coef(ig,1,indice))*dz1(1))
271 z1s = lambda*(1.-d_coef(ig,1,indice))+1.
272 pcapcal(ig) = pcapcal(ig)/z1s
273 pfluxgrd(ig) = pfluxgrd(ig) &
274 + pcapcal(ig) * (ptsoil(ig,1) * z1s &
275 - lambda * c_coef(ig,1,indice) &
!IM Implemente en modes sequentiel et parallele CALL rlon_glo CALL bcast(rlon_glo)!$OMP MASTER if(is_mpi_root) then!zstophy
integer, parameter is_ter
!$Id!common comsoil inertie_sno
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
integer, parameter is_lic
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
integer, parameter is_sic
subroutine abort_physic(modname, message, ierr)
integer, parameter is_oce
!$Id!common comsoil inertie_sol
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
subroutine soil(ptimestep, indice, knon, snow, ptsrf, ptsoil, pcapcal, pfluxgrd)