source: LMDZ5/trunk/libf/phy1d/ocean_forced_mod.F90 @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

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