source: LMDZ6/branches/SETHET_DECOUPLE/libf/phylmd/surf_seaice_mod.F90 @ 5441

Last change on this file since 5441 was 3102, checked in by oboucher, 7 years ago

Removing x permission from these files
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.1 KB
Line 
1!
2! $Id: surf_seaice_mod.F90 3102 2017-12-03 20:27:42Z fhourdin $
3!
4MODULE surf_seaice_mod
5
6  IMPLICIT NONE
7
8CONTAINS
9!
10!****************************************************************************************
11!
12  SUBROUTINE surf_seaice( &
13       rlon, rlat, swnet, lwnet, alb1, fder, &
14       itime, dtime, jour, knon, knindex, &
15       lafin, &
16       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
17       AcoefH, AcoefQ, BcoefH, BcoefQ, &
18       AcoefU, AcoefV, BcoefU, BcoefV, &
19       ps, u1, v1, gustiness, pctsrf, &
20       snow, qsurf, qsol, agesno, tsoil, &
21       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
22       tsurf_new, dflux_s, dflux_l, &
23       flux_u1, flux_v1)
24
25  USE dimphy
26  USE surface_data
27  USE ocean_forced_mod, ONLY : ocean_forced_ice
28  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
29  USE ocean_slab_mod, ONLY   : ocean_slab_ice
30  USE indice_sol_mod
31
32!
33! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
34! slab or couple). The calculation of rugosity for the sea-ice surface is also done
35! in here because it is the same calculation for the different modes of ocean.
36!
37    INCLUDE "dimsoil.h"
38    INCLUDE "clesphys.h"
39
40! Input arguments
41!****************************************************************************************
42    INTEGER, INTENT(IN)                      :: itime, jour, knon
43    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
44    LOGICAL, INTENT(IN)                      :: lafin
45    REAL, INTENT(IN)                         :: dtime
46    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
47    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
48    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
49    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
50    REAL, DIMENSION(klon), INTENT(IN)        :: fder
51    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
52    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
53    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
54    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
55    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
56    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
57    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
58    REAL, DIMENSION(klon), INTENT(IN)        :: ps
59    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
60    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
61
62! In/Output arguments
63!****************************************************************************************
64    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
65    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
66    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
67
68! Output arguments
69!****************************************************************************************
70    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
71!albedo SB >>>
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(6), INTENT(IN)    :: SFRWL
75    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
76!albedo SB <<<
77    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
78    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
79    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
80    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
81
82! Local arguments
83!****************************************************************************************
84    REAL, DIMENSION(klon)  :: radsol
85
86!albedo SB >>>
87    REAL, DIMENSION(klon) :: alb1_new,alb2_new
88!albedo SB <<<
89!
90! End definitions
91!****************************************************************************************
92
93
94!****************************************************************************************
95! Calculate total net radiance at surface
96!
97!****************************************************************************************
98    radsol(:) = 0.0
99    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
100
101!****************************************************************************************
102! Switch according to type of ocean (couple, slab or forced)
103!
104!****************************************************************************************
105    IF (type_ocean == 'couple') THEN
106       
107       CALL ocean_cpl_ice( &
108            rlon, rlat, swnet, lwnet, alb1, &
109            fder, &
110            itime, dtime, knon, knindex, &
111            lafin,&
112            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
113            AcoefH, AcoefQ, BcoefH, BcoefQ, &
114            AcoefU, AcoefV, BcoefU, BcoefV, &
115            ps, u1, v1, gustiness, pctsrf, &
116            radsol, snow, qsurf, &
117            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
118            tsurf_new, dflux_s, dflux_l)
119       
120    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
121       CALL ocean_slab_ice( &
122          itime, dtime, jour, knon, knindex, &
123          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
124          AcoefH, AcoefQ, BcoefH, BcoefQ, &
125            AcoefU, AcoefV, BcoefU, BcoefV, &
126          ps, u1, v1, gustiness, &
127          radsol, snow, qsurf, qsol, agesno, &
128          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
129          tsurf_new, dflux_s, dflux_l, swnet)
130
131      ELSE ! type_ocean=force or slab +sicOBS or sicNO
132       CALL ocean_forced_ice( &
133            itime, dtime, jour, knon, knindex, &
134            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
135            AcoefH, AcoefQ, BcoefH, BcoefQ, &
136            AcoefU, AcoefV, BcoefU, BcoefV, &
137            ps, u1, v1, gustiness, &
138            radsol, snow, qsol, agesno, tsoil, &
139            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
140            tsurf_new, dflux_s, dflux_l)
141
142    END IF
143
144!****************************************************************************************
145! Calculate rugosity
146!
147!****************************************************************************************
148
149    z0m=z0m_seaice
150    z0h = z0h_seaice
151
152!albedo SB >>>
153     select case(NSW)
154     case(2)
155       alb_dir_new(1:knon,1)=alb1_new(1:knon)
156       alb_dir_new(1:knon,2)=alb2_new(1:knon)
157     case(4)
158       alb_dir_new(1:knon,1)=alb1_new(1:knon)
159       alb_dir_new(1:knon,2)=alb2_new(1:knon)
160       alb_dir_new(1:knon,3)=alb2_new(1:knon)
161       alb_dir_new(1:knon,4)=alb2_new(1:knon)
162     case(6)
163       alb_dir_new(1:knon,1)=alb1_new(1:knon)
164       alb_dir_new(1:knon,2)=alb1_new(1:knon)
165       alb_dir_new(1:knon,3)=alb1_new(1:knon)
166       alb_dir_new(1:knon,4)=alb2_new(1:knon)
167       alb_dir_new(1:knon,5)=alb2_new(1:knon)
168       alb_dir_new(1:knon,6)=alb2_new(1:knon)
169     end select
170alb_dif_new=alb_dir_new
171!albedo SB <<<
172
173
174
175
176  END SUBROUTINE surf_seaice
177!
178!****************************************************************************************
179!
180END MODULE surf_seaice_mod
181
Note: See TracBrowser for help on using the repository browser.