source: LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90 @ 1067

Last change on this file since 1067 was 1067, checked in by Laurent Fairhead, 16 years ago
  • Modifications lie au premier niveau du modele pour la diffusion turbulent

du vent.

  • Preparation pour un couplage des courrant oceaniques.

JG
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.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       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, DIMENSION(klon) :: alb_eau
82    REAL, DIMENSION(klon) :: radsol
83
84! End definition
85!****************************************************************************************
86
87
88!****************************************************************************************
89! Calculate total net radiance at surface
90!
91!****************************************************************************************
92    radsol(:) = 0.0
93    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
94
95!****************************************************************************************
96! Switch according to type of ocean (couple, slab or forced)
97!****************************************************************************************
98    SELECT CASE(type_ocean)
99    CASE('couple')
100       CALL ocean_cpl_noice( &
101            swnet, lwnet, alb1, &
102            windsp, fder, &
103            itime, dtime, knon, knindex, &
104            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
105            AcoefH, AcoefQ, BcoefH, BcoefQ, &
106            AcoefU, AcoefV, BcoefU, BcoefV, &
107            ps, u1, v1, &
108            radsol, snow, agesno, &
109            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
110            tsurf_new, dflux_s, dflux_l)
111
112    CASE('slab')
113       CALL ocean_slab_noice( &
114            itime, dtime, jour, knon, knindex, &
115            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
116            AcoefH, AcoefQ, BcoefH, BcoefQ, &
117            AcoefU, AcoefV, BcoefU, BcoefV, &
118            ps, u1, v1, tsurf_in, &
119            radsol, snow, agesno, &
120            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
121            tsurf_new, dflux_s, dflux_l, lmt_bils)
122       
123    CASE('force')
124       CALL ocean_forced_noice( &
125            itime, dtime, jour, knon, knindex, &
126            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
127            temp_air, spechum, &
128            AcoefH, AcoefQ, BcoefH, BcoefQ, &
129            AcoefU, AcoefV, BcoefU, BcoefV, &
130            ps, u1, v1, &
131            radsol, snow, agesno, &
132            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
133            tsurf_new, dflux_s, dflux_l)
134    END SELECT
135
136!****************************************************************************************
137! Calculate albedo
138!
139!****************************************************************************************
140    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
141       CALL alboc(FLOAT(jour),rlat,alb_eau)
142    ELSE  ! diurnal cycle
143       CALL alboc_cd(rmu0,alb_eau)
144    ENDIF
145
146    DO i =1, knon
147       alb1_new(i) = alb_eau(knindex(i))
148    ENDDO
149    alb2_new(1:knon) = alb1_new(1:knon)
150
151!****************************************************************************************
152! Calculate the rugosity
153!
154!****************************************************************************************
155    z0_new = SQRT(rugos**2 + rugoro**2)
156
157    ! The rugosity is recalculated with another method
158    z0_new(:) = 0.0
159    DO i = 1, knon
160       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
161            +  0.11*14e-6 / SQRT(cdragm(i) * (u1(i)**2+v1(i)**2))
162       z0_new(i) = MAX(1.5e-05,z0_new(i))
163    ENDDO
164   
165!
166!****************************************************************************************
167!   
168  END SUBROUTINE surf_ocean
169!
170!****************************************************************************************
171!
172END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.