source: LMDZ6/branches/IPSLCM6.0.14/libf/phylmd/surf_ocean_mod.F90 @ 5444

Last change on this file since 5444 was 3102, checked in by oboucher, 7 years ago

Removing x permission from these files
  • 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 Author Date Id Revision
File size: 10.8 KB
Line 
1!
2! $Id: surf_ocean_mod.F90 3102 2017-12-03 20:27:42Z fhourdin $
3!
4MODULE surf_ocean_mod
5
6  IMPLICIT NONE
7
8CONTAINS
9!
10!******************************************************************************
11!
12  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
13       windsp, rmu0, fder, tsurf_in, &
14       itime, dtime, jour, knon, knindex, &
15       p1lay, z1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
16       AcoefH, AcoefQ, BcoefH, BcoefQ, &
17       AcoefU, AcoefV, BcoefU, BcoefV, &
18       ps, u1, v1, gustiness, rugoro, pctsrf, &
19       snow, qsurf, agesno, &
20       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
21       tsurf_new, dflux_s, dflux_l, lmt_bils, &
22       flux_u1, flux_v1)
23
24  use albedo, only: alboc, alboc_cd
25  USE dimphy, ONLY: klon, zmasq
26  USE surface_data, ONLY     : type_ocean
27  USE ocean_forced_mod, ONLY : ocean_forced_noice
28  USE ocean_slab_mod, ONLY   : ocean_slab_noice
29  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
30  USE indice_sol_mod, ONLY : nbsrf, is_oce
31  USE limit_read_mod
32!
33! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
34! slab or couple). The calculations of albedo and rugosity for the ocean surface are
35! done in here because they are identical for the different modes of ocean.
36
37
38    INCLUDE "YOMCST.h"
39
40    include "clesphys.h"
41    ! for cycle_diurne and for iflag_z0_oce==-1 (prescribed z0)
42
43! Input variables
44!******************************************************************************
45    INTEGER, INTENT(IN)                      :: itime, jour, knon
46    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
47    REAL, INTENT(IN)                         :: dtime
48    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
49    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
50    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
51    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
52    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
53    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
54    REAL, DIMENSION(klon), INTENT(IN)        :: fder
55    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
56    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
57    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
58    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
59    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
60    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
61    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
62    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
63    REAL, DIMENSION(klon), INTENT(IN)        :: ps
64    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
65    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
66    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
67
68! In/Output variables
69!******************************************************************************
70    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
71    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
72    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
73
74! Output variables
75!******************************************************************************
76    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
77!albedo SB >>>
78!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
79!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
80    REAL, DIMENSION(6), INTENT(IN)          :: SFRWL
81    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
82!albedo SB <<<     
83    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
84    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
85    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
86    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
87    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
88
89! Local variables
90!******************************************************************************
91    INTEGER               :: i, k
92    REAL                  :: tmp
93    REAL, PARAMETER       :: cepdu2=(0.1)**2
94    REAL, DIMENSION(klon) :: alb_eau, z0_lim
95    REAL, DIMENSION(klon) :: radsol
96    REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation
97    CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
98
99! End definition
100!******************************************************************************
101
102
103!******************************************************************************
104! Calculate total net radiance at surface
105!
106!******************************************************************************
107    radsol(1:klon) = 0.0 ! initialisation a priori inutile
108    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
109
110!******************************************************************************
111! Cdragq computed from cdrag
112! The difference comes only from a factor (f_z0qh_oce) on z0, so that
113! it can be computed inside surf_ocean
114! More complicated appraches may require the propagation through
115! pbl_surface of an independant cdragq variable.
116!******************************************************************************
117
118    IF ( f_z0qh_oce .ne. 1.) THEN
119! Si on suit les formulations par exemple de Tessel, on
120! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
121       cdragq(1:knon)=cdragh(1:knon)*                                      &
122       log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))
123    ELSE
124       cdragq(1:knon)=cdragh(1:knon)
125    ENDIF
126
127
128!******************************************************************************
129! Switch according to type of ocean (couple, slab or forced)
130!******************************************************************************
131    SELECT CASE(type_ocean)
132    CASE('couple')
133       CALL ocean_cpl_noice( &
134            swnet, lwnet, alb1, &
135            windsp, fder, &
136            itime, dtime, knon, knindex, &
137            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow,temp_air,spechum,&
138            AcoefH, AcoefQ, BcoefH, BcoefQ, &
139            AcoefU, AcoefV, BcoefU, BcoefV, &
140            ps, u1, v1, gustiness, &
141            radsol, snow, agesno, &
142            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
143            tsurf_new, dflux_s, dflux_l)
144
145    CASE('slab')
146       CALL ocean_slab_noice( &
147            itime, dtime, jour, knon, knindex, &
148            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum,&
149            AcoefH, AcoefQ, BcoefH, BcoefQ, &
150            AcoefU, AcoefV, BcoefU, BcoefV, &
151            ps, u1, v1, gustiness, tsurf_in, &
152            radsol, snow, &
153            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
154            tsurf_new, dflux_s, dflux_l, lmt_bils)
155       
156    CASE('force')
157       CALL ocean_forced_noice( &
158            itime, dtime, jour, knon, knindex, &
159            p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
160            temp_air, spechum, &
161            AcoefH, AcoefQ, BcoefH, BcoefQ, &
162            AcoefU, AcoefV, BcoefU, BcoefV, &
163            ps, u1, v1, gustiness, &
164            radsol, snow, agesno, &
165            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
166            tsurf_new, dflux_s, dflux_l)
167    END SELECT
168
169!******************************************************************************
170! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
171!******************************************************************************
172    IF (type_ocean.NE.'slab') THEN
173        lmt_bils(1:klon)=0.
174        DO i=1,knon
175           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
176           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
177        END DO
178    END IF
179
180!******************************************************************************
181! Calculate ocean surface albedo
182!******************************************************************************
183!albedo SB >>>
184IF (iflag_albedo==0) THEN
185!--old parametrizations of ocean surface albedo
186!
187    IF (cycle_diurne) THEN
188!
189       CALL alboc_cd(rmu0,alb_eau)
190!
191!--ad-hoc correction for model radiative balance tuning
192!--now outside alboc_cd routine
193       alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
194       alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0)
195!
196    ELSE
197!
198       CALL alboc(REAL(jour),rlat,alb_eau)
199!--ad-hoc correction for model radiative balance tuning
200!--now outside alboc routine
201       alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
202       alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60)
203!
204    ENDIF
205!
206    DO i =1, knon
207      DO  k=1,nsw
208       alb_dir_new(i,k) = alb_eau(knindex(i))
209      ENDDO
210    ENDDO
211!IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions
212!albedo for diffuse radiation is taken the same as for direct radiation
213     alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:)
214!IM 09122015 end
215!
216ELSE IF (iflag_albedo==1) THEN
217!--new parametrization of ocean surface albedo by Sunghye Baek
218!--albedo for direct and diffuse radiation are different
219!
220    CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
221!
222!--ad-hoc correction for model radiative balance tuning
223    alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic
224    alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic
225    alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0)
226    alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0)
227!
228! F. Codron albedo read from limit.nc
229ELSE IF (iflag_albedo==2) THEN
230    CALL limit_read_rug_alb(itime, dtime, jour,&
231         knon, knindex, z0_lim, alb_eau)
232    DO i =1, knon
233      DO  k=1,nsw
234       alb_dir_new(i,k) = alb_eau(i)
235      ENDDO
236    ENDDO
237    alb_dif_new=alb_dir_new
238ENDIF
239!albedo SB <<<
240
241!******************************************************************************
242! Calculate the rugosity
243!******************************************************************************
244IF (iflag_z0_oce==0) THEN
245    DO i = 1, knon
246       tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
247       z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
248            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
249       z0m(i) = MAX(1.5e-05,z0m(i))
250    ENDDO   
251    z0h(1:knon)=z0m(1:knon) ! En attendant mieux
252
253ELSE IF (iflag_z0_oce==1) THEN
254    DO i = 1, knon
255       tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
256       z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
257            + 0.11*14e-6 / SQRT(cdragm(i) * tmp)
258       z0m(i) = MAX(1.5e-05,z0m(i))
259       z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp)
260    ENDDO
261ELSE IF (iflag_z0_oce==-1) THEN
262    DO i = 1, knon
263       z0m(i) = z0min
264       z0h(i) = z0min
265    ENDDO
266ELSE
267       CALL abort_physic(modname,'version non prevue',1)
268ENDIF
269!
270!******************************************************************************
271  END SUBROUTINE surf_ocean
272!******************************************************************************
273!
274END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.