source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/soil.F90 @ 4486

Last change on this file since 4486 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 9.3 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, &
5     ptsoil, pcapcal, pfluxgrd)
6 
7  USE dimphy
8  USE mod_phys_lmdz_para
9  USE indice_sol_mod
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!        write(*,*) 'soil 101, firstcall=',firstcall
102  IF (firstcall) THEN
103!-----------------------------------------------------------------------
104!   ground levels
105!   grnd=z/l where l is the skin depth of the diurnal cycle:
106!-----------------------------------------------------------------------
107
108     min_period=1800. ! en secondes
109     dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
110!$OMP MASTER
111     IF (is_mpi_root) THEN
112        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
113        IF (ierr == 0) THEN ! Read file only if it exists
114           READ(99,*) min_period
115           READ(99,*) dalph_soil
116           WRITE(lunout,*)'Discretization for the soil model'
117           WRITE(lunout,*)'First level e-folding depth',min_period, &
118                '   dalph',dalph_soil
119           CLOSE(99)
120        END IF
121     ENDIF
122!$OMP END MASTER
123!        write(*,*) 'soil 123'
124     CALL bcast(min_period)
125!        write(*,*) 'soil 125'
126     CALL bcast(dalph_soil)
127!        write(*,*) 'soil 126'
128
129!   la premiere couche represente un dixieme de cycle diurne
130     fz1=SQRT(min_period/3.14)
131     
132        write(*,*) 'soil 130'
133     DO jk=1,nsoilmx
134        rk1=jk
135        rk2=jk-1
136        dz2(jk)=fz(rk1)-fz(rk2)
137     ENDDO
138     DO jk=1,nsoilmx-1
139        rk1=jk+.5
140        rk2=jk-.5
141        dz1(jk)=1./(fz(rk1)-fz(rk2))
142     ENDDO
143     lambda=fz(.5)*dz1(1)
144     WRITE(lunout,*)'full layers, intermediate layers (seconds)'
145     DO jk=1,nsoilmx
146        rk=jk
147        rk1=jk+.5
148        rk2=jk-.5
149        WRITE(lunout,*)'fz=', &
150             fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
151     ENDDO
152!        write(*,*) 'soil 150'
153
154     firstcall =.FALSE.
155  END IF
156!write(*,*) 'soil 151'
157
158!-----------------------------------------------------------------------
159!   Calcul de l'inertie thermique a partir de la variable rnat.
160!   on initialise a inertie_ice meme au-dessus d'un point de mer au cas
161!   ou le point de mer devienne point de glace au pas suivant
162!   on corrige si on a un point de terre avec ou sans glace
163!
164!-----------------------------------------------------------------------
165  IF (indice == is_sic) THEN
166     DO ig = 1, knon
167        ztherm_i(ig)   = inertie_ice
168        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
169     ENDDO
170  ELSE IF (indice == is_lic) THEN
171     DO ig = 1, knon
172        ztherm_i(ig)   = inertie_ice
173        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
174     ENDDO
175  ELSE IF (indice == is_ter) THEN
176     DO ig = 1, knon
177        ztherm_i(ig)   = inertie_sol
178        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
179     ENDDO
180  ELSE IF (indice == is_oce) THEN
181     DO ig = 1, knon
182        ztherm_i(ig)   = inertie_ice
183     ENDDO
184  ELSE
185     WRITE(lunout,*) "valeur d indice non prevue", indice
186     call abort_physic("soil", "", 1)
187  ENDIF
188!write(*,*) 'soil 183'
189
190!-----------------------------------------------------------------------
191! 1)
192! Calculation of Cgrf and Dgrd coefficients using soil temperature from
193! previous time step.
194!
195! These variables are recalculated on the local compressed grid instead
196! of saved in restart file.
197!-----------------------------------------------------------------------
198  DO jk=1,nsoilmx
199     zdz2(jk)=dz2(jk)/ptimestep
200  ENDDO
201 
202  DO ig=1,knon
203     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
204     C_coef(ig,nsoilmx-1,indice)= &
205          zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
206     D_coef(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1s
207  ENDDO
208 
209  DO jk=nsoilmx-1,2,-1
210     DO ig=1,knon
211        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
212             *(1.-D_coef(ig,jk,indice)))
213        C_coef(ig,jk-1,indice)= &
214             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
215        D_coef(ig,jk-1,indice)=dz1(jk-1)*z1s
216     ENDDO
217  ENDDO
218!write(*,*) 'soil 213'
219
220!-----------------------------------------------------------------------
221! 2)
222! Computation of the soil temperatures using the Cgrd and Dgrd
223! coefficient computed above
224!
225!-----------------------------------------------------------------------
226
227!    Surface temperature
228  DO ig=1,knon
229     ptsoil(ig,1)=(lambda*C_coef(ig,1,indice)+ptsrf(ig))/  &
230          (lambda*(1.-D_coef(ig,1,indice))+1.)
231  ENDDO
232 
233!   Other temperatures
234  DO jk=1,nsoilmx-1
235     DO ig=1,knon
236        ptsoil(ig,jk+1)=C_coef(ig,jk,indice)+D_coef(ig,jk,indice) &
237             *ptsoil(ig,jk)
238     ENDDO
239  ENDDO
240
241  IF (indice == is_sic) THEN
242     DO ig = 1 , knon
243        ptsoil(ig,nsoilmx) = RTT - 1.8
244     END DO
245  ENDIF
246!write(*,*) 'soil 241'
247!-----------------------------------------------------------------------
248! 3)
249! Calculate the Cgrd and Dgrd coefficient corresponding to actual soil
250! temperature
251!-----------------------------------------------------------------------
252  DO ig=1,knon
253     z1s = zdz2(nsoilmx)+dz1(nsoilmx-1)
254     C_coef(ig,nsoilmx-1,indice) = zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1s
255     D_coef(ig,nsoilmx-1,indice) = dz1(nsoilmx-1)/z1s
256  ENDDO
257 
258  DO jk=nsoilmx-1,2,-1
259     DO ig=1,knon
260        z1s = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk) &
261             *(1.-D_coef(ig,jk,indice)))
262        C_coef(ig,jk-1,indice) = &
263             (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*C_coef(ig,jk,indice)) * z1s
264        D_coef(ig,jk-1,indice) = dz1(jk-1)*z1s
265     ENDDO
266  ENDDO
267!write(*,*) 'soil 262'
268!-----------------------------------------------------------------------
269! 4)
270! Computation of the surface diffusive flux from ground and
271! calorific capacity of the ground
272!-----------------------------------------------------------------------
273  DO ig=1,knon
274     pfluxgrd(ig) = ztherm_i(ig)*dz1(1)* &
275          (C_coef(ig,1,indice)+(D_coef(ig,1,indice)-1.)*ptsoil(ig,1))
276     pcapcal(ig)  = ztherm_i(ig)* &
277          (dz2(1)+ptimestep*(1.-D_coef(ig,1,indice))*dz1(1))
278     z1s = lambda*(1.-D_coef(ig,1,indice))+1.
279     pcapcal(ig)  = pcapcal(ig)/z1s
280     pfluxgrd(ig) = pfluxgrd(ig) &
281          + pcapcal(ig) * (ptsoil(ig,1) * z1s &
282          - lambda * C_coef(ig,1,indice) &
283          - ptsrf(ig)) &
284          /ptimestep
285  ENDDO
286
287!        write(*,*) 'soil 280'
288   
289END SUBROUTINE soil
Note: See TracBrowser for help on using the repository browser.