/[lmdze]/trunk/phylmd/Interface_surf/calcul_fluxs.f
ViewVC logotype

Contents of /trunk/phylmd/Interface_surf/calcul_fluxs.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 99 - (show annotations)
Wed Jul 2 18:39:15 2014 UTC (9 years, 10 months ago) by guez
File size: 7323 byte(s) 
Created procedure test_disvert (following LMDZ). Added procedures
hybrid and funcd in module disvert_m. Upgraded compute_ab from
internal procedure of disvert to module procedure. Added variables y,
ya in module disvert_m. Upgraded s from local variable of procedure
disvert to module variable.

Renamed allowed value of variable vert_sampling in procedure disvert
from "read" to "read_hybrid". Added possibility to read pressure
values, value "read_pressure". Replaced vertical distribution for
value "param" by the distribution "strato_correct" from LMDZ (but kept
the value "param"). In case "tropo", replaced 1 by dsigmin (following
LMDZ). In case "strato", replaced 0.3 by dsigmin (following LMDZ).

Changed computation of bp in procedure compute_ab.

Removed debugindex case in clmain. Removed useless argument rlon of
procedure clmain. Removed useless variables ytaux, ytauy of procedure
clmain.

Removed intermediary variables tsol, qsol, tsolsrf, tslab in procedure
etat0.

Removed variable ok_veget:. coupling with the model Orchid is not
possible. Removed variable ocean: modeling an ocean slab is not
possible.

Removed useless variables tmp_rriv and tmp_rcoa from module
interface_surf.

