source: LMDZ5/branches/LMDZ6_rc0/libf/phylmd/surf_ocean_mod.F90 @ 4434

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

Merged trunk changes r2054:2070 into testing branch
  • 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: 7.6 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       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
19       tsurf_new, dflux_s, dflux_l, lmt_bils, &
20       flux_u1, flux_v1)
21
22  USE dimphy
23  USE surface_data, ONLY     : type_ocean
24  USE ocean_forced_mod, ONLY : ocean_forced_noice
25  USE ocean_slab_mod, ONLY   : ocean_slab_noice
26  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
27  USE indice_sol_mod
28!
29! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
30! slab or couple). The calculations of albedo and rugosity for the ocean surface are
31! done in here because they are identical for the different modes of ocean.
32
33
34    INCLUDE "YOMCST.h"
35
36! Input variables
37!****************************************************************************************
38    INTEGER, INTENT(IN)                      :: itime, jour, knon
39    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
40    REAL, INTENT(IN)                         :: dtime
41    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
42    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
43    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
44    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
45    REAL, DIMENSION(klon), INTENT(IN)        :: rugos
46    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
47    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
48    REAL, DIMENSION(klon), INTENT(IN)        :: fder
49    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
50    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
51    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
52    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
53    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
54    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
55    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
56    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
57    REAL, DIMENSION(klon), INTENT(IN)        :: ps
58    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
59    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
60    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
61
62! In/Output variables
63!****************************************************************************************
64    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
65    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
66    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
67
68! Output variables
69!****************************************************************************************
70    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
71    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
72    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
73    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
74    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
75    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
76    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
77    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
78
79! Local variables
80!****************************************************************************************
81    INTEGER               :: i
82    REAL                  :: tmp
83    REAL, PARAMETER       :: cepdu2=(0.1)**2
84    REAL, DIMENSION(klon) :: alb_eau
85    REAL, DIMENSION(klon) :: radsol
86
87! End definition
88!****************************************************************************************
89
90
91!****************************************************************************************
92! Calculate total net radiance at surface
93!
94!****************************************************************************************
95    radsol(:) = 0.0
96    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
97
98!****************************************************************************************
99! Switch according to type of ocean (couple, slab or forced)
100!****************************************************************************************
101    SELECT CASE(type_ocean)
102    CASE('couple')
103       CALL ocean_cpl_noice( &
104            swnet, lwnet, alb1, &
105            windsp, fder, &
106            itime, dtime, knon, knindex, &
107            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
108            AcoefH, AcoefQ, BcoefH, BcoefQ, &
109            AcoefU, AcoefV, BcoefU, BcoefV, &
110            ps, u1, v1, &
111            radsol, snow, agesno, &
112            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
113            tsurf_new, dflux_s, dflux_l)
114
115    CASE('slab')
116       CALL ocean_slab_noice( &
117            itime, dtime, jour, knon, knindex, &
118            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
119            AcoefH, AcoefQ, BcoefH, BcoefQ, &
120            AcoefU, AcoefV, BcoefU, BcoefV, &
121            ps, u1, v1, tsurf_in, &
122            radsol, snow, agesno, &
123            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
124            tsurf_new, dflux_s, dflux_l, lmt_bils)
125       
126    CASE('force')
127       CALL ocean_forced_noice( &
128            itime, dtime, jour, knon, knindex, &
129            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
130            temp_air, spechum, &
131            AcoefH, AcoefQ, BcoefH, BcoefQ, &
132            AcoefU, AcoefV, BcoefU, BcoefV, &
133            ps, u1, v1, &
134            radsol, snow, agesno, &
135            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
136            tsurf_new, dflux_s, dflux_l)
137    END SELECT
138
139!****************************************************************************************
140! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
141!****************************************************************************************
142    IF (type_ocean.NE.'slab') THEN
143        lmt_bils(:)=0.
144        DO i=1,knon
145           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
146           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
147        END DO
148    END IF
149
150!****************************************************************************************
151! Calculate albedo
152!
153!****************************************************************************************
154    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
155       CALL alboc(REAL(jour),rlat,alb_eau)
156    ELSE  ! diurnal cycle
157       CALL alboc_cd(rmu0,alb_eau)
158    ENDIF
159
160    DO i =1, knon
161       alb1_new(i) = alb_eau(knindex(i))
162    ENDDO
163    alb2_new(1:knon) = alb1_new(1:knon)
164
165!****************************************************************************************
166! Calculate the rugosity
167!
168!****************************************************************************************
169    DO i = 1, knon
170       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
171       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
172            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
173       z0_new(i) = MAX(1.5e-05,z0_new(i))
174    ENDDO   
175!
176!****************************************************************************************
177!   
178  END SUBROUTINE surf_ocean
179!
180!****************************************************************************************
181!
182END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.