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