Moved initialization of variables da, mp, phi in procedure physiq to
to inside the test iflag_con >= 3.
1 module calcul_fluxs_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE calcul_fluxs( klon, knon, nisurf, dtime, &
8 tsurf, p1lay, cal, beta, coef1lay, ps, &
9 precip_rain, precip_snow, snow, qsurf, &
10 radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, &
11 petAcoef, peqAcoef, petBcoef, peqBcoef, &
12 tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
13
14 ! Cette routine calcule les fluxs en h et q à l'interface et une
15 ! température de surface.
16
17 ! L. Fairhead 4/2000
18
19 ! input:
20 ! knon nombre de points a traiter
21 ! nisurf surface a traiter
22 ! tsurf temperature de surface
23 ! p1lay pression 1er niveau (milieu de couche)
24 ! cal capacite calorifique du sol
25 ! beta evap reelle
26 ! coef1lay coefficient d'echange
27 ! ps pression au sol
28 ! precip_rain precipitations liquides
29 ! precip_snow precipitations solides
30 ! snow champs hauteur de neige
31 ! runoff runoff en cas de trop plein
32 ! petAcoef coeff. A de la resolution de la CL pour t
33 ! peqAcoef coeff. A de la resolution de la CL pour q
34 ! petBcoef coeff. B de la resolution de la CL pour t
35 ! peqBcoef coeff. B de la resolution de la CL pour q
36 ! radsol rayonnement net aus sol (LW + SW)
37 ! dif_grnd coeff. diffusion vers le sol profond
38
39 ! output:
40 ! tsurf_new temperature au sol
41 ! qsurf humidite de l'air au dessus du sol
42 ! fluxsens flux de chaleur sensible
43 ! fluxlat flux de chaleur latente
44 ! dflux_s derivee du flux de chaleur sensible / Ts
45 ! dflux_l derivee du flux de chaleur latente / Ts
46
47
48 use indicesol
49 use abort_gcm_m, only: abort_gcm
50 use yoethf_m
51 use fcttre, only: thermcep, foeew, qsats, qsatl, foede, dqsats, dqsatl
52 use SUPHEC_M
53 use interface_surf
54
55 ! Parametres d'entree
56 integer, intent(IN) :: knon, nisurf, klon
57 real , intent(IN) :: dtime
58 real, dimension(klon), intent(IN) :: petAcoef, peqAcoef
59 real, dimension(klon), intent(IN) :: petBcoef, peqBcoef
60 real, dimension(klon), intent(IN) :: ps, q1lay
61 real, dimension(klon), intent(IN) :: tsurf, p1lay, cal, beta, coef1lay
62 real, dimension(klon), intent(IN) :: precip_rain, precip_snow
63 real, dimension(klon), intent(IN) :: radsol, dif_grnd
64 real, dimension(klon), intent(IN) :: t1lay, u1lay, v1lay
65 real, dimension(klon), intent(INOUT) :: snow, qsurf
66
67 ! Parametres sorties
68 real, dimension(klon), intent(OUT):: tsurf_new, evap, fluxsens, fluxlat
69 real, dimension(klon), intent(OUT):: dflux_s, dflux_l
70
71 ! Variables locales
72 integer :: i
73 real, dimension(klon) :: zx_mh, zx_nh, zx_oh
74 real, dimension(klon) :: zx_mq, zx_nq, zx_oq
75 real, dimension(klon) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
76 real, dimension(klon) :: zx_sl, zx_k1
77 real, dimension(klon) :: zx_q_0 , d_ts
78 real :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh
79 real :: bilan_f, fq_fonte
80 REAL :: subli, fsno
81 REAL :: qsat_new, q1_new
82 real, parameter :: t_grnd = 271.35, t_coup = 273.15
83 !! PB temporaire en attendant mieux pour le modele de neige
84 REAL, parameter :: chasno = 3.334E+05/(2.3867E+06*0.15)
85
86 logical, save :: check = .false.
87 character (len = 20) :: modname = 'calcul_fluxs'
88 logical, save :: fonte_neige = .false.
89 real, save :: max_eau_sol = 150.0
90 character (len = 80) :: abort_message
91 logical, save :: first = .true., second=.false.
92
93 if (check) write(*, *)'Entree ', modname, ' surface = ', nisurf
94
95 IF (check) THEN
96 WRITE(*, *)' radsol (min, max)' &
97 , MINVAL(radsol(1:knon)), MAXVAL(radsol(1:knon))
98 !!CALL flush(6)
99 ENDIF
100
101 if (size(coastalflow) /= knon .AND. nisurf == is_ter) then
102 write(*, *)'Bizarre, le nombre de points continentaux'
103 write(*, *)'a change entre deux appels. J''arrete ...'
104 abort_message='Pb run_off'
105 call abort_gcm(modname, abort_message, 1)
106 endif
107
108 ! Traitement neige et humidite du sol
109
110 ! Initialisation
111
112 evap = 0.
113 fluxsens=0.
114 fluxlat=0.
115 dflux_s = 0.
116 dflux_l = 0.
117
118 ! zx_qs = qsat en kg/kg
119
120 DO i = 1, knon
121 zx_pkh(i) = (ps(i)/ps(i))**RKAPPA
122 IF (thermcep) THEN
123 zdelta=MAX(0., SIGN(1., rtt-tsurf(i)))
124 zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
125 zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q1lay(i))
126 zx_qs= r2es * FOEEW(tsurf(i), zdelta)/ps(i)
127 zx_qs=MIN(0.5, zx_qs)
128 zcor=1./(1.-retv*zx_qs)
129 zx_qs=zx_qs*zcor
130 zx_dq_s_dh = FOEDE(tsurf(i), zdelta, zcvm5, zx_qs, zcor) &
131 /RLVTT / zx_pkh(i)
132 ELSE
133 IF (tsurf(i).LT.t_coup) THEN
134 zx_qs = qsats(tsurf(i)) / ps(i)
135 zx_dq_s_dh = dqsats(tsurf(i), zx_qs)/RLVTT &
136 / zx_pkh(i)
137 ELSE
138 zx_qs = qsatl(tsurf(i)) / ps(i)
139 zx_dq_s_dh = dqsatl(tsurf(i), zx_qs)/RLVTT &
140 / zx_pkh(i)
141 ENDIF
142 ENDIF
143 zx_dq_s_dt(i) = RCPD * zx_pkh(i) * zx_dq_s_dh
144 zx_qsat(i) = zx_qs
145 zx_coef(i) = coef1lay(i) &
146 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2)) &
147 * p1lay(i)/(RD*t1lay(i))
148
149 ENDDO
150
151 ! === Calcul de la temperature de surface ===
152
153 ! zx_sl = chaleur latente d'evaporation ou de sublimation
154
155 do i = 1, knon
156 zx_sl(i) = RLVTT
157 if (tsurf(i) .LT. RTT) zx_sl(i) = RLSTT
158 zx_k1(i) = zx_coef(i)
159 enddo
160
161 do i = 1, knon
162 ! Q
163 zx_oq(i) = 1. - (beta(i) * zx_k1(i) * peqBcoef(i) * dtime)
164 zx_mq(i) = beta(i) * zx_k1(i) * &
165 (peqAcoef(i) - zx_qsat(i) &
166 + zx_dq_s_dt(i) * tsurf(i)) &
167 / zx_oq(i)
168 zx_nq(i) = beta(i) * zx_k1(i) * (-1. * zx_dq_s_dt(i)) &
169 / zx_oq(i)
170
171 ! H
172 zx_oh(i) = 1. - (zx_k1(i) * petBcoef(i) * dtime)
173 zx_mh(i) = zx_k1(i) * petAcoef(i) / zx_oh(i)
174 zx_nh(i) = - (zx_k1(i) * RCPD * zx_pkh(i))/ zx_oh(i)
175
176 ! Tsurface
177 tsurf_new(i) = (tsurf(i) + cal(i)/(RCPD * zx_pkh(i)) * dtime * &
178 (radsol(i) + zx_mh(i) + zx_sl(i) * zx_mq(i)) &
179 + dif_grnd(i) * t_grnd * dtime)/ &
180 ( 1. - dtime * cal(i)/(RCPD * zx_pkh(i)) * ( &
181 zx_nh(i) + zx_sl(i) * zx_nq(i)) &
182 + dtime * dif_grnd(i))
183
184
185 ! Y'a-t-il fonte de neige?
186
187 ! fonte_neige = (nisurf /= is_oce) .AND. &
188 ! & (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
189 ! & .AND. (tsurf_new(i) >= RTT)
190 ! if (fonte_neige) tsurf_new(i) = RTT
191 d_ts(i) = tsurf_new(i) - tsurf(i)
192 ! zx_h_ts(i) = tsurf_new(i) * RCPD * zx_pkh(i)
193 ! zx_q_0(i) = zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
194 !== flux_q est le flux de vapeur d'eau: kg/(m**2 s) positive vers bas
195 !== flux_t est le flux de cpt (energie sensible): j/(m**2 s)
196 evap(i) = - zx_mq(i) - zx_nq(i) * tsurf_new(i)
197 fluxlat(i) = - evap(i) * zx_sl(i)
198 fluxsens(i) = zx_mh(i) + zx_nh(i) * tsurf_new(i)
199 ! Derives des flux dF/dTs (W m-2 K-1):
200 dflux_s(i) = zx_nh(i)
201 dflux_l(i) = (zx_sl(i) * zx_nq(i))
202 ! Nouvelle valeure de l'humidite au dessus du sol
203 qsat_new=zx_qsat(i) + zx_dq_s_dt(i) * d_ts(i)
204 q1_new = peqAcoef(i) - peqBcoef(i)*evap(i)*dtime
205 qsurf(i)=q1_new*(1.-beta(i)) + beta(i)*qsat_new
206 ENDDO
207
208 END SUBROUTINE calcul_fluxs
209
210 end module calcul_fluxs_m
  ViewVC Help
Powered by ViewVC 1.1.21