My Project
 All Classes Files Functions Variables Macros
ocean_forced_mod.F90
Go to the documentation of this file.
1 !
2 MODULE ocean_forced_mod
3 !
4 ! This module is used for both the sub-surfaces ocean and sea-ice for the case of a
5 ! forced ocean, "ocean=force".
6 !
7  IMPLICIT NONE
8 
9 CONTAINS
10 !
11 !****************************************************************************************
12 !
13  SUBROUTINE ocean_forced_noice( &
14  itime, dtime, jour, knon, knindex, &
15  p1lay, cdragh, cdragm, precip_rain, precip_snow, &
16  temp_air, spechum, &
17  acoefh, acoefq, bcoefh, bcoefq, &
18  acoefu, acoefv, bcoefu, bcoefv, &
19  ps, u1, v1, &
20  radsol, snow, agesno, &
21  qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
22  tsurf_new, dflux_s, dflux_l)
23 !
24 ! This subroutine treats the "open ocean", all grid points that are not entierly covered
25 ! by ice.
26 ! The routine receives data from climatologie file limit.nc and does some calculations at the
27 ! surface.
28 !
29  USE dimphy
30  USE calcul_fluxs_mod
31  USE limit_read_mod
32  include "indicesol.h"
33  include "YOMCST.h"
34 
35 ! Input arguments
36 !****************************************************************************************
37  INTEGER, INTENT(IN) :: itime, jour, knon
38  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
39  REAL, INTENT(IN) :: dtime
40  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
41  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
42  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
43  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
44  REAL, DIMENSION(klon), INTENT(IN) :: acoefh, acoefq, bcoefh, bcoefq
45  REAL, DIMENSION(klon), INTENT(IN) :: acoefu, acoefv, bcoefu, bcoefv
46  REAL, DIMENSION(klon), INTENT(IN) :: ps
47  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
48 
49 ! In/Output arguments
50 !****************************************************************************************
51  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
52  REAL, DIMENSION(klon), INTENT(INOUT) :: snow
53  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno !? put to 0 in ocean
54 
55 ! Output arguments
56 !****************************************************************************************
57  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
58  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
59  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
60  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
61  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
62 
63 ! Local variables
64 !****************************************************************************************
65  INTEGER :: i
66  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
67  REAL, DIMENSION(klon) :: alb_neig, tsurf_lim, zx_sl
68  REAL, DIMENSION(klon) :: u0, v0
69  REAL, DIMENSION(klon) :: u1_lay, v1_lay
70  LOGICAL :: check=.false.
71 
72 !****************************************************************************************
73 ! Start calculation
74 !****************************************************************************************
75  IF (check) WRITE(*,*)' Entering ocean_forced_noice'
76 
77 !****************************************************************************************
78 ! 1)
79 ! Read sea-surface temperature from file limit.nc
80 !
81 !****************************************************************************************
82  CALL limit_read_sst(knon,knindex,tsurf_lim)
83 
84 !****************************************************************************************
85 ! 2)
86 ! Flux calculation
87 !
88 !****************************************************************************************
89 ! Set some variables for calcul_fluxs
90  cal = 0.
91  beta = 1.
92  dif_grnd = 0.
93  alb_neig(:) = 0.
94  agesno(:) = 0.
95 ! Suppose zero surface speed
96  u0(:)=0.0
97  v0(:)=0.0
98  u1_lay(:) = u1(:) - u0(:)
99  v1_lay(:) = v1(:) - v0(:)
100 
101 ! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
102  CALL calcul_fluxs(knon, is_oce, dtime, &
103  tsurf_lim, p1lay, cal, beta, cdragh, ps, &
104  precip_rain, precip_snow, snow, qsurf, &
105  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
106  acoefh, acoefq, bcoefh, bcoefq, &
107  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
108 
109 ! - Flux calculation at first modele level for U and V
110  CALL calcul_flux_wind(knon, dtime, &
111  u0, v0, u1, v1, cdragm, &
112  acoefu, acoefv, bcoefu, bcoefv, &
113  p1lay, temp_air, &
114  flux_u1, flux_v1)
115 
116  END SUBROUTINE ocean_forced_noice
117 !
118 !***************************************************************************************
119 !
120  SUBROUTINE ocean_forced_ice( &
121  itime, dtime, jour, knon, knindex, &
122  tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
123  acoefh, acoefq, bcoefh, bcoefq, &
124  acoefu, acoefv, bcoefu, bcoefv, &
125  ps, u1, v1, &
126  radsol, snow, qsol, agesno, tsoil, &
127  qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
128  tsurf_new, dflux_s, dflux_l)
129 !
130 ! This subroutine treats the ocean where there is ice.
131 ! The routine reads data from climatologie file and does flux calculations at the
132 ! surface.
133 !
134  USE dimphy
135  USE calcul_fluxs_mod
136  USE surface_data, ONLY : calice, calsno, tau_gl
137  USE limit_read_mod
138  USE fonte_neige_mod, ONLY : fonte_neige
139 
140  include "indicesol.h"
141  include "dimsoil.h"
142  include "YOMCST.h"
143  include "clesphys.h"
144 
145 ! Input arguments
146 !****************************************************************************************
147  INTEGER, INTENT(IN) :: itime, jour, knon
148  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
149  REAL, INTENT(IN) :: dtime
150  REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in
151  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
152  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
153  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
154  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
155  REAL, DIMENSION(klon), INTENT(IN) :: acoefh, acoefq, bcoefh, bcoefq
156  REAL, DIMENSION(klon), INTENT(IN) :: acoefu, acoefv, bcoefu, bcoefv
157  REAL, DIMENSION(klon), INTENT(IN) :: ps
158  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
159 
160 ! In/Output arguments
161 !****************************************************************************************
162  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
163  REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
164  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
165  REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
166 
167 ! Output arguments
168 !****************************************************************************************
169  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
170  REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
171  REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
172  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
173  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
174  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
175  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
176 
177 ! Local variables
178 !****************************************************************************************
179  LOGICAL :: check=.false.
180  INTEGER :: i
181  REAL :: zfra
182  REAL, PARAMETER :: t_grnd=271.35
183  REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
184  REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp
185  REAL, DIMENSION(klon) :: soilcap, soilflux
186  REAL, DIMENSION(klon) :: u0, v0
187  REAL, DIMENSION(klon) :: u1_lay, v1_lay
188 
189 !****************************************************************************************
190 ! Start calculation
191 !****************************************************************************************
192  IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
193 
194 !****************************************************************************************
195 ! 1)
196 ! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
197 ! dflux_s, dflux_l and qsurf
198 !****************************************************************************************
199  tsurf_tmp(:) = tsurf_in(:)
200 
201 ! calculate the parameters cal, beta, capsol and dif_grnd
202  CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
203 
204 
205  IF (soil_model) THEN
206 ! update tsoil and calculate soilcap and soilflux
207  CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
208  cal(1:knon) = rcpd / soilcap(1:knon)
209  radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
210  dif_grnd = 1.0 / tau_gl
211  ELSE
212  dif_grnd = 1.0 / tau_gl
213  cal = rcpd * calice
214  WHERE (snow > 0.0) cal = rcpd * calsno
215  ENDIF
216 
217  beta = 1.0
218 ! Suppose zero surface speed
219  u0(:)=0.0
220  v0(:)=0.0
221  u1_lay(:) = u1(:) - u0(:)
222  v1_lay(:) = v1(:) - v0(:)
223  CALL calcul_fluxs(knon, is_sic, dtime, &
224  tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
225  precip_rain, precip_snow, snow, qsurf, &
226  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
227  acoefh, acoefq, bcoefh, bcoefq, &
228  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
229 
230 ! - Flux calculation at first modele level for U and V
231  CALL calcul_flux_wind(knon, dtime, &
232  u0, v0, u1, v1, cdragm, &
233  acoefu, acoefv, bcoefu, bcoefv, &
234  p1lay, temp_air, &
235  flux_u1, flux_v1)
236 
237 !****************************************************************************************
238 ! 2)
239 ! Calculations due to snow and runoff
240 !
241 !****************************************************************************************
242  CALL fonte_neige( knon, is_sic, knindex, dtime, &
243  tsurf_tmp, precip_rain, precip_snow, &
244  snow, qsol, tsurf_new, evap)
245 
246 ! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
247 !
248  CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))
249 
250  WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
251 
252  alb1_new(:) = 0.0
253  DO i=1, knon
254  zfra = max(0.0,min(1.0,snow(i)/(snow(i)+10.0)))
255  alb1_new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra)
256  ENDDO
257 
258  alb2_new(:) = alb1_new(:)
259 
260  END SUBROUTINE ocean_forced_ice
261 !
262 !****************************************************************************************
263 !
264 END MODULE ocean_forced_mod
265 
266 
267 
268 
269 
270