/[MITgcm]/MITgcm/pkg/land/land_impl_temp.F
ViewVC logotype

Contents of /MITgcm/pkg/land/land_impl_temp.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Mon Jun 21 16:50:21 2004 UTC (19 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint57t_post, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint57o_post, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint54a_pre, checkpoint57m_post, checkpoint55c_post, checkpoint54e_post, checkpoint57s_post, checkpoint54a_post, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint57g_post, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint57b_post, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint57y_post, checkpoint57e_post, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint55h_post, checkpoint58n_post, checkpoint58x_post, checkpoint57g_pre, checkpoint54b_post, checkpoint55b_post, checkpoint58t_post, checkpoint58h_post, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint54d_post, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint56c_post, checkpoint57y_pre, checkpoint55, checkpoint57f_pre, checkpoint57a_post, checkpoint54, checkpoint58q_post, checkpoint54f_post, checkpoint59q, checkpoint59p, checkpoint55g_post, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, eckpoint57e_pre, checkpoint57h_done, checkpoint58f_post, checkpoint53g_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57f_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint57c_post, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint55e_post, checkpoint58k_post, checkpoint58v_post, checkpoint53f_post, checkpoint55a_post, checkpoint54c_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint57j_post, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint57h_pre, checkpoint58m_post, checkpoint57l_post, checkpoint57h_post, checkpoint56a_post, checkpoint55d_post, HEAD
Changes since 1.2: +3 -1 lines
add dBug and output diagnostics.

1 C $Header: /u/gcmpack/MITgcm/pkg/land/land_impl_temp.F,v 1.2 2004/06/03 16:43:14 jmc Exp $
2 C $Name: $
3
4 #include "LAND_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: LAND_IMPL_TEMP
8 C !INTERFACE:
9 SUBROUTINE LAND_IMPL_TEMP(
10 I land_frc,
11 I dTskin, sFlx,
12 O dTsurf,
13 I bi, bj, myTime, myIter, myThid)
14
15 C !DESCRIPTION: \bv
16 C *==========================================================*
17 C | S/R LAND_IMPL_TEMP
18 C | o solve ground temp. and surface temp. implicitly
19 C *==========================================================*
20 C | o account for snow layer (with no heat capacity)
21 C | and ground water freezing/melting
22 C | o surf. heat flux is linearly dependent on surf. temp.
23 C *==========================================================*
24 C \ev
25
26 C !USES:
27 IMPLICIT NONE
28
29 C == Global variables ===
30 C-- size for MITgcm & Land package :
31 #include "LAND_SIZE.h"
32
33 #include "EEPARAMS.h"
34 #include "LAND_PARAMS.h"
35 #include "LAND_VARS.h"
36
37 C !INPUT/OUTPUT PARAMETERS:
38 C == Routine arguments ==
39 C land_frc :: land fraction [0-1]
40 C dTskin :: temp. correction for daily-cycle heating [K]
41 C sFlx :: surf. heat flux (+=down) function of surface temp. Ts:
42 C 0: Flx(Ts=0) ; 1: Flx(Ts=Ts^n) ; 2: d.Flx/dTs(Ts=Ts^n)
43 C dTsurf :: surf. temp adjusment: Ts^n+1 - Ts^n
44 C bi,bj :: Tile index
45 C myTime :: Current time of simulation ( s )
46 C myIter :: Current iteration number in simulation
47 C myThid :: Number of this instance of the routine
48 _RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
49 _RL dTskin(sNx,sNy), sFlx(sNx,sNy,0:2)
50 _RL dTsurf(sNx,sNy)
51 INTEGER bi, bj, myIter, myThid
52 _RL myTime
53 CEOP
54
55 #ifdef ALLOW_LAND
56
57 C == Local variables ==
58 C- local variables used in solving the ground temp. implicitly :
59 C aLoc :: ground Conductivity * delT / delZ_12 [J/K]
60 C bLoc :: minus surf. flux derivative ./. Ts [W/m2/K]
61 C cLoc :: temporary value for level.1 heat capacity [J/m2/K]
62 C eLoc :: temporary value for level.1 ground enthalpy [J/m2]
63 C fLoc :: temporary value for surface heat flux [W/m2]
64 C alpha :: snow thicknes / snow conductivity [m2.K/W]
65 C beta :: local coeff = 1/(1+alpha*bLoc) [1]
66 C tSurf :: surf. temperature [oC]
67 C tg :: ground temperature [oC] (2 levels)
68 C eg :: ground enthalpy [J/m2] (2 levels)
69 C cg :: ground heat capacity [J/m2/K](2 levels)
70 C mW :: ground water mass [kg/m2] (2 levels)
71 C temp_af :: ground temperature if above freezing
72 C temp_bf :: ground temperature if below freezing
73 C mSnow :: mass of snow [kg/m2]
74 C dMsn :: mass of melting snow [kg/m2]
75 C delT :: time step [s]
76 C mSnEpsil :: small snow mass [kg/m2]
77 C i,j,k :: loop counters
78 C msgBuf :: Informational/error meesage buffer
79 C tmpFlag :: temp. flag, =.T. until found final groung temp
80 _RL aLoc, bLoc, cLoc, eLoc, fLoc, alpha, beta
81 _RL tSurf, tg(land_nLev), eg(land_nLev)
82 _RL cg(land_nLev), mW(land_nLev)
83 _RL temp_af, temp_bf
84 _RL mSnow, dMsn, delT
85 _RL mSnEpsil
86 _RL tmp1, tmp2
87 INTEGER i,j,k
88 LOGICAL tmpFlag
89
90 #ifdef LAND_DEBUG
91 CHARACTER*(MAX_LEN_MBUF) msgBuf
92 LOGICAL dBug, debugFlag
93 INTEGER iprt,jprt,lprt
94 DATA iprt, jprt , lprt / 19 , 20 , 6 /
95 DATA debugFlag / .FALSE. /
96 1010 FORMAT(A,I3,1P4E11.3)
97 #endif
98
99 DATA mSnEpsil / 1. _d -6 /
100
101 C-------------------------------------------------------------------------
102 C solve implicitly the coupled 3 eq. (time level n+1 omitted) :
103 C 1a : if hs=0 : Flx = Flx^o + d.F/dT*(Ts - Ts^n) & Ts=Tg1
104 C 1b : if hs>0 : Flx = (Ts-Tg1)*Ks/hs =< Flx^o + d.F/dT*(Ts - Ts^n)
105 C & difference used to melt the snow, maintaining Ts=0
106 C 2 : Eg1 - Eg1^n = delT*Flx - (lambda*delT/delZ_12)*(Tg1-Tg2)
107 C 3 : Eg2 - Eg2^n = (lambda*delT/delZ_12)*(Tg1-Tg2)
108 C were lambda = ground Conductivity ; Ks = snow Conductivity
109 C k=1,2: Eg_k = Cg_k * Tg_k - Lfreez * mIce_k
110 C
111 C using local variables:
112 C a = lambda*delT/delZ_12 ; b = - d.F/dT ; f = Flx^o + b*Ts^n
113 C alpha = hs/Ks ; beta = 1/(1+alpha*b)
114 C 3.eq system becomes:
115 C o if Ts*hs =< 0
116 C 1a,b: Ts = ( Tg1 + alpha*F)*beta
117 C 2 : Eg1 + a*(Tg1-Tg2) + (b*delT)*beta*Tg1 = Eg1^n + delT*f*beta
118 C 3 : Eg2 + a*(Tg2-Tg1) = Eg2^n
119 C o else:
120 C 1.b : Ts=0 , f = Flx(ts=0) ; snowMelt = (f + Tg1/alpha)/Lfreez
121 C 2 : Eg1 + a*(Tg1-Tg2) + (delT/alpha)*Tg1 = Eg1^n
122 C 3 : Eg2 + a*(Tg2-Tg1) = Eg2^n
123 C-------------------------------------------------------------------------
124
125 C--- Solve implicitely for ground temp. & surface temp
126
127 delT = land_deltaT
128 aLoc = land_grdLambda*land_deltaT*land_rec_dzC(2)
129 DO j=1,sNy
130 DO i=1,sNx
131 IF ( land_frc(i,j,bi,bj).GT.0. ) THEN
132
133 C-- initialise local variables
134 tmpFlag = .TRUE.
135 tSurf = land_skinT(i,j,bi,bj)
136 mSnow = land_rhoSnow*land_hSnow(i,j,bi,bj)
137 bLoc = -sFlx(i,j,2)
138 fLoc = sFlx(i,j,1)+bLoc*tSurf
139 alpha = land_hSnow(i,j,bi,bj)/diffKsnow
140 beta = 1. _d 0/(1. _d 0+alpha*bLoc)
141 DO k=1,land_nLev
142 eg(k) = land_dzF(k)*land_enthalp(i,j,k,bi,bj)
143 mW(k) = land_dzF(k)*land_groundW(i,j,k,bi,bj)
144 & *land_waterCap*land_rhoLiqW
145 mW(k) = MAX( mW(k), 0. _d 0 )
146 cg(k) = land_dzF(k)*land_heatCs + mW(k)*land_CpWater
147 tg(k) = land_groundT(i,j,k,bi,bj)
148 ENDDO
149 #ifdef LAND_DEBUG
150 dBug = bi.eq.lprt .AND. i.EQ.iprt .AND. j.EQ.jprt
151 IF (dBug) write(6,1010)
152 & 'LAND_IMPL_TEMP: 0 , ts,tg1&2,mSw=',0,tSurf,tg,mSnow
153 IF (dBug) write(6,1010)
154 & 'LAND_IMPL_TEMP: 0 , sFlx=', 0,(sFlx(i,j,k),k=0,2)
155 #endif
156
157 C--- Solve for temp as if no freezing/melting was occuring :
158 tg(1) = ( cg(1)*tg(1) + fLoc*delT*beta
159 & + cg(2)*tg(2)*aLoc/(cg(2)+aLoc)
160 & )
161 & / ( cg(1) + aLoc + bLoc*delT*beta
162 & - aLoc*aLoc/(cg(2)+aLoc)
163 & )
164 tg(2) = ( cg(2)*tg(2) + aLoc*tg(1) ) / (cg(2)+aLoc)
165 tSurf = ( tg(1) + alpha*fLoc ) * beta
166
167 #ifdef LAND_DEBUG
168 IF (dBug) write(6,1010)
169 & 'LAND_IMPL_TEMP: 1 , ts,tg1&2,mW1=',1,tSurf,tg,mW(1)
170 #endif
171 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
172 C--- If melting/freezing (top of snow layer, ground water level 1 or 2)
173 C set corresponding temp to freezing point and update enthalpy
174 C--------------
175
176 IF ( tg(2)*land_groundT(i,j,2,bi,bj) .LE. 0. _d 0
177 & .AND. tmpFlag .AND. tSurf*mSnow .LE. 0. _d 0 ) THEN
178 C-- freezing/melting in level 2: set Tg2 to freezing point
179 tmp1 = tg(1)
180 tmp2 = tg(2)
181 tg(2) = 0.
182 eLoc = eg(1) + fLoc*delT*beta
183 cLoc = cg(1) + aLoc + bLoc*delT*beta
184 temp_bf = (eLoc+land_Lfreez*mW(1))/cLoc
185 temp_af = eLoc/cLoc
186 tg(1) = MIN( temp_bf, MAX(temp_af, 0. _d 0) )
187 tSurf = ( tg(1) + alpha*fLoc ) * beta
188 IF ( tSurf*mSnow .LE. 0. _d 0 ) THEN
189 tmpFlag = .FALSE.
190 eg(1) = eLoc - (aLoc + bLoc*delT*beta)*tg(1)
191 eg(2) = eg(2) + aLoc*tg(1)
192 #ifdef LAND_DEBUG
193 ELSEIF ( debugFlag ) THEN
194 WRITE(msgBuf,'(A,2I4,2I3,I10)')
195 & 'LAND_IMPL_TEMP: i,j,bi,bj,Iter=',
196 & i,j,bi,bj,myIter
197 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
198 & SQUEEZE_RIGHT, myThid )
199 WRITE(msgBuf,'(A,1P4E12.4)')
200 & 'LAND_IMPL_TEMP: groundT,t2,ts=',
201 & land_groundT(i,j,1,bi,bj),land_groundT(i,j,2,bi,bj),
202 & tmp2,(tmp1+alpha*fLoc)*beta
203 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
204 & SQUEEZE_RIGHT, myThid )
205 WRITE(msgBuf,'(A,1P4E12.4)')
206 & 'LAND_IMPL_TEMP: Tg,tSurf,mSnw=',
207 & tg,tSurf,mSnow
208 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
209 & SQUEEZE_RIGHT, myThid )
210 WRITE(msgBuf,'(A,1P4E14.6)')
211 & 'LAND_IMPL_TEMP: eg,mW=', eg,mW
212 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
213 & SQUEEZE_RIGHT, myThid )
214 #endif
215 ENDIF
216
217 C- if tg2_new*tg2_old < 0 : end
218 ENDIF
219
220 C--------------
221
222 IF ( tg(1)*land_groundT(i,j,1,bi,bj) .LE. 0. _d 0
223 & .AND. tmpFlag .AND. tSurf*mSnow .LE. 0. _d 0 ) THEN
224 C-- freezing/melting in level 1: set Tg1 to freezing point
225 tmp1 = tg(1)
226 tg(1) = 0.
227 tg(2) = cg(2)*tg(2) / (cg(2)+aLoc)
228 tSurf = alpha*fLoc * beta
229 IF ( tSurf*mSnow .LE. 0. _d 0 ) THEN
230 tmpFlag = .FALSE.
231 eg(2) = eg(2) - aLoc*tg(2)
232 eg(1) = eg(1) + aLoc*tg(2) + fLoc*delT*beta
233 IF ( eg(1)*mSnow .GT. 0. _d 0 ) THEN
234 C- melt snow from bottom
235 dMsn = MIN( mSnow, eg(1)*recip_Lfreez )
236 land_Pr_m_Ev(i,j,bi,bj) = dMsn/delT
237 land_hSnow(i,j,bi,bj) = (mSnow - dMsn)/land_rhoSnow
238 eg(1) = eg(1) - dMsn*land_Lfreez
239 #ifdef LAND_DEBUG
240 IF (dBug) write(6,1010)
241 & 'LAND_IMPL_TEMP: Bot-Melt : dMsn,dEg1,eg1=',
242 & 1, dMsn, -dMsn*land_Lfreez, eg(1)
243 #endif
244 ENDIF
245 #ifdef LAND_DEBUG
246 ELSEIF ( debugFlag ) THEN
247 WRITE(msgBuf,'(A,2I4,2I3,I10)')
248 & 'LAND_IMPL_TEMP: i,j,bi,bj,Iter=',
249 & i,j,bi,bj,myIter
250 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
251 & SQUEEZE_RIGHT, myThid )
252 WRITE(msgBuf,'(A,4F11.6)')
253 & 'LAND_IMPL_TEMP: groundT,t1,ts=',
254 & land_groundT(i,j,1,bi,bj),land_groundT(i,j,2,bi,bj),
255 & tmp1,(tmp1+alpha*fLoc)*beta
256 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
257 & SQUEEZE_RIGHT, myThid )
258 WRITE(msgBuf,'(A,4F12.7)')
259 & 'LAND_IMPL_TEMP: Tg,tSurf,mSnow=',
260 & tg,tSurf,mSnow
261 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
262 & SQUEEZE_RIGHT, myThid )
263 WRITE(msgBuf,'(A,1P4E14.6)')
264 & 'LAND_IMPL_TEMP: eg,mW=', eg,mW
265 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
266 & SQUEEZE_RIGHT, myThid )
267 WRITE(msgBuf,'(A)')
268 & 'LAND_IMPL_TEMP: snow with ts > 0 ! but continue'
269 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
270 & SQUEEZE_RIGHT, myThid )
271 #endif
272 ENDIF
273
274 C- if tg1_new*tg1_old < 0 : end
275 ENDIF
276
277 C--------------
278
279 IF ( tmpFlag .AND. tSurf*mSnow .GT. 0. _d 0 ) THEN
280 C-- snow is melting at the surface: set ts=0 & use fixed heat flux Flx(ts=0)
281 #ifdef LAND_DEBUG
282 IF (dBug) write(6,1010)
283 & 'LAND_IMPL_TEMP: Top-Melt : fx0, fx1, fx1-b*Ts =',
284 & 1, sFlx(i,j,0), fLoc, fLoc-bLoc*tSurf
285 #endif
286 tSurf = 0. _d 0
287 fLoc = sFlx(i,j,0)
288 dTsurf(i,j) = 1000.
289 tg(1) = land_groundT(i,j,1,bi,bj)
290 tg(2) = land_groundT(i,j,2,bi,bj)
291
292 eLoc = cg(1)*tg(1)
293 & + delT*fLoc - land_Lfreez*mSnow + aLoc*tg(2)
294 IF ( eLoc .GT. 0. _d 0 .OR. mSnow.LT.mSnEpsil ) THEN
295 C- all snow melt: do not solve diffusion of heat in snow layer
296 C but put surf. heat flux directly to 1rst level and set tg1=0
297 dMsn = mSnow
298 tg(1) = 0. _d 0
299 tg(2) = cg(2)*tg(2) / (cg(2)+aLoc)
300 ELSE
301 C- solve diffusion of heat in snow layer ; heat flux difference
302 C (surf.Flx - diffusion.Flx) is used to melt the snow from top.
303 tg(1) = ( cg(1)*tg(1) + cg(2)*tg(2)*aLoc/(cg(2)+aLoc) )
304 & / ( cg(1)+aLoc + delT/alpha - aLoc*aLoc/(cg(2)+aLoc) )
305 tg(2) = ( cg(2)*tg(2) + aLoc*tg(1) ) / (cg(2)+aLoc)
306 IF ( tg(2)*land_groundT(i,j,2,bi,bj).LE.0. _d 0 ) THEN
307 tg(2) = 0.
308 tg(1) = cg(1)*tg(1) / ( cg(1)+aLoc + delT/alpha )
309 ELSEIF ( tg(1)*land_groundT(i,j,1,bi,bj).LE.0. _d 0 ) THEN
310 tg(1) = 0.
311 tg(2) = cg(2)*tg(2) / (cg(2)+aLoc)
312 ENDIF
313 dMsn = ( fLoc+tg(1)/alpha )*delT*recip_Lfreez
314 #ifdef LAND_DEBUG
315 IF (dBug) write(6,1010)
316 & 'LAND_IMPL_TEMP: Surf-Melt: dMsn,fLoc,tg1/alpha=',
317 & 2, dMsn, fLoc,tg(1)/alpha
318 #endif
319 C- note: Fx0 < -tg(1)/alpha can happen (due to non-linearity in Fx(Ts)),
320 C- => do not melt nor accumulate snow but put d.Flx in Eg1
321 dMsn = MIN( MAX(dMsn, 0. _d 0), mSnow )
322 ENDIF
323 tmpFlag = .FALSE.
324 eg(2) = eg(2) + aLoc*(tg(1)-tg(2))
325 eg(1) = eg(1) - aLoc*(tg(1)-tg(2))
326 & + delT*fLoc - land_Lfreez*dMsn
327 land_Pr_m_Ev(i,j,bi,bj) = dMsn/delT
328 land_hSnow(i,j,bi,bj) = (mSnow - dMsn)/land_rhoSnow
329
330 C- if ts*hSnow > 0 , else:
331 ELSEIF ( tmpFlag ) THEN
332 C-- snow is not melting & no freezing/melting in ground level 1 & 2
333 eg(2) = eg(2) + aLoc*(tg(1)-tg(2))
334 eg(1) = eg(1) - aLoc*(tg(1)-tg(2))
335 & + delT*(fLoc-bLoc*Tsurf)
336 tmpFlag = .FALSE.
337 ENDIF
338
339 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
340
341 C--- Save new values :
342 IF ( dTsurf(i,j) .LE. 999. )
343 & dTsurf(i,j) = tSurf - land_skinT(i,j,bi,bj)
344 land_skinT(i,j,bi,bj) = tSurf
345 DO k=1,land_nLev
346 land_enthalp(i,j,k,bi,bj) = eg(k)/land_dzF(k)
347 land_groundT(i,j,k,bi,bj) = tg(k)
348 ENDDO
349
350 #ifdef LAND_DEBUG
351 IF (dBug) write(6,1010) 'LAND_IMPL_TEMP: 9, ts,tg1&2,dTs=',9,
352 & tSurf, tg, dTsurf(i,j)
353 IF (dBug) write(6,1010) 'LAND_IMPL_TEMP: 9, Eg1,Eg2,mPmE=',9,
354 & (land_enthalp(i,j,k,bi,bj),k=1,2), land_Pr_m_Ev(i,j,bi,bj)
355 #endif
356
357 ENDIF
358 ENDDO
359 ENDDO
360
361 #endif /* ALLOW_LAND */
362
363 RETURN
364 END

  ViewVC Help
Powered by ViewVC 1.1.22