source: LMDZ4/trunk/libf/phytherm/surf_ocean_mod.F90 @ 1072

Last change on this file since 1072 was 814, checked in by Laurent Fairhead, 17 years ago

Rajout de la physique utilisant les thermiques FH
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.3 KB
RevLine 
[814]1!
2! $Header$
3!
4MODULE surf_ocean_mod
5
6  USE dimphy
7  USE surface_data, ONLY     : ocean
8  USE ocean_forced_mod, ONLY : ocean_forced_noice
9  USE ocean_slab_mod, ONLY   : ocean_slab_noice
10  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
11
12  IMPLICIT NONE
13
14CONTAINS
15!
16!****************************************************************************************
17!
18  SUBROUTINE surf_ocean(rlon, rlat, sollw, albedo, &
19       rugos, windsp, rmu0, &
20       fder, &
21       itime, dtime, jour, knon, knindex, &
22       debut, swdown, &
23       p1lay, tq_cdrag, coefm, precip_rain, precip_snow, temp_air, spechum, &
24       petAcoef, peqAcoef, petBcoef, peqBcoef, &
25       ps, u1_lay, v1_lay, rugoro, pctsrf, &
26       radsol, snow, qsurf, agesno, &
27       z0_new, alblw, evap, fluxsens, fluxlat, &
28       tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_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    INCLUDE "indicesol.h"
35    INCLUDE "YOMCST.h"
36
37! Input variables
38!****************************************************************************************
39    INTEGER, INTENT(IN)                      :: itime, jour, knon
40    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
41    REAL, INTENT(IN)                         :: dtime
42    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
43    REAL, DIMENSION(klon), INTENT(IN)        :: sollw
44    REAL, DIMENSION(klon), INTENT(IN)        :: albedo
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)        :: swdown   
50    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
51    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
52    REAL, DIMENSION(klon), INTENT(IN)        :: coefm
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)        :: petAcoef, peqAcoef
56    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
57    REAL, DIMENSION(klon), INTENT(IN)        :: ps
58    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
59    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
60    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
61    LOGICAL, INTENT(IN)                      :: debut
62
63! In/Output variables
64!****************************************************************************************
65    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
66    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow, qsurf
67    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
68
69! Output variables
70!****************************************************************************************
71    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
72    REAL, DIMENSION(klon), INTENT(OUT)       :: alblw
73    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
74    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new, alb_new
75    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
76    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_oce
77
78
79! Local variables
80!****************************************************************************************
81    INTEGER               :: i
82    REAL, DIMENSION(klon) :: alb_eau
83
84! End definition
85!****************************************************************************************
86!
87! Switch according to type of ocean (couple, slab or forced)
88!****************************************************************************************
89    SELECT CASE(ocean)
90    CASE('couple')
91       CALL ocean_cpl_noice(&
92            sollw, albedo, &
93            windsp, &
94            fder, &
95            itime, dtime, knon, knindex, &
96            swdown, &
97            p1lay, tq_cdrag, precip_rain, precip_snow,temp_air,spechum,&
98            petAcoef, peqAcoef, petBcoef, peqBcoef, &
99            ps, u1_lay, v1_lay, pctsrf, &
100            radsol, snow, qsurf, agesno, &
101            evap, fluxsens, fluxlat, &
102            tsurf_new, dflux_s, dflux_l, pctsrf_oce)
103
104    CASE('slab')
105       CALL ocean_slab_noice(&
106            dtime, knon, knindex, &
107            p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
108            petAcoef, peqAcoef, petBcoef, peqBcoef, &
109            ps, u1_lay, v1_lay, &
110            radsol, snow, qsurf, agesno, &
111            evap, fluxsens, fluxlat, &
112            tsurf_new, &
113            dflux_s, dflux_l, pctsrf_oce)
114       
115    CASE('force')
116       CALL ocean_forced_noice(itime, dtime, jour, knon, knindex, &
117            debut, &
118            p1lay, tq_cdrag, precip_rain, precip_snow, &
119            temp_air, spechum, &
120            petAcoef, peqAcoef, petBcoef, peqBcoef, &
121            ps, u1_lay, v1_lay, &
122            radsol, snow, qsurf, &
123            agesno, &
124            evap, fluxsens, fluxlat, &
125            tsurf_new, dflux_s, dflux_l, pctsrf_oce)
126    END SELECT
127
128!****************************************************************************************
129! Calculate albedo
130!
131!****************************************************************************************
132    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
133       CALL alboc(FLOAT(jour),rlat,alb_eau)
134    ELSE  ! diurnal cycle
135       CALL alboc_cd(rmu0,alb_eau)
136    ENDIF
137
138    DO i =1, knon
139       alb_new(i) = alb_eau(knindex(i))
140    ENDDO
141
142!****************************************************************************************
143! Calculate the rugosity
144!
145!****************************************************************************************
146    z0_new = SQRT(rugos**2 + rugoro**2)
147
148    ! The rugosity is recalculated with another method
149    z0_new(:) = 0.0
150    DO i = 1, knon
151       z0_new(i) = 0.018*coefm(i) * (u1_lay(i)**2+v1_lay(i)**2)/RG  &
152            +  0.11*14e-6 / SQRT(coefm(i) * (u1_lay(i)**2+v1_lay(i)**2))
153       z0_new(i) = MAX(1.5e-05,z0_new(i))
154    ENDDO
155   
156    alblw(1:knon) = alb_new(1:knon)
157!
158!****************************************************************************************
159!   
160  END SUBROUTINE surf_ocean
161!
162!****************************************************************************************
163!
164END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.