source: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_seaice_mod.F90 @ 5101

Last change on this file since 5101 was 5101, checked in by abarral, 4 months ago

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]
  • 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: 8.1 KB
Line 
1
2! $Id: surf_seaice_mod.F90 5101 2024-07-23 06:22:55Z abarral $
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#ifdef ISO
25        ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
26        xtsnow,xtsol,xtevap,Rland_ice &
27#endif               
28        )
29
30  USE dimphy
31  USE surface_data
32  USE ocean_forced_mod, ONLY: ocean_forced_ice
33  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
34  USE ocean_slab_mod, ONLY   : ocean_slab_ice
35  USE indice_sol_mod
36#ifdef ISO
37  USE infotrac_phy, ONLY: ntiso,niso
38#endif
39
40! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
41! slab or couple). The calculation of rugosity for the sea-ice surface is also done
42! in here because it is the same calculation for the different modes of ocean.
43
44    INCLUDE "dimsoil.h"
45    INCLUDE "clesphys.h"
46
47    INCLUDE "YOMCST.h"
48    ! for rd and retv
49
50! Input arguments
51!****************************************************************************************
52    INTEGER, INTENT(IN)                      :: itime, jour, knon
53    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
54    LOGICAL, INTENT(IN)                      :: lafin
55    REAL, INTENT(IN)                         :: dtime
56    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
57    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
58    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
59    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
60    REAL, DIMENSION(klon), INTENT(IN)        :: fder
61    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf
62    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
63    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
64    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
65    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
66    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
67    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
68    REAL, DIMENSION(klon), INTENT(IN)        :: ps
69    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
70    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
71#ifdef ISO
72    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
73    REAL, DIMENSION(klon),       INTENT(IN)  :: xtspechum
74    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Roce
75    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
76#endif
77
78! In/Output arguments
79!****************************************************************************************
80    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsurf, qsol
81    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
82    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
83#ifdef ISO
84    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow 
85    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
86#endif
87
88! Output arguments
89!****************************************************************************************
90    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
91!albedo SB >>>
92!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
93!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
94    REAL, DIMENSION(6), INTENT(IN)    :: SFRWL
95    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
96!albedo SB <<<
97    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
98    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
99    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
100    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
101#ifdef ISO
102    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
103#endif
104
105! Local arguments
106!****************************************************************************************
107    REAL, DIMENSION(klon)  :: radsol
108#ifdef ISO
109#ifdef ISOVERIF
110    INTEGER :: j
111#endif
112#endif
113
114!albedo SB >>>
115    REAL, DIMENSION(klon) :: alb1_new,alb2_new
116!albedo SB <<<
117
118    real rhoa(knon) ! density of moist air  (kg / m3)
119
120! End definitions
121!****************************************************************************************
122
123
124!****************************************************************************************
125! Calculate total net radiance at surface
126
127!****************************************************************************************
128    radsol(:) = 0.0
129    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
130
131    rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
132
133!****************************************************************************************
134! Switch according to type of ocean (couple, slab or forced)
135
136!****************************************************************************************
137    IF (type_ocean == 'couple') THEN
138       
139       CALL ocean_cpl_ice( &
140            rlon, rlat, swnet, lwnet, alb1, &
141            fder, &
142            itime, dtime, knon, knindex, &
143            lafin,&
144            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
145            AcoefH, AcoefQ, BcoefH, BcoefQ, &
146            AcoefU, AcoefV, BcoefU, BcoefV, &
147            ps, u1, v1, gustiness, pctsrf, &
148            radsol, snow, qsurf, &
149            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
150            tsurf_new, dflux_s, dflux_l, rhoa)
151       
152    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
153       CALL ocean_slab_ice( &
154          itime, dtime, jour, knon, knindex, &
155          tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
156          AcoefH, AcoefQ, BcoefH, BcoefQ, &
157            AcoefU, AcoefV, BcoefU, BcoefV, &
158          ps, u1, v1, gustiness, &
159          radsol, snow, qsurf, qsol, agesno, &
160          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
161          tsurf_new, dflux_s, dflux_l, swnet)
162
163      ELSE ! type_ocean=force or slab +sicOBS or sicNO
164       CALL ocean_forced_ice( &
165            itime, dtime, jour, knon, knindex, &
166            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
167            AcoefH, AcoefQ, BcoefH, BcoefQ, &
168            AcoefU, AcoefV, BcoefU, BcoefV, &
169            ps, u1, v1, gustiness, &
170            radsol, snow, qsol, agesno, tsoil, &
171            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
172            tsurf_new, dflux_s, dflux_l, rhoa &
173#ifdef ISO
174            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
175            xtsnow, xtsol,xtevap,Rland_ice & 
176#endif           
177            )
178
179    END IF
180
181!****************************************************************************************
182! Calculate rugosity
183
184!****************************************************************************************
185
186    z0m=z0m_seaice
187    z0h = z0h_seaice
188
189!albedo SB >>>
190     select case(NSW)
191     case(2)
192       alb_dir_new(1:knon,1)=alb1_new(1:knon)
193       alb_dir_new(1:knon,2)=alb2_new(1:knon)
194     case(4)
195       alb_dir_new(1:knon,1)=alb1_new(1:knon)
196       alb_dir_new(1:knon,2)=alb2_new(1:knon)
197       alb_dir_new(1:knon,3)=alb2_new(1:knon)
198       alb_dir_new(1:knon,4)=alb2_new(1:knon)
199     case(6)
200       alb_dir_new(1:knon,1)=alb1_new(1:knon)
201       alb_dir_new(1:knon,2)=alb1_new(1:knon)
202       alb_dir_new(1:knon,3)=alb1_new(1:knon)
203       alb_dir_new(1:knon,4)=alb2_new(1:knon)
204       alb_dir_new(1:knon,5)=alb2_new(1:knon)
205       alb_dir_new(1:knon,6)=alb2_new(1:knon)
206     end select
207alb_dif_new=alb_dir_new
208!albedo SB <<<
209
210
211
212
213  END SUBROUTINE surf_seaice
214
215!****************************************************************************************
216
217END MODULE surf_seaice_mod
218
Note: See TracBrowser for help on using the repository browser.