source: LMDZ4/trunk/libf/phytherm/surf_landice_mod.F90 @ 854

Last change on this file since 854 was 814, checked in by Laurent Fairhead, 17 years ago

Rajout de la physique utilisant les thermiques FH
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.5 KB
Line 
1!
2! $Header$
3!
4MODULE surf_landice_mod
5 
6  USE dimphy
7  USE surface_data,     ONLY : ocean, calice, calsno
8  USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
9  USE cpl_mod,          ONLY : cpl_send_landice_fields
10  USE calcul_fluxs_mod, ONLY : calcul_fluxs
11
12  IMPLICIT NONE
13
14CONTAINS
15!
16!****************************************************************************************
17!
18  SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
19       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
20       petAcoef, peqAcoef, petBcoef, peqBcoef, &
21       ps, u1_lay, v1_lay, rugoro, pctsrf, &
22       radsol, snow, qsurf, qsol, agesno, &
23       tsoil, z0_new, alblw, evap, fluxsens, fluxlat, &
24       tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_lic)
25
26    INCLUDE "indicesol.h"
27    INCLUDE "dimsoil.h"
28    INCLUDE "YOMCST.h"
29    INCLUDE "clesphys.h"
30
31! Input variables
32!****************************************************************************************
33    INTEGER, INTENT(IN)                           :: itime, knon
34    INTEGER, DIMENSION(klon), INTENT(in)          :: knindex
35    REAL, INTENT(in)                              :: dtime
36    REAL, DIMENSION(klon), INTENT(IN)             :: tsurf
37    REAL, DIMENSION(klon), INTENT(IN)             :: p1lay
38    REAL, DIMENSION(klon), INTENT(IN)             :: tq_cdrag
39    REAL, DIMENSION(klon), INTENT(IN)             :: precip_rain, precip_snow
40    REAL, DIMENSION(klon), INTENT(IN)             :: temp_air, spechum
41    REAL, DIMENSION(klon), INTENT(IN)             :: petAcoef, peqAcoef
42    REAL, DIMENSION(klon), INTENT(IN)             :: petBcoef, peqBcoef
43    REAL, DIMENSION(klon), INTENT(IN)             :: ps
44    REAL, DIMENSION(klon), INTENT(IN)             :: u1_lay, v1_lay
45    REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
46    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
47
48! In/Output variables
49!****************************************************************************************
50    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
51    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
52    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
53    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
54
55! Output variables
56!****************************************************************************************
57    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
58    REAL, DIMENSION(klon), INTENT(OUT)            :: z0_new
59    REAL, DIMENSION(klon), INTENT(OUT)            :: alblw
60    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
61    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new, alb_new
62    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
63    REAL, DIMENSION(klon), INTENT(OUT)            :: pctsrf_lic
64
65! Local variables
66!****************************************************************************************
67    REAL, DIMENSION(klon)    :: soilcap, soilflux
68    REAL, DIMENSION(klon)    :: cal, beta, dif_grnd
69    REAL, DIMENSION(klon)    :: zfra, alb_neig
70
71! End definition
72!****************************************************************************************
73!
74! Initialize output variables
75    alblw(:) =  999999.
76    alb_new(:) = 999999.
77
78
79!****************************************************************************************
80! Soil calculations
81!
82!****************************************************************************************
83    IF (soil_model) THEN
84       CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
85       cal(1:knon) = RCPD / soilcap(1:knon)
86       radsol(1:knon)  = radsol(1:knon) + soilflux(1:knon)
87    ELSE
88       cal = RCPD * calice
89       WHERE (snow > 0.0) cal = RCPD * calsno
90    ENDIF
91
92
93!****************************************************************************************
94! Calulate fluxes
95!
96!****************************************************************************************
97    beta(:) = 1.0
98    dif_grnd(:) = 0.0
99
100    CALL calcul_fluxs(knon, is_lic, dtime, &
101         tsurf, p1lay, cal, beta, tq_cdrag, ps, &
102         precip_rain, precip_snow, snow, qsurf,  &
103         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
104         petAcoef, peqAcoef, petBcoef, peqBcoef, &
105         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
106
107
108!****************************************************************************************
109! Calculate snow height, age, run-off,..
110!   
111!****************************************************************************************
112    CALL fonte_neige( knon, is_lic, knindex, dtime, &
113         tsurf, precip_rain, precip_snow, &
114         snow, qsol, tsurf_new, evap)
115
116
117!****************************************************************************************
118! Calculate albedo
119!
120!****************************************************************************************
121    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
122    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
123    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
124    alb_new(1:knon)  = alb_neig(1:knon)*zfra(1:knon) + &
125         0.6 * (1.0-zfra(1:knon))
126!
127!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
128!       alb_new(1 : knon)  = 0.6 !IM cf FH/GK
129!       alb_new(1 : knon)  = 0.82
130!       alb_new(1 : knon)  = 0.77 !211003 Ksta0.77
131!       alb_new(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
132!IM: KstaTER0.77 & LMD_ARMIP6   
133
134! Attantion: alb_new and alblw are the same!
135    alb_new(1:knon)  = 0.77
136    alblw(1:knon)    = alb_new(1:knon)
137
138
139!****************************************************************************************
140! Rugosity
141!
142!****************************************************************************************
143    z0_new(:) = rugoro(:)
144
145
146!****************************************************************************************
147! Return the pourcentage for this sub-surface
148!
149!****************************************************************************************
150    pctsrf_lic(:) = pctsrf(:,is_lic)
151   
152
153!****************************************************************************************
154! Send run-off on land-ice to coupler if coupled ocean.
155! run_off_lic has been calculated in fonte_neige
156!
157!****************************************************************************************
158    IF (ocean=='couple') THEN
159       CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
160    ENDIF
161
162
163  END SUBROUTINE surf_landice
164!
165!****************************************************************************************
166!
167END MODULE surf_landice_mod
168
169
170
Note: See TracBrowser for help on using the repository browser.