source: LMDZ6/branches/Test_modipsl/libf/phylmd/surf_seaice_mod.F90 @ 4582

Last change on this file since 4582 was 3815, checked in by lguez, 4 years ago

Merge Ocean_skin branch back into trunk
  • 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.2 KB
Line 
1!
2! $Id: surf_seaice_mod.F90 3815 2021-02-01 14:30:57Z lguez $
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    INCLUDE "YOMCST.h"
41    ! for rd and retv
42
43! Input arguments
44!****************************************************************************************
45    INTEGER, INTENT(IN)                      :: itime, jour, knon
46    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
47    LOGICAL, INTENT(IN)                      :: lafin
48    REAL, INTENT(IN)                         :: dtime
49    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
50    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
51    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
52    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
53    REAL, DIMENSION(klon), INTENT(IN)        :: fder
54    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
55    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
56    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
57    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
58    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
59    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
60    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
61    REAL, DIMENSION(klon), INTENT(IN)        :: ps
62    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
63    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
64
65! In/Output arguments
66!****************************************************************************************
67    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
68    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
69    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
70
71! Output arguments
72!****************************************************************************************
73    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
74!albedo SB >>>
75!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
76!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
77    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
78    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
79!albedo SB <<<
80    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
81    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
82    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
83    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
84
85! Local arguments
86!****************************************************************************************
87    REAL, DIMENSION(klon)  :: radsol
88
89!albedo SB >>>
90    REAL, DIMENSION(klon) :: alb1_new,alb2_new
91!albedo SB <<<
92
93    real rhoa(knon) ! density of moist air  (kg / m3)
94
95! End definitions
96!****************************************************************************************
97
98
99!****************************************************************************************
100! Calculate total net radiance at surface
101!
102!****************************************************************************************
103    radsol(:) = 0.0
104    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
105
106    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
107
108!****************************************************************************************
109! Switch according to type of ocean (couple, slab or forced)
110!
111!****************************************************************************************
112    IF (type_ocean == 'couple') THEN
113       
114       CALL ocean_cpl_ice( &
115            rlon, rlat, swnet, lwnet, alb1, &
116            fder, &
117            itime, dtime, knon, knindex, &
118            lafin,&
119            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
120            AcoefH, AcoefQ, BcoefH, BcoefQ, &
121            AcoefU, AcoefV, BcoefU, BcoefV, &
122            ps, u1, v1, gustiness, pctsrf, &
123            radsol, snow, qsurf, &
124            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
125            tsurf_new, dflux_s, dflux_l, rhoa)
126       
127    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
128       CALL ocean_slab_ice( &
129          itime, dtime, jour, knon, knindex, &
130          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
131          AcoefH, AcoefQ, BcoefH, BcoefQ, &
132            AcoefU, AcoefV, BcoefU, BcoefV, &
133          ps, u1, v1, gustiness, &
134          radsol, snow, qsurf, qsol, agesno, &
135          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
136          tsurf_new, dflux_s, dflux_l, swnet)
137
138      ELSE ! type_ocean=force or slab +sicOBS or sicNO
139       CALL ocean_forced_ice( &
140            itime, dtime, jour, knon, knindex, &
141            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
142            AcoefH, AcoefQ, BcoefH, BcoefQ, &
143            AcoefU, AcoefV, BcoefU, BcoefV, &
144            ps, u1, v1, gustiness, &
145            radsol, snow, qsol, agesno, tsoil, &
146            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
147            tsurf_new, dflux_s, dflux_l, rhoa)
148
149    END IF
150
151!****************************************************************************************
152! Calculate rugosity
153!
154!****************************************************************************************
155
156    z0m=z0m_seaice
157    z0h = z0h_seaice
158
159!albedo SB >>>
160     select case(NSW)
161     case(2)
162       alb_dir_new(1:knon,1)=alb1_new(1:knon)
163       alb_dir_new(1:knon,2)=alb2_new(1:knon)
164     case(4)
165       alb_dir_new(1:knon,1)=alb1_new(1:knon)
166       alb_dir_new(1:knon,2)=alb2_new(1:knon)
167       alb_dir_new(1:knon,3)=alb2_new(1:knon)
168       alb_dir_new(1:knon,4)=alb2_new(1:knon)
169     case(6)
170       alb_dir_new(1:knon,1)=alb1_new(1:knon)
171       alb_dir_new(1:knon,2)=alb1_new(1:knon)
172       alb_dir_new(1:knon,3)=alb1_new(1:knon)
173       alb_dir_new(1:knon,4)=alb2_new(1:knon)
174       alb_dir_new(1:knon,5)=alb2_new(1:knon)
175       alb_dir_new(1:knon,6)=alb2_new(1:knon)
176     end select
177alb_dif_new=alb_dir_new
178!albedo SB <<<
179
180
181
182
183  END SUBROUTINE surf_seaice
184!
185!****************************************************************************************
186!
187END MODULE surf_seaice_mod
188
Note: See TracBrowser for help on using the repository browser.