source: LMDZ4/trunk/libf/phylmd/surf_land_mod.F90 @ 902

Last change on this file since 902 was 888, checked in by Laurent Fairhead, 16 years ago

Modifications sur l'albedo JG
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.0 KB
Line 
1!
2! $Header$
3!
4MODULE surf_land_mod
5 
6  USE surface_data, ONLY    : ok_veget
7  USE dimphy
8 
9#ifdef CPP_VEGET
10  USE surf_land_orchidee_mod
11#endif
12  USE surf_land_bucket_mod
13
14  IMPLICIT NONE
15
16CONTAINS
17!
18!****************************************************************************************
19! 
20  SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
21       rlon, rlat, &
22       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
23       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
24       petAcoef, peqAcoef, petBcoef, peqBcoef, &
25       pref, u1_lay, v1_lay, rugoro, pctsrf, &
26       snow, qsol, agesno, tsoil, &
27       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
28       qsurf, tsurf_new, dflux_s, dflux_l, pctsrf_ter, &
29       lwdown_m)
30
31    INCLUDE "indicesol.h"
32    INCLUDE "dimsoil.h"
33    INCLUDE "YOMCST.h"
34
35! Input variables 
36!****************************************************************************************
37    INTEGER, INTENT(IN)                     :: itime, jour, knon
38    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
39    REAL, INTENT(IN)                        :: date0
40    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
41    LOGICAL, INTENT(IN)                     :: debut, lafin
42    REAL, INTENT(IN)                        :: dtime
43    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
44    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
45    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
46    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
47    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
48    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
49    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
50    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
51    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
52    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
53    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
54    REAL, DIMENSION(klon), INTENT(IN)       :: u1_lay, v1_lay
55    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
56    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
57
58    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
59                                                         ! corresponds to previous sollwdown
60
61! In/Output variables
62!****************************************************************************************
63    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
64    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
65    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
66
67! Output variables
68!****************************************************************************************
69    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
70    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
71    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
72    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
73    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat
74    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
75    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
76    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
77    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_ter
78
79! Local variables
80!****************************************************************************************
81    REAL, DIMENSION(klon) :: p1lay_tmp
82    REAL, DIMENSION(klon) :: pref_tmp
83    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
84    REAL, DIMENSION(klon) :: lwdown     ! downwelling longwave radiation at land surface
85    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
86    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
87    INTEGER               :: i
88
89
90!****************************************************************************************
91! Choice between call to vegetation model (ok_veget=true) or simple calculation below
92!
93!****************************************************************************************
94   IF (ok_veget) THEN
95!****************************************************************************************
96!  Call model sechiba in model ORCHIDEE
97!
98!****************************************************************************************
99       p1lay_tmp(:)      = 0.0
100       pref_tmp(:)       = 0.0
101       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
102       pref_tmp(1:knon)  = pref(1:knon)/100.
103!
104!* Calculate incoming flux for SW and LW interval: swdown, lwdown
105!
106       swdown(:) = 0.0
107       lwdown(:) = 0.0
108       DO i = 1, knon
109          swdown(i) = swnet(i)/(1-albedo(i))
110          lwdown(i) = lwnet(i) + RSIGMA*tsurf(i)**4
111       END DO
112!
113!* Calculate potential air temperature
114!
115       epot_air(:) = 0.0
116       DO i = 1, knon
117          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
118       END DO
119
120#ifdef CPP_VEGET
121       ! temporary for keeping same results using lwdown_m instead of lwdown
122       CALL surf_land_orchidee(itime, dtime, date0, knon, &
123            knindex, rlon, rlat, pctsrf, &
124            debut, lafin, &
125            zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
126            tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
127            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
128            pref_tmp, &
129            evap, fluxsens, fluxlat, &             
130            tsol_rad, tsurf_new, alb1_new, alb2_new, &
131            emis_new, z0_new, qsurf)       
132#endif
133
134! 
135!* Add contribution of relief to surface roughness
136! 
137       DO i=1,knon
138          z0_new(i) = SQRT(z0_new(i)**2 + rugoro(i)**2)
139       ENDDO
140
141    ELSE  ! not ok_veget
142!****************************************************************************************
143! No extern vegetation model choosen, call simple bucket calculations instead.
144!
145!****************************************************************************************
146       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
147            tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
148            spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
149            u1_lay, v1_lay, rugoro, swnet, lwnet, &
150            snow, qsol, agesno, tsoil, &
151            qsurf, z0_new, alb1_new, alb2_new, evap, &
152            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
153
154    ENDIF ! ok_veget
155
156!****************************************************************************************
157! Return the pourcentage of land in each grid cell, even if not changed in here!
158!
159!****************************************************************************************
160    pctsrf_ter(:) = pctsrf(:,is_ter)
161
162
163  END SUBROUTINE surf_land
164!
165!****************************************************************************************
166! 
167END MODULE surf_land_mod
168!
169!****************************************************************************************
170! 
Note: See TracBrowser for help on using the repository browser.