/[lmdze]/trunk/libf/phylmd/soil.f
ViewVC logotype

Contents of /trunk/libf/phylmd/soil.f

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21