source: LMDZ6/trunk/libf/phylmd/soil.f90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 3 hours ago

Replace yomcst.h by existing module

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.7 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, qsol, &
5     lon, lat, ptsoil, pcapcal, pfluxgrd)
6 
7  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
8          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
9          , R_ecc, R_peri, R_incl                                      &
10          , RA, RG, R1SA                                         &
11          , RSIGMA                                                     &
12          , R, RMD, RMV, RD, RV, RCPD                    &
13          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
14          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
15          , RCW, RCS                                                 &
16          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
17          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
18          , RALPD, RBETD, RGAMD
19  USE dimphy
20  USE mod_phys_lmdz_para
21  USE indice_sol_mod
22  USE print_control_mod, ONLY: lunout
23  USE dimsoil_mod_h, ONLY: nsoilmx
24
25  IMPLICIT NONE
26
27!=======================================================================
28!
29!   Auteur:  Frederic Hourdin     30/01/92
30!   -------
31!
32!   Object:  Computation of : the soil temperature evolution
33!   -------                   the surfacic heat capacity "Capcal"
34!                            the surface conduction flux pcapcal
35!
36!   Update: 2021/07 : soil thermal inertia, formerly a constant value,
37!   ------   can also be now a function of soil moisture (F Cheruy's idea)
38!            depending on iflag_inertie, read from physiq.def via conf_phys_m.F90
39!            ("Stage L3" Eve Rebouillat, with E Vignon, A Sima, F Cheruy)
40!
41!   Method: Implicit time integration
42!   -------
43!   Consecutive ground temperatures are related by:
44!           T(k+1) = C(k) + D(k)*T(k)  (*)
45!   The coefficients C and D are computed at the t-dt time-step.
46!   Routine structure:
47!   1) C and D coefficients are computed from the old temperature
48!   2) new temperatures are computed using (*)
49!   3) C and D coefficients are computed from the new temperature
50!      profile for the t+dt time-step
51!   4) the coefficients A and B are computed where the diffusive
52!      fluxes at the t+dt time-step is given by
53!             Fdiff = A + B Ts(t+dt)
54!      or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
55!             with F0 = A + B (Ts(t))
56!                 Capcal = B*dt
57!
58!   Interface:
59!   ----------
60!
61!   Arguments:
62!   ----------
63!   ptimestep            physical timestep (s)
64!   indice               sub-surface index
65!   snow(klon)           snow
66!   ptsrf(klon)          surface temperature at time-step t (K)
67!   qsol(klon)           soil moisture (kg/m2 or mm)
68!   lon(klon)            longitude in radian
69!   lat(klon)            latitude in radian
70!   ptsoil(klon,nsoilmx) temperature inside the ground (K)
71!   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
72!   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)
73!
74!=======================================================================
75  INCLUDE "comsoil.h"
76!-----------------------------------------------------------------------
77! Arguments
78! ---------
79  REAL, INTENT(IN)                     :: ptimestep
80  INTEGER, INTENT(IN)                  :: indice, knon !, knindex
81  REAL, DIMENSION(klon), INTENT(IN)    :: snow
82  REAL, DIMENSION(klon), INTENT(IN)    :: ptsrf
83  REAL, DIMENSION(klon), INTENT(IN)    :: qsol
84  REAL, DIMENSION(klon), INTENT(IN)    :: lon
85  REAL, DIMENSION(klon), INTENT(IN)    :: lat
86
87  REAL, DIMENSION(klon,nsoilmx), INTENT(INOUT) :: ptsoil
88  REAL, DIMENSION(klon), INTENT(OUT)           :: pcapcal
89  REAL, DIMENSION(klon), INTENT(OUT)           :: pfluxgrd
90
91!-----------------------------------------------------------------------
92! Local variables
93! ---------------
94  INTEGER                             :: ig, jk, ierr
95  REAL                                :: min_period,dalph_soil
96  REAL, DIMENSION(nsoilmx)            :: zdz2
97  REAL                                :: z1s
98  REAL, DIMENSION(klon)               :: ztherm_i
99  REAL, DIMENSION(klon,nsoilmx,nbsrf) :: C_coef, D_coef
100
101! Local saved variables
102! ---------------------
103  REAL, SAVE                     :: lambda
104!$OMP THREADPRIVATE(lambda)
105  REAL, DIMENSION(nsoilmx), SAVE :: dz1, dz2
106!$OMP THREADPRIVATE(dz1,dz2)
107  LOGICAL, SAVE                  :: firstcall=.TRUE.
108!$OMP THREADPRIVATE(firstcall)
109   
110!-----------------------------------------------------------------------
111!   Depthts:
112!   --------
113  REAL fz,rk,fz1,rk1,rk2
114  fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
115
116
117!-----------------------------------------------------------------------
118! Calculation of some constants
119! NB! These constants do not depend on the sub-surfaces
120!-----------------------------------------------------------------------
121
122  IF (firstcall) THEN
123!-----------------------------------------------------------------------
124!   ground levels
125!   grnd=z/l where l is the skin depth of the diurnal cycle:
126!-----------------------------------------------------------------------
127
128     min_period=1800. ! en secondes
129     dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
130!$OMP MASTER
131     IF (is_mpi_root) THEN
132        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
133        IF (ierr == 0) THEN ! Read file only if it exists
134           READ(99,*) min_period
135           READ(99,*) dalph_soil
136           WRITE(lunout,*)'Discretization for the soil model'
137           WRITE(lunout,*)'First level e-folding depth',min_period, &
138                '   dalph',dalph_soil
139           CLOSE(99)
140        END IF
141     ENDIF
142!$OMP END MASTER
143     CALL bcast(min_period)
144     CALL bcast(dalph_soil)
145
146!   la premiere couche represente un dixieme de cycle diurne
147     fz1=SQRT(min_period/3.14)
148     
149     DO jk=1,nsoilmx
150        rk1=jk
151        rk2=jk-1
152        dz2(jk)=fz(rk1)-fz(rk2)
153     ENDDO
154     DO jk=1,nsoilmx-1
155        rk1=jk+.5
156        rk2=jk-.5
157        dz1(jk)=1./(fz(rk1)-fz(rk2))
158     ENDDO
159     lambda=fz(.5)*dz1(1)
160     WRITE(lunout,*)'full layers, intermediate layers (seconds)'
161     DO jk=1,nsoilmx
162        rk=jk
163        rk1=jk+.5
164        rk2=jk-.5
165        WRITE(lunout,*)'fz=', &
166             fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
167     ENDDO
168
169     firstcall =.FALSE.
170  END IF
171
172
173!-----------------------------------------------------------------------
174!   Calcul de l'inertie thermique a partir de la variable rnat.
175!   on initialise a inertie_sic meme au-dessus d'un point de mer au cas
176!   ou le point de mer devienne point de glace au pas suivant
177!   on corrige si on a un point de terre avec ou sans glace
178!
179!   iophys can be used to write the ztherm_i variable in a phys.nc file
180!   and check the results; to do so, add "CALL iophys_ini" in physiq_mod
181!   and add knindex to the list of inputs in all the calls to soil.F90
182!   (and to soil.F90 itself !)
183!-----------------------------------------------------------------------
184
185  IF (indice == is_sic) THEN
186     DO ig = 1, knon
187        ztherm_i(ig)   = inertie_sic
188     ENDDO
189     IF (iflag_sic == 0) THEN
190       DO ig = 1, knon
191         IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
192       ENDDO
193!      Otherwise sea-ice keeps the same inertia, even when covered by snow
194     ENDIF
195!    CALL iophys_ecrit_index('ztherm_sic', 1, 'ztherm_sic', 'USI', &
196!      knon, knindex, ztherm_i)
197  ELSE IF (indice == is_lic) THEN
198     DO ig = 1, knon
199        ztherm_i(ig)   = inertie_lic
200        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
201     ENDDO
202!    CALL iophys_ecrit_index('ztherm_lic', 1, 'ztherm_lic', 'USI', &
203!      knon, knindex, ztherm_i)
204  ELSE IF (indice == is_ter) THEN
205     !
206     ! La relation entre l'inertie thermique du sol et qsol change d'apres
207     !   iflag_inertie, defini dans physiq.def, et appele via comsoil.h
208     !
209     DO ig = 1, knon
210        ! iflag_inertie=0 correspond au cas inertie=constant, comme avant
211        IF (iflag_inertie==0) THEN         
212           ztherm_i(ig)   = inertie_sol
213        ELSE IF (iflag_inertie == 1) THEN
214          ! I = a_qsol * qsol + b  modele lineaire deduit d'une
215          ! regression lineaire I = a_mrsos * mrsos + b obtenue sur
216          ! sorties MO d'une simulation LMDZOR(CMIP6) sur l'annee 2000
217          ! sur tous les points avec frac_snow=0
218          ! Difference entre qsol et mrsos prise en compte par un
219          ! facteur d'echelle sur le coefficient directeur de regression:
220          ! fact = 35./150. = mrsos_max/qsol_max
221          ! et a_qsol = a_mrsos * fact (car a = dI/dHumidite)
222            ztherm_i(ig) = 30.0 *35.0/150.0 *qsol(ig) +770.0
223          ! AS : pour qsol entre 0 - 150, on a I entre 770 - 1820
224        ELSE IF (iflag_inertie == 2) THEN
225          ! deux regressions lineaires, sur les memes sorties, 
226          ! distinguant le type de sol : sable ou autre (limons/argile)
227          ! Implementation simple : regression type "sable" seulement pour
228          ! Sahara, defini par une "boite" lat/lon (NB : en radians !! )
229          IF (lon(ig)>-0.35 .AND. lon(ig)<0.70 .AND. lat(ig)>0.17 .AND. lat(ig)<0.52) THEN
230              ! Valeurs theoriquement entre 728 et 2373 ; qsol valeurs basses
231              ztherm_i(ig) = 47. *35.0/150.0 *qsol(ig) +728.  ! boite type "sable" pour Sahara
232          ELSE
233              ! Valeurs theoriquement entre 550 et 1940 ; qsol valeurs moyennes et hautes
234              ztherm_i(ig) = 41. *35.0/150.0 *qsol(ig) +505.
235          ENDIF
236        ELSE IF (iflag_inertie == 3) THEN
237          ! AS : idee a tester :
238          ! si la relation doit etre une droite,
239          ! definissons-la en fonction des valeurs min et max de qsol (0:150),
240          ! et de l'inertie (900 : 2000 ou 2400 ; choix ici: 2000)
241          ! I = I_min + qsol * (I_max - I_min)/(qsol_max - qsol_min)
242              ztherm_i(ig) = 900. + qsol(ig) * (2000. - 900.)/150.
243        ELSE         
244          WRITE (lunout,*) "Le choix iflag_inertie = ",iflag_inertie," n'est pas defini. Veuillez choisir un entier entre 0 et 3"
245        ENDIF
246     !
247     ! Fin de l'introduction de la relation entre l'inertie thermique du sol et qsol
248     !-------------------------------------------
249        !AS : donc le moindre flocon de neige sur un point de grid
250        ! fait que l'inertie du point passe a la valeur pour neige !
251        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
252       
253     ENDDO
254!    CALL iophys_ecrit_index('ztherm_ter', 1, 'ztherm_ter', 'USI', &
255!      knon, knindex, ztherm_i)
256  ELSE IF (indice == is_oce) THEN
257     DO ig = 1, knon
258!       This is just in case, but SST should be used by the model anyway
259        ztherm_i(ig)   = inertie_sic
260     ENDDO
261!    CALL iophys_ecrit_index('ztherm_oce', 1, 'ztherm_oce', 'USI', &
262!      knon, knindex, ztherm_i)
263  ELSE
264     WRITE(lunout,*) "valeur d indice non prevue", indice
265     call abort_physic("soil", "", 1)
266  ENDIF
267
268
269!-----------------------------------------------------------------------
270! 1)
271! Calculation of Cgrf and Dgrd coefficients using soil temperature from
272! previous time step.
273!
274! These variables are recalculated on the local compressed grid instead
275! of saved in restart file.
276!-----------------------------------------------------------------------
277  DO jk=1,nsoilmx
278     zdz2(jk)=dz2(jk)/ptimestep
279  ENDDO
280 
281  DO ig=1,knon
282     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
283     C_coef(ig,nsoilmx-1,indice)= &
284          zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
285     D_coef(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1s
286  ENDDO
287 
288  DO jk=nsoilmx-1,2,-1
289     DO ig=1,knon
290        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
291             *(1.-D_coef(ig,jk,indice)))
292        C_coef(ig,jk-1,indice)= &
293             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
294        D_coef(ig,jk-1,indice)=dz1(jk-1)*z1s
295     ENDDO
296  ENDDO
297
298!-----------------------------------------------------------------------
299! 2)
300! Computation of the soil temperatures using the Cgrd and Dgrd
301! coefficient computed above
302!
303!-----------------------------------------------------------------------
304
305!    Surface temperature
306  DO ig=1,knon
307     ptsoil(ig,1)=(lambda*C_coef(ig,1,indice)+ptsrf(ig))/  &
308          (lambda*(1.-D_coef(ig,1,indice))+1.)
309  ENDDO
310 
311!   Other temperatures
312  DO jk=1,nsoilmx-1
313     DO ig=1,knon
314        ptsoil(ig,jk+1)=C_coef(ig,jk,indice)+D_coef(ig,jk,indice) &
315             *ptsoil(ig,jk)
316     ENDDO
317  ENDDO
318
319  IF (indice == is_sic) THEN
320     DO ig = 1 , knon
321        ptsoil(ig,nsoilmx) = RTT - 1.8
322     END DO
323  ENDIF
324
325!-----------------------------------------------------------------------
326! 3)
327! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil
328! temperature
329!-----------------------------------------------------------------------
330  DO ig=1,knon
331     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
332     C_coef(ig,nsoilmx-1,indice) = zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
333     D_coef(ig,nsoilmx-1,indice) = dz1(nsoilmx-1)/z1s
334  ENDDO
335 
336  DO jk=nsoilmx-1,2,-1
337     DO ig=1,knon
338        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
339             *(1.-D_coef(ig,jk,indice)))
340        C_coef(ig,jk-1,indice) = &
341             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
342        D_coef(ig,jk-1,indice) = dz1(jk-1)*z1s
343     ENDDO
344  ENDDO
345
346!-----------------------------------------------------------------------
347! 4)
348! Computation of the surface diffusive flux from ground and
349! calorific capacity of the ground
350!-----------------------------------------------------------------------
351  DO ig=1,knon
352     pfluxgrd(ig) = ztherm_i(ig)*dz1(1)* &
353          (C_coef(ig,1,indice)+(D_coef(ig,1,indice)-1.)*ptsoil(ig,1))
354     pcapcal(ig)  = ztherm_i(ig)* &
355          (dz2(1)+ptimestep*(1.-D_coef(ig,1,indice))*dz1(1))
356     z1s = lambda*(1.-D_coef(ig,1,indice))+1.
357     pcapcal(ig)  = pcapcal(ig)/z1s
358     pfluxgrd(ig) = pfluxgrd(ig) &
359          + pcapcal(ig) * (ptsoil(ig,1) * z1s &
360          - lambda * C_coef(ig,1,indice) &
361          - ptsrf(ig)) &
362          /ptimestep
363  ENDDO
364   
365END SUBROUTINE soil
Note: See TracBrowser for help on using the repository browser.