/[lmdze]/trunk/Sources/phylmd/Interface_surf/soil.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Interface_surf/soil.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/soil.f revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/Sources/phylmd/Interface_surf/soil.f revision 175 by guez, Fri Feb 5 16:02:34 2016 UTC
# Line 1  Line 1 
1  !  module soil_m
 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/soil.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $  
 !  
       SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, ptsoil,  
      s          pcapcal, pfluxgrd)  
       use dimens_m  
       use indicesol  
       use dimphy  
       use dimsoil  
       use SUPHEC_M  
       IMPLICIT NONE  
   
 c=======================================================================  
 c  
 c   Auteur:  Frederic Hourdin     30/01/92  
 c   -------  
 c  
 c   objet:  computation of : the soil temperature evolution  
 c   ------                   the surfacic heat capacity "Capcal"  
 c                            the surface conduction flux pcapcal  
 c  
 c  
 c   Method: implicit time integration  
 c   -------  
 c   Consecutive ground temperatures are related by:  
 c           T(k+1) = C(k) + D(k)*T(k)  (1)  
 c   the coefficients C and D are computed at the t-dt time-step.  
 c   Routine structure:  
 c   1)new temperatures are computed  using (1)  
 c   2)C and D coefficients are computed from the new temperature  
 c     profile for the t+dt time-step  
 c   3)the coefficients A and B are computed where the diffusive  
 c     fluxes at the t+dt time-step is given by  
 c            Fdiff = A + B Ts(t+dt)  
 c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt  
 c            with F0 = A + B (Ts(t))  
 c                 Capcal = B*dt  
 c            
 c   Interface:  
 c   ----------  
 c  
 c   Arguments:  
 c   ----------  
 c   ptimestep            physical timestep (s)  
 c   indice               sub-surface index  
 c   snow(klon,nbsrf)     snow  
 c   ptsrf(klon)          surface temperature at time-step t (K)  
 c   ptsoil(klon,nsoilmx) temperature inside the ground (K)  
 c   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)  
 c   pfluxgrd(klon)       surface diffusive flux from ground (Wm-2)  
 c    
 c=======================================================================  
 c   declarations:  
 c   -------------  
   
   
 c-----------------------------------------------------------------------  
 c  arguments  
 c  ---------  
   
       REAL ptimestep  
       INTEGER indice, knon  
       REAL ptsrf(klon),ptsoil(klon,nsoilmx),snow(klon)  
       REAL pcapcal(klon),pfluxgrd(klon)  
   
 c-----------------------------------------------------------------------  
 c  local arrays  
 c  ------------  
   
       INTEGER ig,jk  
 c$$$      REAL zdz2(nsoilmx),z1(klon)  
       REAL zdz2(nsoilmx),z1(klon,nbsrf)  
       REAL min_period,dalph_soil  
       REAL ztherm_i(klon)  
   
 c   local saved variables:  
 c   ----------------------  
       REAL dz1(nsoilmx),dz2(nsoilmx)  
 c$$$          REAL zc(klon,nsoilmx),zd(klon,nsoilmx)  
       REAL zc(klon,nsoilmx,nbsrf),zd(klon,nsoilmx,nbsrf)  
       REAL lambda  
       SAVE dz1,dz2,zc,zd,lambda  
       LOGICAL firstcall, firstsurf(nbsrf)  
       SAVE firstcall, firstsurf  
       REAL isol,isno,iice  
       SAVE isol,isno,iice  
   
       DATA firstcall/.true./  
       DATA firstsurf/.TRUE.,.TRUE.,.TRUE.,.TRUE./  
   
       DATA isol,isno,iice/2000.,2000.,2000./  
   
 c-----------------------------------------------------------------------  
 c   Depthts:  
 c   --------  
   
       REAL fz,rk,fz1,rk1,rk2  
       fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)  
       pfluxgrd(:) = 0.  
 c   calcul de l'inertie thermique a partir de la variable rnat.  
 c   on initialise a iice meme au-dessus d'un point de mer au cas  
 c   ou le point de mer devienne point de glace au pas suivant  
 c   on corrige si on a un point de terre avec ou sans glace  
 c  
       IF (indice.EQ.is_sic) THEN  
          DO ig = 1, knon  
             ztherm_i(ig)   = iice  
             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno  
          ENDDO  
       ELSE IF (indice.EQ.is_lic) THEN  
          DO ig = 1, knon  
             ztherm_i(ig)   = iice  
             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno  
          ENDDO  
       ELSE IF (indice.EQ.is_ter) THEN  
          DO ig = 1, knon  
             ztherm_i(ig)   = isol  
             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno  
          ENDDO  
       ELSE IF (indice.EQ.is_oce) THEN  
          DO ig = 1, knon  
             ztherm_i(ig)   = iice  
          ENDDO  
       ELSE  
          PRINT*, "valeur d indice non prevue", indice  
          stop 1  
       ENDIF  
   
   
 c$$$      IF (firstcall) THEN  
       IF (firstsurf(indice)) THEN  
   
 c-----------------------------------------------------------------------  
 c   ground levels  
 c   grnd=z/l where l is the skin depth of the diurnal cycle:  
 c   --------------------------------------------------------  
   
          min_period=1800. ! en secondes  
          dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.  
   
          OPEN(99,file='soil.def',status='old',form='formatted',err=9999)  
          READ(99,*) min_period  
          READ(99,*) dalph_soil  
          PRINT*,'Discretization for the soil model'  
          PRINT*,'First level e-folding depth',min_period,  
      s   '   dalph',dalph_soil  
          CLOSE(99)  
 9999     CONTINUE  
   
 c   la premiere couche represente un dixieme de cycle diurne  
          fz1=sqrt(min_period/3.14)  
   
          DO jk=1,nsoilmx  
             rk1=jk  
             rk2=jk-1  
             dz2(jk)=fz(rk1)-fz(rk2)  
          ENDDO  
          DO jk=1,nsoilmx-1  
             rk1=jk+.5  
             rk2=jk-.5  
             dz1(jk)=1./(fz(rk1)-fz(rk2))  
          ENDDO  
          lambda=fz(.5)*dz1(1)  
          PRINT*,'full layers, intermediate layers (seconds)'  
          DO jk=1,nsoilmx  
             rk=jk  
             rk1=jk+.5  
             rk2=jk-.5  
             PRINT *,'fz=',  
      .               fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14  
          ENDDO  
 C PB  
          firstsurf(indice) = .FALSE.  
 c$$$         firstcall =.false.  
   
 c   Initialisations:  
 c   ----------------  
   
       ELSE   !--not firstcall  
 c-----------------------------------------------------------------------  
 c   Computation of the soil temperatures using the Cgrd and Dgrd  
 c  coefficient computed at the previous time-step:  
 c  -----------------------------------------------  
   
 c    surface temperature  
          DO ig=1,knon  
             ptsoil(ig,1)=(lambda*zc(ig,1,indice)+ptsrf(ig))/  
      s      (lambda*(1.-zd(ig,1,indice))+1.)  
          ENDDO  
   
 c   other temperatures  
          DO jk=1,nsoilmx-1  
             DO ig=1,knon  
                ptsoil(ig,jk+1)=zc(ig,jk,indice)+zd(ig,jk,indice)  
      $            *ptsoil(ig,jk)  
             ENDDO  
          ENDDO  
   
       ENDIF !--not firstcall  
 c-----------------------------------------------------------------------  
 c   Computation of the Cgrd and Dgrd coefficient for the next step:  
 c   ---------------------------------------------------------------  
   
 c$$$  PB ajout pour cas glace de mer  
       IF (indice .EQ. is_sic) THEN  
           DO ig = 1 , knon  
             ptsoil(ig,nsoilmx) = RTT - 1.8  
           END DO  
       ENDIF  
   
       DO jk=1,nsoilmx  
          zdz2(jk)=dz2(jk)/ptimestep  
       ENDDO  
   
       DO ig=1,knon  
          z1(ig,indice)=zdz2(nsoilmx)+dz1(nsoilmx-1)  
          zc(ig,nsoilmx-1,indice)=  
      $       zdz2(nsoilmx)*ptsoil(ig,nsoilmx)/z1(ig,indice)  
          zd(ig,nsoilmx-1,indice)=dz1(nsoilmx-1)/z1(ig,indice)  
       ENDDO  
   
       DO jk=nsoilmx-1,2,-1  
          DO ig=1,knon  
             z1(ig,indice)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)  
      $         *(1.-zd(ig,jk,indice)))  
             zc(ig,jk-1,indice)=  
      s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk,indice))  
      $          *z1(ig,indice)  
             zd(ig,jk-1,indice)=dz1(jk-1)*z1(ig,indice)  
          ENDDO  
       ENDDO  
   
 c-----------------------------------------------------------------------  
 c   computation of the surface diffusive flux from ground and  
 c   calorific capacity of the ground:  
 c   ---------------------------------  
   
       DO ig=1,knon  
          pfluxgrd(ig)=ztherm_i(ig)*dz1(1)*  
      s   (zc(ig,1,indice)+(zd(ig,1,indice)-1.)*ptsoil(ig,1))  
          pcapcal(ig)=ztherm_i(ig)*  
      s   (dz2(1)+ptimestep*(1.-zd(ig,1,indice))*dz1(1))  
          z1(ig,indice)=lambda*(1.-zd(ig,1,indice))+1.  
          pcapcal(ig)=pcapcal(ig)/z1(ig,indice)  
          pfluxgrd(ig) = pfluxgrd(ig)  
      s   + pcapcal(ig) * (ptsoil(ig,1) * z1(ig,indice)  
      $       - lambda * zc(ig,1,indice)  
      $       - ptsrf(ig))  
      s   /ptimestep  
       ENDDO  
