source: LMDZ5/trunk/libf/phylmd/ocean_forced_mod.F90 @ 2662

Last change on this file since 2662 was 2538, checked in by Laurent Fairhead, 8 years ago

Computation of heat fluxes associated with solid and liquid precipitations
over ocean and seaice. Quantities are sent to the coupler
LF
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 12.7 KB
Line 
1!
2! $Id: ocean_forced_mod.F90 2538 2016-06-03 14:12:16Z jbmadeleine $
3!
4MODULE ocean_forced_mod
5!
6! This module is used for both the sub-surfaces ocean and sea-ice for the case of a
7! forced ocean,  "ocean=force".
8!
9  IMPLICIT NONE
10
11CONTAINS
12!
13!****************************************************************************************
14!
15  SUBROUTINE ocean_forced_noice( &
16       itime, dtime, jour, knon, knindex, &
17       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
18       temp_air, spechum, &
19       AcoefH, AcoefQ, BcoefH, BcoefQ, &
20       AcoefU, AcoefV, BcoefU, BcoefV, &
21       ps, u1, v1, gustiness, &
22       radsol, snow, agesno, &
23       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
24       tsurf_new, dflux_s, dflux_l)
25!
26! This subroutine treats the "open ocean", all grid points that are not entierly covered
27! by ice.
28! The routine receives data from climatologie file limit.nc and does some calculations at the
29! surface.
30!
31    USE dimphy
32    USE calcul_fluxs_mod
33    USE limit_read_mod
34    USE mod_grid_phy_lmdz
35    USE indice_sol_mod
36    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
37
38    INCLUDE "YOMCST.h"
39    INCLUDE "clesphys.h"
40
41
42! Input arguments
43!****************************************************************************************
44    INTEGER, INTENT(IN)                      :: itime, jour, knon
45    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
46    REAL, INTENT(IN)                         :: dtime
47    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
48    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
49    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
50    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
51    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
52    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
53    REAL, DIMENSION(klon), INTENT(IN)        :: ps
54    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
55
56! In/Output arguments
57!****************************************************************************************
58    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
59    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
60    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
61 
62! Output arguments
63!****************************************************************************************
64    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
65    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
66    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
67    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
68    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
69
70! Local variables
71!****************************************************************************************
72    INTEGER                     :: i, j
73    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd
74    REAL, DIMENSION(klon)       :: alb_neig, tsurf_lim, zx_sl
75    REAL, DIMENSION(klon)       :: u0, v0
76    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
77    LOGICAL                     :: check=.FALSE.
78    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
79    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
80
81!****************************************************************************************
82! Start calculation
83!****************************************************************************************
84    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
85   
86!****************************************************************************************
87! 1)   
88! Read sea-surface temperature from file limit.nc
89!
90!****************************************************************************************
91!--sb:
92!!jyg    if (knon.eq.1) then ! single-column model
93    if (klon_glo.eq.1) then ! single-column model
94      CALL read_tsurf1d(knon,tsurf_lim) ! new
95    else ! GCM
96      CALL limit_read_sst(knon,knindex,tsurf_lim)
97    endif ! knon
98!sb--
99
100!****************************************************************************************
101! 2)
102! Flux calculation
103!
104!****************************************************************************************
105! Set some variables for calcul_fluxs
106    cal = 0.
107    beta = 1.
108    dif_grnd = 0.
109    alb_neig(:) = 0.
110    agesno(:) = 0.
111    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
112
113! Suppose zero surface speed
114    u0(:)=0.0
115    v0(:)=0.0
116    u1_lay(:) = u1(:) - u0(:)
117    v1_lay(:) = v1(:) - v0(:)
118
119! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
120    CALL calcul_fluxs(knon, is_oce, dtime, &
121         tsurf_lim, p1lay, cal, beta, cdragh, cdragq, ps, &
122         precip_rain, precip_snow, snow, qsurf,  &
123         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
124         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
125         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
126         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
127
128    do j = 1, knon
129      i = knindex(j)
130      sens_prec_liq_o(i,1) = sens_prec_liq(j)
131      sens_prec_sol_o(i,1) = sens_prec_sol(j)
132      lat_prec_liq_o(i,1) = lat_prec_liq(j)
133      lat_prec_sol_o(i,1) = lat_prec_sol(j)
134    enddo
135
136
137! - Flux calculation at first modele level for U and V
138    CALL calcul_flux_wind(knon, dtime, &
139         u0, v0, u1, v1, gustiness, cdragm, &
140         AcoefU, AcoefV, BcoefU, BcoefV, &
141         p1lay, temp_air, &
142         flux_u1, flux_v1) 
143
144  END SUBROUTINE ocean_forced_noice
145!
146!***************************************************************************************
147!
148  SUBROUTINE ocean_forced_ice( &
149       itime, dtime, jour, knon, knindex, &
150       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
151       AcoefH, AcoefQ, BcoefH, BcoefQ, &
152       AcoefU, AcoefV, BcoefU, BcoefV, &
153       ps, u1, v1, gustiness, &
154       radsol, snow, qsol, agesno, tsoil, &
155       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
156       tsurf_new, dflux_s, dflux_l)
157!
158! This subroutine treats the ocean where there is ice.
159! The routine reads data from climatologie file and does flux calculations at the
160! surface.
161!
162    USE dimphy
163    USE calcul_fluxs_mod
164    USE surface_data,     ONLY : calice, calsno, tau_gl
165    USE limit_read_mod
166    USE fonte_neige_mod,  ONLY : fonte_neige
167    USE indice_sol_mod
168    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
169
170!    INCLUDE "indicesol.h"
171    INCLUDE "dimsoil.h"
172    INCLUDE "YOMCST.h"
173    INCLUDE "clesphys.h"
174
175! Input arguments
176!****************************************************************************************
177    INTEGER, INTENT(IN)                  :: itime, jour, knon
178    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
179    REAL, INTENT(IN)                     :: dtime
180    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
181    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
182    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
183    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
184    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
185    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
186    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
187    REAL, DIMENSION(klon), INTENT(IN)    :: ps
188    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
189
190! In/Output arguments
191!****************************************************************************************
192    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
193    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
194    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
195    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
196
197! Output arguments
198!****************************************************************************************
199    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
200    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
201    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
202    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
203    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
204    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
205    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
206
207! Local variables
208!****************************************************************************************
209    LOGICAL                     :: check=.FALSE.
210    INTEGER                     :: i, j
211    REAL                        :: zfra
212    REAL, PARAMETER             :: t_grnd=271.35
213    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
214    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
215    REAL, DIMENSION(klon)       :: soilcap, soilflux
216    REAL, DIMENSION(klon)       :: u0, v0
217    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
218    REAL, DIMENSION(klon)       :: sens_prec_liq, sens_prec_sol   
219    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol   
220
221
222!****************************************************************************************
223! Start calculation
224!****************************************************************************************
225    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
226
227!****************************************************************************************
228! 1)
229! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
230!                    dflux_s, dflux_l and qsurf
231!****************************************************************************************
232
233    tsurf_tmp(:) = tsurf_in(:)
234
235! calculate the parameters cal, beta, capsol and dif_grnd
236    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
237
238   
239    IF (soil_model) THEN
240! update tsoil and calculate soilcap and soilflux
241       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
242       cal(1:knon) = RCPD / soilcap(1:knon)
243       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
244       dif_grnd = 1.0 / tau_gl
245    ELSE
246       dif_grnd = 1.0 / tau_gl
247       cal = RCPD * calice
248       WHERE (snow > 0.0) cal = RCPD * calsno
249    ENDIF
250
251    beta = 1.0
252    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
253
254! Suppose zero surface speed
255    u0(:)=0.0
256    v0(:)=0.0
257    u1_lay(:) = u1(:) - u0(:)
258    v1_lay(:) = v1(:) - v0(:)
259    CALL calcul_fluxs(knon, is_sic, dtime, &
260         tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
261         precip_rain, precip_snow, snow, qsurf,  &
262         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
263         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
264         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
265         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
266    do j = 1, knon
267      i = knindex(j)
268      sens_prec_liq_o(i,2) = sens_prec_liq(j)
269      sens_prec_sol_o(i,2) = sens_prec_sol(j)
270      lat_prec_liq_o(i,2) = lat_prec_liq(j)
271      lat_prec_sol_o(i,2) = lat_prec_sol(j)
272    enddo
273
274! - Flux calculation at first modele level for U and V
275    CALL calcul_flux_wind(knon, dtime, &
276         u0, v0, u1, v1, gustiness, cdragm, &
277         AcoefU, AcoefV, BcoefU, BcoefV, &
278         p1lay, temp_air, &
279         flux_u1, flux_v1) 
280
281!****************************************************************************************
282! 2)
283! Calculations due to snow and runoff
284!
285!****************************************************************************************
286    CALL fonte_neige( knon, is_sic, knindex, dtime, &
287         tsurf_tmp, precip_rain, precip_snow, &
288         snow, qsol, tsurf_new, evap)
289   
290! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
291!
292    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
293
294    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
295
296    alb1_new(:) = 0.0
297    DO i=1, knon
298       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
299       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
300    ENDDO
301
302    alb2_new(:) = alb1_new(:)
303
304  END SUBROUTINE ocean_forced_ice
305
306!************************************************************************
307! 1D case
308!************************************************************************
309  SUBROUTINE read_tsurf1d(knon,sst_out)
310
311! This subroutine specifies the surface temperature to be used in 1D simulations
312
313      USE dimphy, ONLY : klon
314
315      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
316      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
317
318       INTEGER :: i
319! COMMON defined in lmdz1d.F:
320       real ts_cur
321       common /sst_forcing/ts_cur
322
323       DO i = 1, knon
324        sst_out(i) = ts_cur
325       ENDDO
326
327      END SUBROUTINE read_tsurf1d
328
329!
330!************************************************************************
331!
332END MODULE ocean_forced_mod
333
334
335
336
337
338
Note: See TracBrowser for help on using the repository browser.