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

Last change on this file since 3784 was 3784, checked in by evignon, 5 years ago

correction v3783 pour convergence et compilation ancienne physique, Etienne aide par Ehouarn
  • 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: 13.1 KB
Line 
1!
2! $Id: ocean_forced_mod.F90 3784 2020-11-09 14:09:22Z 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   
115   
116    ! EV: use calbeta to calculate beta
117    ! Need to initialize qsurf for calbeta but it is not modified by this routine
118    qsurf(:)=0.
119    CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
120
121
122    alb_neig(:) = 0.
123    agesno(:) = 0.
124    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
125
126! Suppose zero surface speed
127    u0(:)=0.0
128    v0(:)=0.0
129    u1_lay(:) = u1(:) - u0(:)
130    v1_lay(:) = v1(:) - v0(:)
131
132! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
133    CALL calcul_fluxs(knon, is_oce, dtime, &
134         tsurf_lim, p1lay, cal, beta, cdragh, cdragq, ps, &
135         precip_rain, precip_snow, snow, qsurf,  &
136         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
137         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
138         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
139         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
140
141    do j = 1, knon
142      i = knindex(j)
143      sens_prec_liq_o(i,1) = sens_prec_liq(j)
144      sens_prec_sol_o(i,1) = sens_prec_sol(j)
145      lat_prec_liq_o(i,1) = lat_prec_liq(j)
146      lat_prec_sol_o(i,1) = lat_prec_sol(j)
147    enddo
148
149
150! - Flux calculation at first modele level for U and V
151    CALL calcul_flux_wind(knon, dtime, &
152         u0, v0, u1, v1, gustiness, cdragm, &
153         AcoefU, AcoefV, BcoefU, BcoefV, &
154         p1lay, temp_air, &
155         flux_u1, flux_v1) 
156
157  END SUBROUTINE ocean_forced_noice
158!
159!***************************************************************************************
160!
161  SUBROUTINE ocean_forced_ice( &
162       itime, dtime, jour, knon, knindex, &
163       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
164       AcoefH, AcoefQ, BcoefH, BcoefQ, &
165       AcoefU, AcoefV, BcoefU, BcoefV, &
166       ps, u1, v1, gustiness, &
167       radsol, snow, qsol, agesno, tsoil, &
168       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
169       tsurf_new, dflux_s, dflux_l)
170!
171! This subroutine treats the ocean where there is ice.
172! The routine reads data from climatologie file and does flux calculations at the
173! surface.
174!
175    USE dimphy
176    USE calcul_fluxs_mod
177    USE surface_data,     ONLY : calice, calsno
178    USE limit_read_mod
179    USE fonte_neige_mod,  ONLY : fonte_neige
180    USE indice_sol_mod
181    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
182
183!   INCLUDE "indicesol.h"
184    INCLUDE "dimsoil.h"
185    INCLUDE "YOMCST.h"
186    INCLUDE "clesphys.h"
187    INCLUDE "flux_arp.h"
188
189! Input arguments
190!****************************************************************************************
191    INTEGER, INTENT(IN)                  :: itime, jour, knon
192    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
193    REAL, INTENT(IN)                     :: dtime
194    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
195    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
196    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
197    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
198    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
199    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
200    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
201    REAL, DIMENSION(klon), INTENT(IN)    :: ps
202    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
203
204! In/Output arguments
205!****************************************************************************************
206    REAL, DIMENSION(klon), INTENT(INOUT)          :: radsol
207    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
208    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
209    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
210
211! Output arguments
212!****************************************************************************************
213    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
214    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
215    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
216    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
217    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
218    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
219    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
220
221! Local variables
222!****************************************************************************************
223    LOGICAL                     :: check=.FALSE.
224    INTEGER                     :: i, j
225    REAL                        :: zfra
226    REAL, PARAMETER             :: t_grnd=271.35
227    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd, capsol
228    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
229    REAL, DIMENSION(klon)       :: soilcap, soilflux
230    REAL, DIMENSION(klon)       :: u0, v0
231    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
232    REAL, DIMENSION(klon)       :: sens_prec_liq, sens_prec_sol   
233    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol   
234
235
236!****************************************************************************************
237! Start calculation
238!****************************************************************************************
239    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
240
241!****************************************************************************************
242! 1)
243! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
244!                    dflux_s, dflux_l and qsurf
245!****************************************************************************************
246
247    tsurf_tmp(:) = tsurf_in(:)
248
249! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
250    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
251
252   
253    IF (soil_model) THEN
254! update tsoil and calculate soilcap and soilflux
255       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
256       cal(1:knon) = RCPD / soilcap(1:knon)
257       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)
258       dif_grnd = 1.0 / tau_gl
259    ELSE
260       dif_grnd = 1.0 / tau_gl
261       cal = RCPD * calice
262       WHERE (snow > 0.0) cal = RCPD * calsno
263    ENDIF
264
265!    beta = 1.0
266    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
267
268! Suppose zero surface speed
269    u0(:)=0.0
270    v0(:)=0.0
271    u1_lay(:) = u1(:) - u0(:)
272    v1_lay(:) = v1(:) - v0(:)
273    CALL calcul_fluxs(knon, is_sic, dtime, &
274         tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
275         precip_rain, precip_snow, snow, qsurf,  &
276         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
277         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
278         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
279         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
280    do j = 1, knon
281      i = knindex(j)
282      sens_prec_liq_o(i,2) = sens_prec_liq(j)
283      sens_prec_sol_o(i,2) = sens_prec_sol(j)
284      lat_prec_liq_o(i,2) = lat_prec_liq(j)
285      lat_prec_sol_o(i,2) = lat_prec_sol(j)
286    enddo
287
288! - Flux calculation at first modele level for U and V
289    CALL calcul_flux_wind(knon, dtime, &
290         u0, v0, u1, v1, gustiness, cdragm, &
291         AcoefU, AcoefV, BcoefU, BcoefV, &
292         p1lay, temp_air, &
293         flux_u1, flux_v1) 
294
295!****************************************************************************************
296! 2)
297! Calculations due to snow and runoff
298!
299!****************************************************************************************
300    CALL fonte_neige( knon, is_sic, knindex, dtime, &
301         tsurf_tmp, precip_rain, precip_snow, &
302         snow, qsol, tsurf_new, evap)
303   
304! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
305!
306    CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) 
307
308    WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
309
310    alb1_new(:) = 0.0
311    DO i=1, knon
312       zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
313       alb1_new(i) = alb_neig(i) * zfra +  0.6 * (1.0-zfra)
314    ENDDO
315
316    alb2_new(:) = alb1_new(:)
317
318  END SUBROUTINE ocean_forced_ice
319
320!************************************************************************
321! 1D case
322!************************************************************************
323!  SUBROUTINE read_tsurf1d(knon,sst_out)
324!
325! This subroutine specifies the surface temperature to be used in 1D simulations
326!
327!      USE dimphy, ONLY : klon
328!
329!      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
330!      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
331!
332!       INTEGER :: i
333! COMMON defined in lmdz1d.F:
334!       real ts_cur
335!       common /sst_forcing/ts_cur
336!
337!       DO i = 1, knon
338!        sst_out(i) = ts_cur
339!       ENDDO
340!
341!      END SUBROUTINE read_tsurf1d
342!
343!
344!************************************************************************
345END MODULE ocean_forced_mod
346
347
348
349
350
351
Note: See TracBrowser for help on using the repository browser.