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

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

Modifications sur l'albedo JG
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.9 KB
RevLine 
[781]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!
[888]18  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
19       rugos, windsp, rmu0, fder, &
[781]20       itime, dtime, jour, knon, knindex, &
[888]21       debut, &
[781]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, &
[888]25       snow, qsurf, agesno, &
26       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
27       tsurf_new, dflux_s, dflux_l, pctsrf_oce)
[781]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!
[793]33    INCLUDE "indicesol.h"
34    INCLUDE "YOMCST.h"
[781]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
[888]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
[781]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)        :: p1lay
50    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
51    REAL, DIMENSION(klon), INTENT(IN)        :: coefm
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)        :: petAcoef, peqAcoef
55    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
56    REAL, DIMENSION(klon), INTENT(IN)        :: ps
57    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
58    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
59    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
60    LOGICAL, INTENT(IN)                      :: debut
61
62! In/Output variables
63!****************************************************************************************
[888]64    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
65    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
[781]66    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
67
68! Output variables
69!****************************************************************************************
70    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
[888]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
[781]73    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
[888]74    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[781]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
[888]83    REAL, DIMENSION(klon) :: radsol
[781]84
85! End definition
86!****************************************************************************************
[888]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!****************************************************************************************
[781]97! Switch according to type of ocean (couple, slab or forced)
98!****************************************************************************************
99    SELECT CASE(ocean)
100    CASE('couple')
[888]101       CALL ocean_cpl_noice( &
102            swnet, lwnet, alb1, &
[781]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, pctsrf, &
[888]109            radsol, snow, agesno, &
110            qsurf, evap, fluxsens, fluxlat, &
[781]111            tsurf_new, dflux_s, dflux_l, pctsrf_oce)
112
113    CASE('slab')
[888]114       CALL ocean_slab_noice( &
[781]115            dtime, knon, knindex, &
116            p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
117            petAcoef, peqAcoef, petBcoef, peqBcoef, &
118            ps, u1_lay, v1_lay, &
[888]119            radsol, snow, agesno, &
120            qsurf, evap, fluxsens, fluxlat, &
121            tsurf_new, dflux_s, dflux_l, pctsrf_oce)
[781]122       
123    CASE('force')
[888]124       CALL ocean_forced_noice( &
125            itime, dtime, jour, knon, knindex, &
[781]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, &
[888]131            radsol, snow, agesno, &
132            qsurf, evap, fluxsens, fluxlat, &
[781]133            tsurf_new, dflux_s, dflux_l, pctsrf_oce)
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
[888]147       alb1_new(i) = alb_eau(knindex(i))
[781]148    ENDDO
[888]149    alb2_new(1:knon) = alb1_new(1:knon)
[781]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.