source: LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/soil.f90 @ 5914

Last change on this file since 5914 was 5889, checked in by yann meurdesoif, 6 weeks ago

GPU port of surf_seaice

YM

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