source: LMDZ5/trunk/libf/phylmd/surf_ocean_mod.F90 @ 2946

Last change on this file since 2946 was 2719, checked in by fhourdin, 8 years ago

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