2    
3        RETURN    IMPLICIT NONE
4        END  
5    contains
6    
7      SUBROUTINE soil(dtime, nisurf, knon, snow, tsurf, tsoil, soilcap, soilflux)
8    
9        ! From LMDZ4/libf/phylmd/soil.F, version 1.1.1.1 2004/05/19
10    
11        ! Author: Frederic Hourdin 30/01/92
12    
13        ! Object: computation of the soil temperature evolution, the
14        ! surfacic heat capacity "Soilcap" and the surface conduction flux
15    
16        ! Method: implicit time integration
17    
18        ! Consecutive ground temperatures are related by:
19        ! T(k+1) = C(k) + D(k)*T(k) (1)
20        ! the coefficients C and D are computed at the t-dt time-step.
21        ! Routine structure:
22        ! 1) new temperatures are computed using (1)
23        ! 2) C and D coefficients are computed from the new temperature
24        ! profile for the t+dt time-step
25        ! 3) the coefficients A and B are computed where the diffusive
26        ! fluxes at the t+dt time-step is given by
27        ! Fdiff = A + B Ts(t+dt)
28        ! or Fdiff = F0 + Soilcap (Ts(t+dt)-Ts(t))/dt
29        ! with F0 = A + B (Ts(t))
30        ! Soilcap = B*dt
31    
32        USE dimens_m, only:
33        USE indicesol
34        USE dimphy
35        USE dimsoil
36        USE suphec_m
37    
38        ! Interface:
39        ! ----------
40    
41        ! Arguments:
42        ! ----------
43        ! dtime physical timestep (s)
44        ! indice sub-surface index
45        ! snow(klon, nbsrf) snow
46        ! tsurf(knon) surface temperature at time-step t (K)
47        ! tsoil(klon, nsoilmx) temperature inside the ground (K)
48        ! soilcap(klon) surfacic specific heat (W*m-2*s*K-1)
49        ! soilflux(klon) surface diffusive flux from ground (Wm-2)
50    
51        ! declarations:
52        ! -------------
53    
54        ! -----------------------------------------------------------------------
55        ! arguments
56        ! ---------
57    
58        REAL dtime
59        INTEGER nisurf, knon
60        REAL tsurf(knon), tsoil(klon, nsoilmx), snow(klon)
61        REAL soilcap(klon), soilflux(klon)
62    
63        ! -----------------------------------------------------------------------
64        ! local arrays
65        ! ------------
66    
67        INTEGER ig, jk
68        ! $$$ REAL zdz2(nsoilmx), z1(klon)
69        REAL zdz2(nsoilmx), z1(klon, nbsrf)
70        REAL min_period, dalph_soil
71        REAL ztherm_i(klon)
72    
73        ! local saved variables:
74        ! ----------------------
75        REAL dz1(nsoilmx), dz2(nsoilmx)
76        ! $$$ REAL zc(klon, nsoilmx), zd(klon, nsoilmx)
77        REAL zc(klon, nsoilmx, nbsrf), zd(klon, nsoilmx, nbsrf)
78        REAL lambda
79        SAVE dz1, dz2, zc, zd, lambda
80        LOGICAL firstsurf(nbsrf)
81        SAVE firstsurf
82        REAL isol, isno, iice
83        SAVE isol, isno, iice
84    
85        DATA firstsurf/.TRUE., .TRUE., .TRUE., .TRUE./
86    
87        DATA isol, isno, iice/2000., 2000., 2000./
88    
89        ! -----------------------------------------------------------------------
90        ! Depthts:
91        ! --------
92    
93        REAL rk, fz1, rk1, rk2
94    
95        soilflux(:) = 0.
96        ! calcul de l'inertie thermique a partir de la variable rnat.
97        ! on initialise a iice meme au-dessus d'un point de mer au cas
98        ! ou le point de mer devienne point de glace au pas suivant
99        ! on corrige si on a un point de terre avec ou sans glace
100    
101        IF (nisurf==is_sic) THEN
102           DO ig = 1, knon
103              ztherm_i(ig) = iice
104              IF (snow(ig)>0.0) ztherm_i(ig) = isno
105           END DO
106        ELSE IF (nisurf==is_lic) THEN
107           DO ig = 1, knon
108              ztherm_i(ig) = iice
109              IF (snow(ig)>0.0) ztherm_i(ig) = isno
110           END DO
111        ELSE IF (nisurf==is_ter) THEN
112           DO ig = 1, knon
113              ztherm_i(ig) = isol
114              IF (snow(ig)>0.0) ztherm_i(ig) = isno
115           END DO
116        ELSE IF (nisurf==is_oce) THEN
117           DO ig = 1, knon
118              ztherm_i(ig) = iice
119           END DO
120        ELSE
121           PRINT *, 'valeur d indice non prevue', nisurf
122           STOP 1
123        END IF
124    
125        IF (firstsurf(nisurf)) THEN
126    
127           ! -----------------------------------------------------------------------
128           ! ground levels
129           ! grnd=z/l where l is the skin depth of the diurnal cycle:
130           ! --------------------------------------------------------
131    
132           min_period = 1800. ! en secondes
133           dalph_soil = 2. ! rapport entre les epaisseurs de 2 couches succ.
134    
135           OPEN (99, FILE='soil.def', STATUS='old', FORM='formatted', ERR=9999)
136           READ (99, *) min_period
137           READ (99, *) dalph_soil
138           PRINT *, 'Discretization for the soil model'
139           PRINT *, 'First level e-folding depth', min_period, ' dalph', &
140                dalph_soil
141           CLOSE (99)
142    9999   CONTINUE
143    
144           ! la premiere couche represente un dixieme de cycle diurne
145           fz1 = sqrt(min_period/3.14)
146    
147           DO jk = 1, nsoilmx
148              rk1 = jk
149              rk2 = jk - 1
150              dz2(jk) = fz(rk1) - fz(rk2)
151           END DO
152           DO jk = 1, nsoilmx - 1
153              rk1 = jk + .5
154              rk2 = jk - .5
155              dz1(jk) = 1./(fz(rk1)-fz(rk2))
156           END DO
157           lambda = fz(.5)*dz1(1)
158           PRINT *, 'full layers, intermediate layers (seconds)'
159           DO jk = 1, nsoilmx
160              rk = jk
161              rk1 = jk + .5
162              rk2 = jk - .5
163              PRINT *, 'fz=', fz(rk1)*fz(rk2)*3.14, fz(rk)*fz(rk)*3.14
164           END DO
165           ! PB
166           firstsurf(nisurf) = .FALSE.
167    
168           ! Initialisations:
169           ! ----------------
170    
171        ELSE
172           ! -----------------------------------------------------------------------
173           ! Computation of the soil temperatures using the Cgrd and Dgrd
174           ! coefficient computed at the previous time-step:
175           ! -----------------------------------------------
176    
177           ! surface temperature
178           DO ig = 1, knon
179              tsoil(ig, 1) = (lambda*zc(ig, 1, nisurf)+tsurf(ig))/(lambda*(1.-zd(ig, 1, &
180                   nisurf))+1.)
181           END DO
182    
183           ! other temperatures
184           DO jk = 1, nsoilmx - 1
185              DO ig = 1, knon
186                 tsoil(ig, jk+1) = zc(ig, jk, nisurf) + zd(ig, jk, nisurf)*tsoil(ig, &
187                      jk)
188              END DO
189           END DO
190    
191        END IF
192        ! -----------------------------------------------------------------------
193        ! Computation of the Cgrd and Dgrd coefficient for the next step:
194        ! ---------------------------------------------------------------
195    
196        ! $$$ PB ajout pour cas glace de mer
197        IF (nisurf==is_sic) THEN
198           DO ig = 1, knon
199              tsoil(ig, nsoilmx) = rtt - 1.8
200           END DO
201        END IF
202    
203        DO jk = 1, nsoilmx
204           zdz2(jk) = dz2(jk)/dtime
205        END DO
206    
207        DO ig = 1, knon
208           z1(ig, nisurf) = zdz2(nsoilmx) + dz1(nsoilmx-1)
209           zc(ig, nsoilmx-1, nisurf) = zdz2(nsoilmx)*tsoil(ig, nsoilmx)/ &
210                z1(ig, nisurf)
211           zd(ig, nsoilmx-1, nisurf) = dz1(nsoilmx-1)/z1(ig, nisurf)
212        END DO
213    
214        DO jk = nsoilmx - 1, 2, -1
215           DO ig = 1, knon
216              z1(ig, nisurf) = 1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig, jk, nisurf)))
217              zc(ig, jk-1, nisurf) = (tsoil(ig, jk)*zdz2(jk)+dz1(jk)*zc(ig, jk, nisurf) &
218                   )*z1(ig, nisurf)
219              zd(ig, jk-1, nisurf) = dz1(jk-1)*z1(ig, nisurf)
220           END DO
221        END DO
222    
223        ! -----------------------------------------------------------------------
224        ! computation of the surface diffusive flux from ground and
225        ! calorific capacity of the ground:
226        ! ---------------------------------
227    
228        DO ig = 1, knon
229           soilflux(ig) = ztherm_i(ig)*dz1(1)*(zc(ig, 1, nisurf)+(zd(ig, 1, &
230                nisurf)-1.)*tsoil(ig, 1))
231           soilcap(ig) = ztherm_i(ig)*(dz2(1)+dtime*(1.-zd(ig, 1, nisurf))*dz1(1))
232           z1(ig, nisurf) = lambda*(1.-zd(ig, 1, nisurf)) + 1.
233           soilcap(ig) = soilcap(ig)/z1(ig, nisurf)
234           soilflux(ig) = soilflux(ig) + soilcap(ig)*(tsoil(ig, 1)*z1(ig, nisurf)- &
235                lambda*zc(ig, 1, nisurf)-tsurf(ig))/dtime
236        END DO
237    
238      contains
239    
240        real function fz(rk)
241          real rk
242          fz = fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
243        end function fz
244    
245      END SUBROUTINE soil
246    
247    end module soil_m

Legend:
Removed from v.38  
changed lines
  Added in v.175

  ViewVC Help
Powered by ViewVC 1.1.21