source: LMDZ6/branches/Test_modipsl/libf/phylmd/surf_land_mod.F90 @ 5454

Last change on this file since 5454 was 4526, checked in by evignon, 20 months ago

fix bug from merge of blowing snow branch
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.8 KB
Line 
1!
2MODULE surf_land_mod
3
4  IMPLICIT NONE
5
6CONTAINS
7!
8!****************************************************************************************
9! 
10  SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
11       rlon, rlat, yrmu0, &
12       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
13       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
16       pref, u1, v1, gustiness, rugoro, pctsrf, &
17       lwdown_m, q2m, t2m, &
18       snow, qsol, agesno, tsoil, &
19       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, &   
20       qsurf, tsurf_new, dflux_s, dflux_l, &
21       flux_u1, flux_v1 , &
22       veget,lai,height)
23
24    USE dimphy
25    USE surface_data, ONLY    : ok_veget
26    USE carbon_cycle_mod
27
28
29    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
30#ifdef ORCHIDEE_NOOPENMP
31    ! Compilation with cpp key ORCHIDEE NOOPENMP
32    USE surf_land_orchidee_noopenmp_mod
33#else
34#if ORCHIDEE_NOZ0H
35    ! Compilation with cpp key ORCHIDEE NOZ0H
36    USE surf_land_orchidee_noz0h_mod
37#else
38#if ORCHIDEE_NOFREIN
39    ! Compilation with cpp key ORCHIDEE_NOFREIN
40    USE surf_land_orchidee_nofrein_mod
41#else
42#if ORCHIDEE_NOUNSTRUCT
43    ! Compilation with cpp key ORCHIDEE_NOUNSTRUCT
44    USE surf_land_orchidee_nounstruct_mod
45#else
46#if ORCHIDEE_NOLIC
47    ! Compilation with cpp key ORCHIDEE_NOLIC
48    USE surf_land_orchidee_nolic_mod
49#else
50    ! Default version
51    USE surf_land_orchidee_mod
52#endif
53#endif
54#endif
55#endif
56#endif
57   
58    USE surf_land_bucket_mod
59    USE calcul_fluxs_mod
60    USE indice_sol_mod
61    USE print_control_mod, ONLY: lunout
62
63    INCLUDE "dimsoil.h"
64    INCLUDE "YOMCST.h"
65    INCLUDE "clesphys.h"
66    INCLUDE "dimpft.h"
67
68! Input variables 
69!****************************************************************************************
70    INTEGER, INTENT(IN)                     :: itime, jour, knon
71    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
72    REAL, INTENT(IN)                        :: date0
73    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
74    REAL, DIMENSION(klon), INTENT(IN)       :: yrmu0  ! cosine of solar zenith angle
75    LOGICAL, INTENT(IN)                     :: debut, lafin
76    REAL, INTENT(IN)                        :: dtime
77    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
78    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
79    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
80    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
81    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
82    REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
83    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow, precip_bs
84    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
85    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefH, AcoefQ, BcoefH, BcoefQ
86    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefU, AcoefV, BcoefU, BcoefV
87    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
88    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
89    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
90    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
91    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
92                                                         ! corresponds to previous sollwdown
93    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
94
95! In/Output variables
96!****************************************************************************************
97    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
98    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
99    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
100
101! Output variables
102!****************************************************************************************
103    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
104!albedo SB >>>
105!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
106!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
107    REAL, DIMENSION(6), INTENT(IN) :: SFRWL
108    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
109!albedo SB <<<
110    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
111    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat, fluxbs
112    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
113    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
114    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
115    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
116    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
117    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
118
119! Local variables
120!****************************************************************************************
121    REAL, DIMENSION(klon) :: p1lay_tmp
122    REAL, DIMENSION(klon) :: pref_tmp
123    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
124    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
125    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
126    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
127    REAL, DIMENSION(klon) :: precip_totsnow     ! total solid precip
128    INTEGER               :: i
129
130!albedo SB >>>
131    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
132!albedo SB <<<
133
134
135!****************************************************************************************
136!Total solid precip
137
138IF (ok_bs) THEN
139precip_totsnow(:)=precip_snow(:)+precip_bs(:)
140ELSE
141precip_totsnow(:)=precip_snow(:)
142ENDIF
143!****************************************************************************************
144
145
146!****************************************************************************************
147! Choice between call to vegetation model (ok_veget=true) or simple calculation below
148!
149!****************************************************************************************
150   IF (ok_veget) THEN
151!****************************************************************************************
152!  Call model sechiba in model ORCHIDEE
153!
154!****************************************************************************************
155       p1lay_tmp(:)      = 0.0
156       pref_tmp(:)       = 0.0
157       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
158       pref_tmp(1:knon)  = pref(1:knon)/100.
159!
160!* Calculate incoming flux for SW and LW interval: swdown
161!
162       swdown(:) = 0.0
163       DO i = 1, knon
164          swdown(i) = swnet(i)/(1-albedo(i))
165       END DO
166!
167!* Calculate potential air temperature
168!
169       epot_air(:) = 0.0
170       DO i = 1, knon
171          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
172       END DO
173
174       ! temporary for keeping same results using lwdown_m instead of lwdown
175       CALL surf_land_orchidee(itime, dtime, date0, knon, &
176            knindex, rlon, rlat, yrmu0, pctsrf, &
177            debut, lafin, &
178            zlev,  u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, &
179            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
180            precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
181            pref_tmp, q2m, t2m, &
182            evap, fluxsens, fluxlat,  &             
183            tsol_rad, tsurf_new, alb1_new, alb2_new, &
184            emis_new, z0m, z0h, qsurf, &
185            veget, lai, height)       
186! 
187!* Add contribution of relief to surface roughness
188! 
189       DO i=1,knon
190          z0m(i) = MAX(1.5e-05,SQRT(z0m(i)**2 + rugoro(i)**2))
191       ENDDO
192
193    ELSE  ! not ok_veget
194!****************************************************************************************
195! No extern vegetation model choosen, call simple bucket calculations instead.
196!
197!****************************************************************************************
198       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
199            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
200            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
201            u1, v1, gustiness, rugoro, swnet, lwnet, &
202            snow, qsol, agesno, tsoil, &
203            qsurf, z0m, alb1_new, alb2_new, evap, &
204            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
205        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
206
207
208    ENDIF ! ok_veget
209
210        ! blowing snow not treated yet over land
211        fluxbs(:)=0.
212
213
214!****************************************************************************************
215! Calculation for all land models
216! - Flux calculation at first modele level for U and V
217!****************************************************************************************
218! Suppose zero surface speed
219    u0(:)=0.0
220    v0(:)=0.0
221    CALL calcul_flux_wind(knon, dtime, &
222         u0, v0, u1, v1, gustiness, cdragm, &
223         AcoefU, AcoefV, BcoefU, BcoefV, &
224         p1lay, temp_air, &
225         flux_u1, flux_v1)
226
227!albedo SB >>>
228     SELECT CASE(NSW)
229     CASE(2)
230       alb_dir_new(1:knon,1)=alb1_new(1:knon)
231       alb_dir_new(1:knon,2)=alb2_new(1:knon)
232     CASE(4)
233       alb_dir_new(1:knon,1)=alb1_new(1:knon)
234       alb_dir_new(1:knon,2)=alb2_new(1:knon)
235       alb_dir_new(1:knon,3)=alb2_new(1:knon)
236       alb_dir_new(1:knon,4)=alb2_new(1:knon)
237     CASE(6)
238       alb_dir_new(1:knon,1)=alb1_new(1:knon)
239       alb_dir_new(1:knon,2)=alb1_new(1:knon)
240       alb_dir_new(1:knon,3)=alb1_new(1:knon)
241       alb_dir_new(1:knon,4)=alb2_new(1:knon)
242       alb_dir_new(1:knon,5)=alb2_new(1:knon)
243       alb_dir_new(1:knon,6)=alb2_new(1:knon)
244     END SELECT
245
246     alb_dif_new=alb_dir_new
247!albedo SB <<<
248   
249  END SUBROUTINE surf_land
250!
251!****************************************************************************************
252! 
253END MODULE surf_land_mod
254!
255!****************************************************************************************
256! 
Note: See TracBrowser for help on using the repository browser.