My Project
 All Classes Files Functions Variables Macros
surf_landice_mod.F90
Go to the documentation of this file.
1 !
3 
4  IMPLICIT NONE
5 
6 CONTAINS
7 !
8 !****************************************************************************************
9 !
10  SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
11  swnet, lwnet, tsurf, p1lay, &
12  cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
13  acoefh, acoefq, bcoefh, bcoefq, &
14  acoefu, acoefv, bcoefu, bcoefv, &
15  ps, u1, v1, rugoro, pctsrf, &
16  snow, qsurf, qsol, agesno, &
17  tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
18  tsurf_new, dflux_s, dflux_l, &
19  flux_u1, flux_v1)
20 
21  USE dimphy
22  USE surface_data, ONLY : type_ocean, calice, calsno
23  USE fonte_neige_mod, ONLY : fonte_neige, run_off_lic
24  USE cpl_mod, ONLY : cpl_send_landice_fields
27 
28  include "indicesol.h"
29  include "dimsoil.h"
30  include "YOMCST.h"
31  include "clesphys.h"
32 
33 ! Input variables
34 !****************************************************************************************
35  INTEGER, INTENT(IN) :: itime, knon
36  INTEGER, DIMENSION(klon), INTENT(in) :: knindex
37  REAL, INTENT(in) :: dtime
38  REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiance
39  REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiance
40  REAL, DIMENSION(klon), INTENT(IN) :: tsurf
41  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
42  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
43  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
44  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
45  REAL, DIMENSION(klon), INTENT(IN) :: acoefh, acoefq
46  REAL, DIMENSION(klon), INTENT(IN) :: bcoefh, bcoefq
47  REAL, DIMENSION(klon), INTENT(IN) :: acoefu, acoefv, bcoefu, bcoefv
48  REAL, DIMENSION(klon), INTENT(IN) :: ps
49  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
50  REAL, DIMENSION(klon), INTENT(IN) :: rugoro
51  REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
52 
53 ! In/Output variables
54 !****************************************************************************************
55  REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
56  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
57  REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
58 
59 ! Output variables
60 !****************************************************************************************
61  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
62  REAL, DIMENSION(klon), INTENT(OUT) :: z0_new
63  REAL, DIMENSION(klon), INTENT(OUT) :: alb1 ! new albedo in visible SW interval
64  REAL, DIMENSION(klon), INTENT(OUT) :: alb2 ! new albedo in near IR interval
65  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
66  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
67  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
68  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
69 
70 ! Local variables
71 !****************************************************************************************
72  REAL, DIMENSION(klon) :: soilcap, soilflux
73  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
74  REAL, DIMENSION(klon) :: zfra, alb_neig
75  REAL, DIMENSION(klon) :: radsol
76  REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
77  INTEGER :: i,j
78 
79 ! End definition
80 !****************************************************************************************
81 !
82 ! Initialize output variables
83  alb2(:) = 999999.
84  alb1(:) = 999999.
85 
86 !****************************************************************************************
87 ! Calculate total absorbed radiance at surface
88 !
89 !****************************************************************************************
90  radsol(:) = 0.0
91  radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
92 
93 !****************************************************************************************
94 ! Soil calculations
95 !
96 !****************************************************************************************
97  IF (soil_model) THEN
98  CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
99  cal(1:knon) = rcpd / soilcap(1:knon)
100  radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
101  ELSE
102  cal = rcpd * calice
103  WHERE (snow > 0.0) cal = rcpd * calsno
104  ENDIF
105 
106 
107 !****************************************************************************************
108 ! Calulate fluxes
109 !
110 !****************************************************************************************
111  beta(:) = 1.0
112  dif_grnd(:) = 0.0
113 
114 ! Suppose zero surface speed
115  u0(:)=0.0
116  v0(:)=0.0
117  u1_lay(:) = u1(:) - u0(:)
118  v1_lay(:) = v1(:) - v0(:)
119 
120  CALL calcul_fluxs(knon, is_lic, dtime, &
121  tsurf, p1lay, cal, beta, cdragh, ps, &
122  precip_rain, precip_snow, snow, qsurf, &
123  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
124  acoefh, acoefq, bcoefh, bcoefq, &
125  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
126 
127  CALL calcul_flux_wind(knon, dtime, &
128  u0, v0, u1, v1, cdragm, &
129  acoefu, acoefv, bcoefu, bcoefv, &
130  p1lay, temp_air, &
131  flux_u1, flux_v1)
132 
133 !****************************************************************************************
134 ! Calculate snow height, age, run-off,..
135 !
136 !****************************************************************************************
137  CALL fonte_neige( knon, is_lic, knindex, dtime, &
138  tsurf, precip_rain, precip_snow, &
139  snow, qsol, tsurf_new, evap)
140 
141 
142 !****************************************************************************************
143 ! Calculate albedo
144 !
145 !****************************************************************************************
146  CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
147  WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
148  zfra(1:knon) = max(0.0,min(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
149  alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
150  0.6 * (1.0-zfra(1:knon))
151 !
152 !IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
153 ! alb1(1 : knon) = 0.6 !IM cf FH/GK
154 ! alb1(1 : knon) = 0.82
155 ! alb1(1 : knon) = 0.77 !211003 Ksta0.77
156 ! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5
157 !IM: KstaTER0.77 & LMD_ARMIP6
158 
159 ! Attantion: alb1 and alb2 are the same!
160  alb1(1:knon) = 0.77
161  alb2(1:knon) = alb1(1:knon)
162 
163 
164 !****************************************************************************************
165 ! Rugosity
166 !
167 !****************************************************************************************
168  z0_new(:) = max(1.e-3,rugoro(:))
169 
170 !****************************************************************************************
171 ! Send run-off on land-ice to coupler if coupled ocean.
172 ! run_off_lic has been calculated in fonte_neige
173 !
174 !****************************************************************************************
175  IF (type_ocean=='couple') THEN
176  CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
177  ENDIF
178 
179 !****************************************************************************************
180  snow_o=0.
181  zfra_o = 0.
182  DO j = 1, knon
183  i = knindex(j)
184  snow_o(i) = snow(j)
185  zfra_o(i) = zfra(j)
186  ENDDO
187 
188 !****************************************************************************************
189  snow_o=0.
190  zfra_o = 0.
191  DO j = 1, knon
192  i = knindex(j)
193  snow_o(i) = snow(j)
194  zfra_o(i) = zfra(j)
195  ENDDO
196 
197 
198  END SUBROUTINE surf_landice
199 !
200 !****************************************************************************************
201 !
202 END MODULE surf_landice_mod
203 
204 
205