source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/surf_landice_mod.F90 @ 2440

Last change on this file since 2440 was 1369, checked in by idelkadi, 15 years ago
  • Corrections pour integrer de nouveaux champs de sorties
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.5 KB
RevLine 
[781]1!
2MODULE surf_landice_mod
3 
4  IMPLICIT NONE
5
6CONTAINS
7!
8!****************************************************************************************
9!
10  SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
[888]11       swnet, lwnet, tsurf, p1lay, &
[1067]12       cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
13       AcoefH, AcoefQ, BcoefH, BcoefQ, &
14       AcoefU, AcoefV, BcoefU, BcoefV, &
15       ps, u1, v1, rugoro, pctsrf, &
[888]16       snow, qsurf, qsol, agesno, &
17       tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
[1067]18       tsurf_new, dflux_s, dflux_l, &
19       flux_u1, flux_v1)
[781]20
[1067]21    USE dimphy
22    USE surface_data,     ONLY : type_ocean, calice, calsno
23    USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
24    USE cpl_mod,          ONLY : cpl_send_landice_fields
25    USE calcul_fluxs_mod
[1369]26    USE phys_output_var_mod
[1067]27
[793]28    INCLUDE "indicesol.h"
[781]29    INCLUDE "dimsoil.h"
[793]30    INCLUDE "YOMCST.h"
31    INCLUDE "clesphys.h"
[781]32
33! Input variables
34!****************************************************************************************
35    INTEGER, INTENT(IN)                           :: itime, knon
36    INTEGER, DIMENSION(klon), INTENT(in)          :: knindex
37    REAL, INTENT(in)                              :: dtime
[888]38    REAL, DIMENSION(klon), INTENT(IN)             :: swnet ! net shortwave radiance
39    REAL, DIMENSION(klon), INTENT(IN)             :: lwnet ! net longwave radiance
[781]40    REAL, DIMENSION(klon), INTENT(IN)             :: tsurf
41    REAL, DIMENSION(klon), INTENT(IN)             :: p1lay
[1067]42    REAL, DIMENSION(klon), INTENT(IN)             :: cdragh, cdragm
[781]43    REAL, DIMENSION(klon), INTENT(IN)             :: precip_rain, precip_snow
44    REAL, DIMENSION(klon), INTENT(IN)             :: temp_air, spechum
[1067]45    REAL, DIMENSION(klon), INTENT(IN)             :: AcoefH, AcoefQ
46    REAL, DIMENSION(klon), INTENT(IN)             :: BcoefH, BcoefQ
47    REAL, DIMENSION(klon), INTENT(IN)             :: AcoefU, AcoefV, BcoefU, BcoefV
[781]48    REAL, DIMENSION(klon), INTENT(IN)             :: ps
[1067]49    REAL, DIMENSION(klon), INTENT(IN)             :: u1, v1
[781]50    REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
51    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
52
53! In/Output variables
54!****************************************************************************************
55    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
56    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
57    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
58
59! Output variables
60!****************************************************************************************
61    REAL, DIMENSION(klon), INTENT(OUT)            :: qsurf
62    REAL, DIMENSION(klon), INTENT(OUT)            :: z0_new
[888]63    REAL, DIMENSION(klon), INTENT(OUT)            :: alb1  ! new albedo in visible SW interval
64    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2  ! new albedo in near IR interval
[781]65    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
[888]66    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
[781]67    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
[1067]68    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
[781]69
70! Local variables
71!****************************************************************************************
72    REAL, DIMENSION(klon)    :: soilcap, soilflux
73    REAL, DIMENSION(klon)    :: cal, beta, dif_grnd
74    REAL, DIMENSION(klon)    :: zfra, alb_neig
[888]75    REAL, DIMENSION(klon)    :: radsol
[1067]76    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay
[1369]77    INTEGER                  :: i,j
[781]78
79! End definition
80!****************************************************************************************
81!
82! Initialize output variables
[888]83    alb2(:) = 999999.
84    alb1(:) = 999999.
[781]85
[888]86!****************************************************************************************
87! Calculate total absorbed radiance at surface
88!
89!****************************************************************************************
90    radsol(:) = 0.0
91    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
[781]92
93!****************************************************************************************
94! Soil calculations
95!
96!****************************************************************************************
97    IF (soil_model) THEN
98       CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
99       cal(1:knon) = RCPD / soilcap(1:knon)
100       radsol(1:knon)  = radsol(1:knon) + soilflux(1:knon)
101    ELSE
102       cal = RCPD * calice
103       WHERE (snow > 0.0) cal = RCPD * calsno
104    ENDIF
105
106
107!****************************************************************************************
108! Calulate fluxes
109!
110!****************************************************************************************
111    beta(:) = 1.0
112    dif_grnd(:) = 0.0
113
[1067]114! Suppose zero surface speed
115    u0(:)=0.0
116    v0(:)=0.0
117    u1_lay(:) = u1(:) - u0(:)
118    v1_lay(:) = v1(:) - v0(:)
119
[781]120    CALL calcul_fluxs(knon, is_lic, dtime, &
[1067]121         tsurf, p1lay, cal, beta, cdragh, ps, &
[781]122         precip_rain, precip_snow, snow, qsurf,  &
123         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]124         AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]125         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
126
[1067]127    CALL calcul_flux_wind(knon, dtime, &
128         u0, v0, u1, v1, cdragm, &
129         AcoefU, AcoefV, BcoefU, BcoefV, &
130         p1lay, temp_air, &
131         flux_u1, flux_v1)
[781]132
133!****************************************************************************************
134! Calculate snow height, age, run-off,..
135!   
136!****************************************************************************************
137    CALL fonte_neige( knon, is_lic, knindex, dtime, &
138         tsurf, precip_rain, precip_snow, &
139         snow, qsol, tsurf_new, evap)
140
141
142!****************************************************************************************
143! Calculate albedo
144!
145!****************************************************************************************
146    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:)) 
147    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
148    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
[888]149    alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
[781]150         0.6 * (1.0-zfra(1:knon))
151!
152!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
[888]153!       alb1(1 : knon)  = 0.6 !IM cf FH/GK
154!       alb1(1 : knon)  = 0.82
155!       alb1(1 : knon)  = 0.77 !211003 Ksta0.77
156!       alb1(1 : knon)  = 0.8 !KstaTER0.8 & LMD_ARMIP5
[781]157!IM: KstaTER0.77 & LMD_ARMIP6   
158
[888]159! Attantion: alb1 and alb2 are the same!
160    alb1(1:knon)  = 0.77
161    alb2(1:knon)  = alb1(1:knon)
[781]162
163
164!****************************************************************************************
165! Rugosity
166!
167!****************************************************************************************
[1146]168    z0_new(:) = MAX(1.E-3,rugoro(:))
[781]169
170!****************************************************************************************
171! Send run-off on land-ice to coupler if coupled ocean.
172! run_off_lic has been calculated in fonte_neige
173!
174!****************************************************************************************
[996]175    IF (type_ocean=='couple') THEN
[781]176       CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
177    ENDIF
178
[1369]179!****************************************************************************************
180       snow_o=0.
181       zfra_o = 0.
182       DO j = 1, knon
183           i = knindex(j)
184           snow_o(i) = snow(j)
185           zfra_o(i) = zfra(j)
186       ENDDO
[781]187
[1369]188
[781]189  END SUBROUTINE surf_landice
190!
191!****************************************************************************************
192!
193END MODULE surf_landice_mod
194
195
196
Note: See TracBrowser for help on using the repository browser.