source: trunk/libf/phylmd/surf_ocean_mod.F90 @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago

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