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

Last change on this file since 1063 was 996, checked in by lsce, 16 years ago
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

JG
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.9 KB
Line 
1!
2! $Header$
3!
4MODULE surf_ocean_mod
5
6  USE dimphy
7  USE surface_data, ONLY     : type_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, swnet, lwnet, alb1, &
19       rugos, windsp, rmu0, fder, tsurf_in, &
20       itime, dtime, jour, knon, knindex, &
21       debut, &
22       p1lay, tq_cdrag, coefm, precip_rain, precip_snow, temp_air, spechum, &
23       petAcoef, peqAcoef, petBcoef, peqBcoef, &
24       ps, u1_lay, v1_lay, rugoro, pctsrf, &
25       snow, qsurf, agesno, &
26       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
27       tsurf_new, dflux_s, dflux_l, lmt_bils)
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    INCLUDE "indicesol.h"
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)        :: 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)     :: snow
66    REAL, DIMENSION(klon), INTENT(INOUT)     :: 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)       :: alb1_new  ! new albedo in visible SW interval
73    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
74    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
75    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
76    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
77    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
78
79! Local variables
80!****************************************************************************************
81    INTEGER               :: i
82    REAL, DIMENSION(klon) :: alb_eau
83    REAL, DIMENSION(klon) :: radsol
84
85! End definition
86!****************************************************************************************
87
88
89!****************************************************************************************
90! Calculate total net radiance at surface
91!
92!****************************************************************************************
93    radsol(:) = 0.0
94    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
95
96!****************************************************************************************
97! Switch according to type of ocean (couple, slab or forced)
98!****************************************************************************************
99    SELECT CASE(type_ocean)
100    CASE('couple')
101       CALL ocean_cpl_noice( &
102            swnet, lwnet, alb1, &
103            windsp, &
104            fder, &
105            itime, dtime, knon, knindex, &
106            p1lay, tq_cdrag, precip_rain, precip_snow,temp_air,spechum,&
107            petAcoef, peqAcoef, petBcoef, peqBcoef, &
108            ps, u1_lay, v1_lay, &
109            radsol, snow, agesno, &
110            qsurf, evap, fluxsens, fluxlat, &
111            tsurf_new, dflux_s, dflux_l)
112
113    CASE('slab')
114       CALL ocean_slab_noice( &
115            itime, dtime, jour, knon, knindex, &
116            p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
117            petAcoef, peqAcoef, petBcoef, peqBcoef, &
118            ps, u1_lay, v1_lay, tsurf_in, &
119            radsol, snow, agesno, &
120            qsurf, evap, fluxsens, fluxlat, &
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            debut, &
127            p1lay, tq_cdrag, precip_rain, precip_snow, &
128            temp_air, spechum, &
129            petAcoef, peqAcoef, petBcoef, peqBcoef, &
130            ps, u1_lay, v1_lay, &
131            radsol, snow, agesno, &
132            qsurf, evap, fluxsens, fluxlat, &
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*coefm(i) * (u1_lay(i)**2+v1_lay(i)**2)/RG  &
161            +  0.11*14e-6 / SQRT(coefm(i) * (u1_lay(i)**2+v1_lay(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.