LMDZ
soil.F90
Go to the documentation of this file.
1 !
2 ! $Id: soil.F90 2311 2015-06-25 07:45:24Z emillour $
3 !
4 SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, &
5  ptsoil, pcapcal, pfluxgrd)
6 
7  USE dimphy
10  USE print_control_mod, ONLY: lunout
11 
12  IMPLICIT NONE
13 
14 !=======================================================================
15 !
16 ! Auteur: Frederic Hourdin 30/01/92
17 ! -------
18 !
19 ! Object: Computation of : the soil temperature evolution
20 ! ------- the surfacic heat capacity "Capcal"
21 ! the surface conduction flux pcapcal
22 !
23 !
24 ! Method: Implicit time integration
25 ! -------
26 ! Consecutive ground temperatures are related by:
27 ! T(k+1) = C(k) + D(k)*T(k) (*)
28 ! The coefficients C and D are computed at the t-dt time-step.
29 ! Routine structure:
30 ! 1) C and D coefficients are computed from the old temperature
31 ! 2) new temperatures are computed using (*)
32 ! 3) C and D coefficients are computed from the new temperature
33 ! profile for the t+dt time-step
34 ! 4) the coefficients A and B are computed where the diffusive
35 ! fluxes at the t+dt time-step is given by
36 ! Fdiff = A + B Ts(t+dt)
37 ! or Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
38 ! with F0 = A + B (Ts(t))
39 ! Capcal = B*dt
40 !
41 ! Interface:
42 ! ----------
43 !
44 ! Arguments:
45 ! ----------
46 ! ptimestep physical timestep (s)
47 ! indice sub-surface index
48 ! snow(klon) snow
49 ! ptsrf(klon) surface temperature at time-step t (K)
50 ! ptsoil(klon,nsoilmx) temperature inside the ground (K)
51 ! pcapcal(klon) surfacic specific heat (W*m-2*s*K-1)
52 ! pfluxgrd(klon) surface diffusive flux from ground (Wm-2)
53 !
54 !=======================================================================
55  include "YOMCST.h"
56  include "dimsoil.h"
57  include "comsoil.h"
58 !-----------------------------------------------------------------------
59 ! Arguments
60 ! ---------
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
65 
66  REAL, DIMENSION(klon,nsoilmx), INTENT(INOUT) :: ptsoil
67  REAL, DIMENSION(klon), INTENT(OUT) :: pcapcal
68  REAL, DIMENSION(klon), INTENT(OUT) :: pfluxgrd
69 
70 !-----------------------------------------------------------------------
71 ! Local variables
72 ! ---------------
73  INTEGER :: ig, jk, ierr
74  REAL :: min_period,dalph_soil
75  REAL, DIMENSION(nsoilmx) :: zdz2
76  REAL :: z1s
77  REAL, DIMENSION(klon) :: ztherm_i
78  REAL, DIMENSION(klon,nsoilmx,nbsrf) :: C_coef, D_coef
79 
80 ! Local saved variables
81 ! ---------------------
82  REAL, SAVE :: lambda
83 !$OMP THREADPRIVATE(lambda)
84  REAL, DIMENSION(nsoilmx), SAVE :: dz1, dz2
85 !$OMP THREADPRIVATE(dz1,dz2)
86  LOGICAL, SAVE :: firstcall=.true.
87 !$OMP THREADPRIVATE(firstcall)
88 
89 !-----------------------------------------------------------------------
90 ! Depthts:
91 ! --------
92  REAL fz,rk,fz1,rk1,rk2
93  fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
94 
95 
96 !-----------------------------------------------------------------------
97 ! Calculation of some constants
98 ! NB! These constants do not depend on the sub-surfaces
99 !-----------------------------------------------------------------------
100 
101  IF (firstcall) THEN
102 !-----------------------------------------------------------------------
103 ! ground levels
104 ! grnd=z/l where l is the skin depth of the diurnal cycle:
105 !-----------------------------------------------------------------------
106 
107  min_period=1800. ! en secondes
108  dalph_soil=2. ! rapport entre les epaisseurs de 2 couches succ.
109 !$OMP MASTER
110  IF (is_mpi_root) THEN
111  OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
112  IF (ierr == 0) THEN ! Read file only if it exists
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, &
117  ' dalph',dalph_soil
118  CLOSE(99)
119  END IF
120  ENDIF
121 !$OMP END MASTER
122  CALL bcast(min_period)
123  CALL bcast(dalph_soil)
124 
125 ! la premiere couche represente un dixieme de cycle diurne
126  fz1=sqrt(min_period/3.14)
127 
128  DO jk=1,nsoilmx
129  rk1=jk
130  rk2=jk-1
131  dz2(jk)=fz(rk1)-fz(rk2)
132  ENDDO
133  DO jk=1,nsoilmx-1
134  rk1=jk+.5
135  rk2=jk-.5
136  dz1(jk)=1./(fz(rk1)-fz(rk2))
137  ENDDO
138  lambda=fz(.5)*dz1(1)
139  WRITE(lunout,*)'full layers, intermediate layers (seconds)'
140  DO jk=1,nsoilmx
141  rk=jk
142  rk1=jk+.5
143  rk2=jk-.5
144  WRITE(lunout,*)'fz=', &
145  fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
146  ENDDO
147 
148  firstcall =.false.
149  END IF
150 
151 
152 !-----------------------------------------------------------------------
153 ! Calcul de l'inertie thermique a partir de la variable rnat.
154 ! on initialise a inertie_ice meme au-dessus d'un point de mer au cas
155 ! ou le point de mer devienne point de glace au pas suivant
156 ! on corrige si on a un point de terre avec ou sans glace
157 !
158 !-----------------------------------------------------------------------
159  IF (indice == is_sic) THEN
160  DO ig = 1, knon
161  ztherm_i(ig) = inertie_ice
162  IF (snow(ig) > 0.0) ztherm_i(ig) = inertie_sno
163  ENDDO
164  ELSE IF (indice == is_lic) THEN
165  DO ig = 1, knon
166  ztherm_i(ig) = inertie_ice
167  IF (snow(ig) > 0.0) ztherm_i(ig) = inertie_sno
168  ENDDO
169  ELSE IF (indice == is_ter) THEN
170  DO ig = 1, knon
171  ztherm_i(ig) = inertie_sol
172  IF (snow(ig) > 0.0) ztherm_i(ig) = inertie_sno
173  ENDDO
174  ELSE IF (indice == is_oce) THEN
175  DO ig = 1, knon
176  ztherm_i(ig) = inertie_ice
177  ENDDO
178  ELSE
179  WRITE(lunout,*) "valeur d indice non prevue", indice
180  call abort_physic("soil", "", 1)
181  ENDIF
182 
183 
184 !-----------------------------------------------------------------------
185 ! 1)
186 ! Calculation of Cgrf and Dgrd coefficients using soil temperature from
187 ! previous time step.
188 !
189 ! These variables are recalculated on the local compressed grid instead
190 ! of saved in restart file.
191 !-----------------------------------------------------------------------
192  DO jk=1,nsoilmx
193  zdz2(jk)=dz2(jk)/ptimestep
194  ENDDO
195 
196  DO ig=1,knon
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
201  ENDDO
202 
203  DO jk=nsoilmx-1,2,-1
204  DO ig=1,knon
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
210  ENDDO
211  ENDDO
212 
213 !-----------------------------------------------------------------------
214 ! 2)
215 ! Computation of the soil temperatures using the Cgrd and Dgrd
216 ! coefficient computed above
217 !
218 !-----------------------------------------------------------------------
219 
220 ! Surface temperature
221  DO ig=1,knon
222  ptsoil(ig,1)=(lambda*c_coef(ig,1,indice)+ptsrf(ig))/ &
223  (lambda*(1.-d_coef(ig,1,indice))+1.)
224  ENDDO
225 
226 ! Other temperatures
227  DO jk=1,nsoilmx-1
228  DO ig=1,knon
229  ptsoil(ig,jk+1)=c_coef(ig,jk,indice)+d_coef(ig,jk,indice) &
230  *ptsoil(ig,jk)
231  ENDDO
232  ENDDO
233 
234  IF (indice == is_sic) THEN
235  DO ig = 1 , knon
236  ptsoil(ig,nsoilmx) = rtt - 1.8
237  END DO
238  ENDIF
239 
240 !-----------------------------------------------------------------------
241 ! 3)
242 ! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil
243 ! temperature
244 !-----------------------------------------------------------------------
245  DO ig=1,knon
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
249  ENDDO
250 
251  DO jk=nsoilmx-1,2,-1
252  DO ig=1,knon
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
258  ENDDO
259  ENDDO
260 
261 !-----------------------------------------------------------------------
262 ! 4)
263 ! Computation of the surface diffusive flux from ground and
264 ! calorific capacity of the ground
265 !-----------------------------------------------------------------------
266  DO ig=1,knon
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) &
276  - ptsrf(ig)) &
277  /ptimestep
278  ENDDO
279 
280 END SUBROUTINE soil
!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
Definition: comsoil.h:5
!$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
Definition: calcul_STDlev.h:26
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)
Definition: abort_physic.F90:3
Definition: dimphy.F90:1
integer, parameter is_oce
!$Id!common comsoil inertie_sol
Definition: comsoil.h:5
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
subroutine soil(ptimestep, indice, knon, snow, ptsrf, ptsoil, pcapcal, pfluxgrd)
Definition: soil.F90:6