source: LMDZ6/branches/cirrus/libf/phylmd/surf_seaice_mod.F90 @ 5434

Last change on this file since 5434 was 5202, checked in by Laurent Fairhead, 3 months ago

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