source: lmdz_wrf/trunk/WRFV3/lmdz/surf_land_bucket_mod.F90 @ 1554

Last change on this file since 1554 was 7, checked in by lfita, 10 years ago

Removing checking prints from the development process

File size: 6.6 KB
Line 
1!
2MODULE surf_land_bucket_mod
3!
4! Surface land bucket module
5!
6! This module is used when no external land model is choosen.
7!
8  IMPLICIT NONE
9
10CONTAINS
11
12  SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
13       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
14       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
15       u1, v1, rugoro, swnet, lwnet, &
16       snow, qsol, agesno, tsoil, &
17       qsurf, z0_new, alb1_new, alb2_new, evap, &
18       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
19
20    USE limit_read_mod
21    USE surface_data
22    USE fonte_neige_mod
23    USE calcul_fluxs_mod
24    USE cpl_mod
25    USE dimphy
26    USE comgeomphy
27    USE mod_grid_phy_lmdz
28    USE mod_phys_lmdz_para
29    USE indice_sol_mod
30
31
32!L. Fita, LMD. November, 2013
33    USE NOread_limit_sub_variables
34
35!****************************************************************************************
36! Bucket calculations for surface.
37!
38    INCLUDE "clesphys.h"
39    INCLUDE "dimsoil.h"
40    INCLUDE "YOMCST.h"
41
42! Input variables 
43!****************************************************************************************
44    INTEGER, INTENT(IN)                     :: itime, jour, knon
45    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
46    LOGICAL, INTENT(IN)                     :: debut
47    REAL, INTENT(IN)                        :: dtime
48    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
49    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
50    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
51    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
52    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
53    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
54    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
55    REAL, DIMENSION(klon), INTENT(IN)       :: pref
56    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1
57    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
58    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
59
60! In/Output variables
61!****************************************************************************************
62    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
63    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
64    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
65
66! Output variables
67!****************************************************************************************
68    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
69    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
70    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
71    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
72    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
73    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
74
75! Local variables
76!****************************************************************************************
77    REAL, DIMENSION(klon) :: soilcap, soilflux
78    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
79    REAL, DIMENSION(klon) :: alb_neig, alb_lim
80    REAL, DIMENSION(klon) :: zfra
81    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
82    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
83    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
84    INTEGER               :: i
85
86! Lluis
87    INTEGER               :: lpt
88
89    lpt=MIN(498,knon)
90
91!L. Fita. LMD November 2013.
92!!  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: rugos  ! rugosity at surface (m)
93!    ALLOCATE(z0_lim(klon))
94!    ALLOCATE(alb_lim(klon))
95!
96!****************************************************************************************
97
98
99!
100!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
101!
102!L. Fita, LMD. November 2013. Not any more. Using 'wrflowinput_d[nn]' instead
103!    CALL limit_read_rug_alb(itime, dtime, jour,&
104!         knon, knindex, &
105!         z0_new, alb_lim)
106!!    z0_new=rugos(knindex(1:knon),1)
107!!    alb_lim=albedo
108!!    z0_new = 0.4
109!!    alb_lim = 0.7
110   
111    z0_new(1:knon) = z0_limit(knindex(1:knon))
112    alb_lim(1:knon) = alb_limit(knindex(1:knon))
113!
114!* Calcultaion of fluxes
115!
116
117! calculate total absorbed radiance at surface
118       radsol(:) = 0.0
119       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
120
121! calculate constants
122    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
123    if (type_veget=='betaclim') then
124       CALL calbeta_clim(knon,jour,rlatd(knindex(:)),beta)
125    endif
126       
127! calculate temperature, heat capacity and conduction flux in soil
128    IF (soil_model) THEN
129       CALL soil(dtime, is_ter, knon, snow, tsurf, tsoil, soilcap, soilflux)
130       DO i=1, knon
131          cal(i) = RCPD / soilcap(i)
132          radsol(i) = radsol(i)  + soilflux(i)
133       END DO
134    ELSE
135       cal(:) = RCPD * capsol(:)
136       IF (klon_glo .EQ. 1) THEN
137         cal(:) = 0.
138       ENDIF
139    ENDIF
140   
141! Suppose zero surface speed
142    u0(:)=0.0
143    v0(:)=0.0
144    u1_lay(:) = u1(:) - u0(:)
145    v1_lay(:) = v1(:) - v0(:)
146
147    CALL calcul_fluxs(knon, is_ter, dtime, &
148         tsurf, p1lay, cal, beta, tq_cdrag, pref, &
149         precip_rain, precip_snow, snow, qsurf,  &
150         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
151         petAcoef, peqAcoef, petBcoef, peqBcoef, &
152         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
153   
154!
155!* Calculate snow height, run_off, age of snow
156!     
157
158    CALL fonte_neige( knon, is_ter, knindex, dtime, &
159         tsurf, precip_rain, precip_snow, &
160         snow, qsol, tsurf_new, evap)
161!
162!* Calculate the age of snow
163!
164    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
165   
166    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
167   
168    DO i=1, knon
169       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
170       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
171    END DO
172
173
174!
175!* Return albedo :
176!    alb1_new and alb2_new are here given the same values
177!
178    alb1_new(:) = 0.0
179    alb2_new(:) = 0.0
180    alb1_new(1:knon) = alb_lim(1:knon)
181    alb2_new(1:knon) = alb_lim(1:knon)
182       
183!
184!* Calculate the rugosity
185!
186    DO i = 1, knon
187       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
188    END DO
189
190!* Send to coupler
191!  The run-off from river and coast are not calculated in the bucket modele.
192!  For testing purpose of the coupled modele we put the run-off to zero.
193    IF (type_ocean=='couple') THEN
194       dummy_riverflow(:)   = 0.0
195       dummy_coastalflow(:) = 0.0
196       CALL cpl_send_land_fields(itime, knon, knindex, &
197            dummy_riverflow, dummy_coastalflow)
198    ENDIF
199
200!
201!* End
202!
203  END SUBROUTINE surf_land_bucket
204!
205!****************************************************************************************
206!
207END MODULE surf_land_bucket_mod
Note: See TracBrowser for help on using the repository browser.