source: LMDZ6/trunk/libf/phylmd/ocean_forced_mod.F90 @ 3780

Last change on this file since 3780 was 3780, checked in by evignon, 4 years ago

Premiere comission Etienne: changements pour le 1D (forcage en Ts au dessus des continents) et inclusion drag arbres dans yamada4_num=6
  • 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:keywords set to Id
File size: 12.3 KB
Line 
1!
2! $Id: ocean_forced_mod.F90 3780 2020-10-22 12:50:18Z evignon $
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    INCLUDE "flux_arp.h"
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      ! EV: now surface Tin flux_arp.h
95      !CALL read_tsurf1d(knon,tsurf_lim) ! new
96       DO i = 1, knon
97        tsurf_lim(i) = tg
98       ENDDO
99
100    else ! GCM
101      CALL limit_read_sst(knon,knindex,tsurf_lim)
102    endif ! knon
103!sb--
104
105!****************************************************************************************
106! 2)
107! Flux calculation
108!
109!****************************************************************************************
110! Set some variables for calcul_fluxs
111    !cal = 0.
112    !beta = 1.
113    !dif_grnd = 0.
114    ! EV: use calbeta to calculate beta
115   
116    CALL calbeta(dtime, is_oce, knon, snow, beta*0., beta, cal, dif_grnd)
117
118
119    alb_neig(:) = 0.
120    agesno(:) = 0.
121    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
122
123! Suppose zero surface speed
124    u0(:)=0.0
125    v0(:)=0.0
126    u1_lay(:) = u1(:) - u0(:)
127    v1_lay(:) = v1(:) - v0(:)
128
129! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
130    CALL calcul_fluxs(knon, is_oce, dtime, &
131         tsurf_lim, p1lay, cal, beta, cdragh, cdragq, ps, &
132         precip_rain, precip_snow, snow, qsurf,  &
133         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
134         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
135         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
136         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
137
138    do j = 1, knon
139      i = knindex(j)
140      sens_prec_liq_o(i,1) = sens_prec_liq(j)
141      sens_prec_sol_o(i,1) = sens_prec_sol(j)
142      lat_prec_liq_o(i,1) = lat_prec_liq(j)
143      lat_prec_sol_o(i,1) = lat_prec_sol(j)
144    enddo
145
146
147! - Flux calculation at first modele level for U and V
148    CALL calcul_flux_wind(knon, dtime, &
149         u0, v0, u1, v1, gustiness, cdragm, &
150         AcoefU, AcoefV, BcoefU, BcoefV, &
151         p1lay, temp_air, &
152         flux_u1, flux_v1) 
153
154  END SUBROUTINE ocean_forced_noice
155!
156!***************************************************************************************
157!
158  SUBROUTINE ocean_forced_ice( &
159       itime, dtime, jour, knon, knindex, &
160       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
161       AcoefH, AcoefQ, BcoefH, BcoefQ, &
162       AcoefU, AcoefV, BcoefU, BcoefV, &
163       ps, u1, v1, gustiness, &
164       radsol, snow, qsol, agesno, tsoil, &
165       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
166       tsurf_new, dflux_s, dflux_l)
167!
168! This subroutine treats the ocean where there is ice.
169! The routine reads data from climatologie file and does flux calculations at the
170! surface.
171!
172    USE dimphy
173    USE calcul_fluxs_mod
174    USE surface_data,     ONLY : calice, calsno
175    USE limit_read_mod
176    USE fonte_neige_mod,  ONLY : fonte_neige
177    USE indice_sol_mod
178    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
179
180!    INCLUDE "indicesol.h"
181    INCLUDE "dimsoil.h"
182    INCLUDE "YOMCST.h"
183    INCLUDE "clesphys.h"
184    INCLUDE "flux_arp.h"
185
186! Input arguments
187!****************************************************************************************
188    INTEGER, INTENT(IN)                  :: itime, jour, knon
189    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
190    REAL, INTENT(IN)                     :: dtime
191    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
192    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
193    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
194    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
195    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
196    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
197    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
198    REAL, DIMENSION(klon), INTENT(IN)    :: ps
199    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
200
201! In/Output arguments
202!****************************************************************************************
203    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
204    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
205    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
206    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
207
208! Output arguments
209!****************************************************************************************
210    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
211    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
212    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
213    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
214    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
215    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
216    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
217
218! Local variables
219!****************************************************************************************
220    LOGICAL                     :: check=.FALSE.
221    INTEGER                     :: i, j
222    REAL                        :: zfra
223    REAL, PARAMETER             :: t_grnd=271.35
224    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
225    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
226    REAL, DIMENSION(klon)       :: soilcap, soilflux
227    REAL, DIMENSION(klon)       :: u0, v0
228    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
229    REAL, DIMENSION(klon)       :: sens_prec_liq, sens_prec_sol   
230    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol   
231
232
233!****************************************************************************************
234! Start calculation
235!****************************************************************************************
236    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
237
238!****************************************************************************************
239! 1)
240! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
241!                    dflux_s, dflux_l and qsurf
242!****************************************************************************************
243
244    tsurf_tmp(:) = tsurf_in(:)
245
246! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
247    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, cal, dif_grnd)
248
249   
250    IF (soil_model) THEN
251! update tsoil and calculate soilcap and soilflux
252       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
253       cal(1:knon) = RCPD / soilcap(1:knon)
254       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
255       dif_grnd = 1.0 / tau_gl
256    ELSE
257       dif_grnd = 1.0 / tau_gl
258       cal = RCPD * calice
259       WHERE (snow > 0.0) cal = RCPD * calsno
260    ENDIF
261
262    !beta = 1.0
263    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
264
265! Suppose zero surface speed
266    u0(:)=0.0
267    v0(:)=0.0
268    u1_lay(:) = u1(:) - u0(:)
269    v1_lay(:) = v1(:) - v0(:)
270    CALL calcul_fluxs(knon, is_sic, dtime, &
271         tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
272         precip_rain, precip_snow, snow, qsurf,  &
273         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
274         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
275         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
276         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
277    do j = 1, knon
278      i = knindex(j)
279      sens_prec_liq_o(i,2) = sens_prec_liq(j)
280      sens_prec_sol_o(i,2) = sens_prec_sol(j)
281      lat_prec_liq_o(i,2) = lat_prec_liq(j)
282      lat_prec_sol_o(i,2) = lat_prec_sol(j)
283    enddo
284
285! - Flux calculation at first modele level for U and V
286    CALL calcul_flux_wind(knon, dtime, &
287         u0, v0, u1, v1, gustiness, cdragm, &
288         AcoefU, AcoefV, BcoefU, BcoefV, &
289         p1lay, temp_air, &
290         flux_u1, flux_v1) 
291
292!****************************************************************************************
293! 2)
294! Calculations due to snow and runoff
295!
296!****************************************************************************************
297    CALL fonte_neige( knon, is_sic, knindex, dtime, &
298         tsurf_tmp, precip_rain, precip_snow, &
299         snow, qsol, tsurf_new, evap)
300   
301! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
302!
303    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
304
305    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
306
307    alb1_new(:) = 0.0
308    DO i=1, knon
309       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
310       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
311    ENDDO
312
313    alb2_new(:) = alb1_new(:)
314
315  END SUBROUTINE ocean_forced_ice
316
317!
318!************************************************************************
319!
320END MODULE ocean_forced_mod
321
322
323
324
325
326
Note: See TracBrowser for help on using the repository browser.