source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/surf_land_bucket_mod.F90 @ 3809

Last change on this file since 3809 was 3809, checked in by ymipsl, 10 years ago

Add LMDZ in aquaplanet configuration
YM
File size: 6.1 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, gustiness, 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! Bucket calculations for surface.
32!
33    INCLUDE "clesphys.h"
34    INCLUDE "dimsoil.h"
35    INCLUDE "YOMCST.h"
36
37! Input variables 
38!****************************************************************************************
39    INTEGER, INTENT(IN)                     :: itime, jour, knon
40    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
41    LOGICAL, INTENT(IN)                     :: debut
42    REAL, INTENT(IN)                        :: dtime
43    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
44    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
45    REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
46    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
47    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
48    REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
49    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
50    REAL, DIMENSION(klon), INTENT(IN)       :: pref
51    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
52    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
53    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
54
55! In/Output variables
56!****************************************************************************************
57    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
58    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
59    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
60
61! Output variables
62!****************************************************************************************
63    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
64    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
65    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
66    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
67    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
68    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
69
70! Local variables
71!****************************************************************************************
72    REAL, DIMENSION(klon) :: soilcap, soilflux
73    REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
74    REAL, DIMENSION(klon) :: alb_neig, alb_lim
75    REAL, DIMENSION(klon) :: zfra
76    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
77    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
78    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
79    INTEGER               :: i
80!
81!****************************************************************************************
82
83
84!
85!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
86!
87    CALL limit_read_rug_alb(itime, dtime, jour,&
88         knon, knindex, &
89         z0_new, alb_lim)
90!
91!* Calcultaion of fluxes
92!
93
94! calculate total absorbed radiance at surface
95       radsol(:) = 0.0
96       radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
97
98! calculate constants
99    CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
100    if (type_veget=='betaclim') then
101       CALL calbeta_clim(knon,jour,rlatd(knindex(1:knon)),beta)
102    endif
103       
104! calculate temperature, heat capacity and conduction flux in soil
105    IF (soil_model) THEN
106       CALL soil(dtime, is_ter, knon, snow, tsurf, tsoil, soilcap, soilflux)
107       DO i=1, knon
108          cal(i) = RCPD / soilcap(i)
109          radsol(i) = radsol(i)  + soilflux(i)
110       END DO
111    ELSE
112       cal(:) = RCPD * capsol(:)
113       IF (klon_glo .EQ. 1) THEN
114         cal(:) = 0.
115       ENDIF
116    ENDIF
117   
118! Suppose zero surface speed
119    u0(:)=0.0
120    v0(:)=0.0
121    u1_lay(:) = u1(:) - u0(:)
122    v1_lay(:) = v1(:) - v0(:)
123
124    CALL calcul_fluxs(knon, is_ter, dtime, &
125         tsurf, p1lay, cal, beta, tq_cdrag, pref, &
126         precip_rain, precip_snow, snow, qsurf,  &
127         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
128         petAcoef, peqAcoef, petBcoef, peqBcoef, &
129         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
130   
131!
132!* Calculate snow height, run_off, age of snow
133!     
134    CALL fonte_neige( knon, is_ter, knindex, dtime, &
135         tsurf, precip_rain, precip_snow, &
136         snow, qsol, tsurf_new, evap)
137!
138!* Calculate the age of snow
139!
140    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
141   
142    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
143   
144    DO i=1, knon
145       zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
146       alb_lim(i)  = alb_neig(i) *zfra(i) + alb_lim(i)*(1.0-zfra(i))
147    END DO
148
149!
150!* Return albedo :
151!    alb1_new and alb2_new are here given the same values
152!
153    alb1_new(:) = 0.0
154    alb2_new(:) = 0.0
155    alb1_new(1:knon) = alb_lim(1:knon)
156    alb2_new(1:knon) = alb_lim(1:knon)
157       
158!
159!* Calculate the rugosity
160!
161    DO i = 1, knon
162       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
163    END DO
164
165!* Send to coupler
166!  The run-off from river and coast are not calculated in the bucket modele.
167!  For testing purpose of the coupled modele we put the run-off to zero.
168    IF (type_ocean=='couple') THEN
169       dummy_riverflow(:)   = 0.0
170       dummy_coastalflow(:) = 0.0
171       CALL cpl_send_land_fields(itime, knon, knindex, &
172            dummy_riverflow, dummy_coastalflow)
173    ENDIF
174
175!
176!* End
177!
178  END SUBROUTINE surf_land_bucket
179!
180!****************************************************************************************
181!
182END MODULE surf_land_bucket_mod
Note: See TracBrowser for help on using the repository browser.