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

Last change on this file since 2237 was 2227, checked in by Laurent Fairhead, 10 years ago

New ocean albedo.

To activate the new scheme, put iflag_albedo=1 in physiq.def

To activate chlorophyll concentration effect on albedo,
put ok_chlorophyll=y in def file

and download file named chlorophyll.nc
chlorophyll.nc has the same dimension as the model grid with 12 months data,
(i=lon, j=lat, L=1:12) and can be degraded from the original file of dimension
i=1:4320 , j=1:2160 , L=1:12
ada:/workgpfs/rech/psl/rpsl949/clima/chlor_seasonal_clim_seawifs.nc

For 96X96 resolution, chlorophyll.nc file is in
ada:/workgpfs/rech/psl/rpsl949/clima/chlorophyll.nc

  1. Baek
  • 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: 8.0 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       rugos, windsp, rmu0, fder, tsurf_in, &
12       itime, dtime, jour, knon, knindex, &
13       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
16       ps, u1, v1, rugoro, pctsrf, &
17       snow, qsurf, agesno, &
18!albedo SB >>>
19!      z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
20       z0_new, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
21!albedo SB <<<
22       tsurf_new, dflux_s, dflux_l, lmt_bils, &
23       flux_u1, flux_v1)
24
25  USE dimphy
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
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
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)        :: rugos
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
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
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)       :: z0_new
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
95    REAL, DIMENSION(klon) :: radsol
96
97! End definition
98!****************************************************************************************
99
100
101!****************************************************************************************
102! Calculate total net radiance at surface
103!
104!****************************************************************************************
105    radsol(:) = 0.0
106    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
107
108!****************************************************************************************
109! Switch according to type of ocean (couple, slab or forced)
110!****************************************************************************************
111    SELECT CASE(type_ocean)
112    CASE('couple')
113       CALL ocean_cpl_noice( &
114            swnet, lwnet, alb1, &
115            windsp, fder, &
116            itime, dtime, knon, knindex, &
117            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
118            AcoefH, AcoefQ, BcoefH, BcoefQ, &
119            AcoefU, AcoefV, BcoefU, BcoefV, &
120            ps, u1, v1, &
121            radsol, snow, agesno, &
122            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
123            tsurf_new, dflux_s, dflux_l)
124
125    CASE('slab')
126       CALL ocean_slab_noice( &
127            itime, dtime, jour, knon, knindex, &
128            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
129            AcoefH, AcoefQ, BcoefH, BcoefQ, &
130            AcoefU, AcoefV, BcoefU, BcoefV, &
131            ps, u1, v1, tsurf_in, &
132            radsol, snow, &
133            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
134            tsurf_new, dflux_s, dflux_l, lmt_bils)
135       
136    CASE('force')
137       CALL ocean_forced_noice( &
138            itime, dtime, jour, knon, knindex, &
139            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
140            temp_air, spechum, &
141            AcoefH, AcoefQ, BcoefH, BcoefQ, &
142            AcoefU, AcoefV, BcoefU, BcoefV, &
143            ps, u1, v1, &
144            radsol, snow, agesno, &
145            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
146            tsurf_new, dflux_s, dflux_l)
147    END SELECT
148
149!****************************************************************************************
150! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
151!****************************************************************************************
152    IF (type_ocean.NE.'slab') THEN
153        lmt_bils(:)=0.
154        DO i=1,knon
155           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
156           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
157        END DO
158    END IF
159
160!****************************************************************************************
161! Calculate albedo
162!
163!****************************************************************************************
164!albedo SB >>>
165
166
167  if(iflag_albedo==1)then
168    call ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
169  else
170    IF (cycle_diurne) THEN
171       CALL alboc_cd(rmu0,alb_eau)
172    ELSE
173       CALL alboc(REAL(jour),rlat,alb_eau)
174    ENDIF
175
176    DO i =1, knon
177      do  k=1,nsw
178       alb_dir_new(i,k) = alb_eau(knindex(i))
179      enddo
180    ENDDO
181     alb_dif_new=0.05 !alb_dir_new
182endif
183
184!albedo SB <<<
185
186!****************************************************************************************
187! Calculate the rugosity
188!
189!****************************************************************************************
190    DO i = 1, knon
191       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
192       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
193            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
194       z0_new(i) = MAX(1.5e-05,z0_new(i))
195    ENDDO   
196!
197!****************************************************************************************
198!   
199  END SUBROUTINE surf_ocean
200!
201!****************************************************************************************
202!
203END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.