source: LMDZ5/branches/AI-cosp/libf/phylmd/surf_ocean_mod.F90 @ 2529

Last change on this file since 2529 was 2413, checked in by oboucher, 9 years ago

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