source: LMDZ5/branches/testing/libf/phylmd/surf_land_mod.F90 @ 5403

Last change on this file since 5403 was 2594, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2545:2589 into testing branch

  • 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:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 8.7 KB
RevLine 
[781]1!
2MODULE surf_land_mod
3 
4  IMPLICIT NONE
5
6CONTAINS
7!
8!****************************************************************************************
9
10  SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
[2435]11       rlon, rlat, yrmu0, &
[888]12       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
[1067]13       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
[2298]16       pref, u1, v1, gustiness, rugoro, pctsrf, &
[1146]17       lwdown_m, q2m, t2m, &
[888]18       snow, qsol, agesno, tsoil, &
[2298]19       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &   
[996]20       qsurf, tsurf_new, dflux_s, dflux_l, &
[1146]21       flux_u1, flux_v1 )
[781]22
[1067]23    USE dimphy
24    USE surface_data, ONLY    : ok_veget
[1146]25
[2594]26    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
[1146]27#ifdef ORCHIDEE_NOOPENMP
[2594]28    ! Compilation with cpp key ORCHIDEE NOOPENMP
[1146]29    USE surf_land_orchidee_noopenmp_mod
30#else
[2594]31#if ORCHIDEE_NOZ0H
32    ! Compilation with cpp key ORCHIDEE NOZ0H
33    USE surf_land_orchidee_noz0h_mod
34#else
35    ! Compilation with default interface
[1067]36    USE surf_land_orchidee_mod
[1146]37#endif
[2594]38#endif
39
[1067]40    USE surf_land_bucket_mod
41    USE calcul_fluxs_mod
[1795]42    USE indice_sol_mod
[1067]43
[781]44    INCLUDE "dimsoil.h"
[888]45    INCLUDE "YOMCST.h"
[2258]46!albedo SB >>>
47    INCLUDE "clesphys.h"
48!albedo SB <<<
[781]49
50! Input variables 
51!****************************************************************************************
52    INTEGER, INTENT(IN)                     :: itime, jour, knon
53    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
54    REAL, INTENT(IN)                        :: date0
55    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
[2435]56    REAL, DIMENSION(klon), INTENT(IN)       :: yrmu0  ! cosine of solar zenith angle
[781]57    LOGICAL, INTENT(IN)                     :: debut, lafin
58    REAL, INTENT(IN)                        :: dtime
[888]59    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
60    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
61    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
[781]62    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
63    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
[1067]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
[888]69    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
[2298]70    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1, gustiness
[781]71    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
72    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[888]73    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
74                                                         ! corresponds to previous sollwdown
[1146]75    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
[888]76
[781]77! In/Output variables
78!****************************************************************************************
79    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
80    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
81    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
82
83! Output variables
84!****************************************************************************************
[2298]85    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m, z0h
[2258]86!albedo SB >>>
87!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
88!    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
89    REAL, DIMENSION(6), INTENT(IN) :: SFRWL
90    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
91!albedo SB <<<
[888]92    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
93    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat
[781]94    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
[888]95    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[781]96    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
[1067]97    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
[781]98
99! Local variables
100!****************************************************************************************
[888]101    REAL, DIMENSION(klon) :: p1lay_tmp
102    REAL, DIMENSION(klon) :: pref_tmp
103    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
104    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
[781]105    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
[1067]106    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
[781]107    INTEGER               :: i
108
[2258]109!albedo SB >>>
110    REAL, DIMENSION(klon)      :: alb1_new,alb2_new
111!albedo SB <<<
[781]112
[2258]113
[781]114!****************************************************************************************
115! Choice between call to vegetation model (ok_veget=true) or simple calculation below
116!
117!****************************************************************************************
118   IF (ok_veget) THEN
119!****************************************************************************************
[888]120!  Call model sechiba in model ORCHIDEE
[781]121!
122!****************************************************************************************
123       p1lay_tmp(:)      = 0.0
[888]124       pref_tmp(:)       = 0.0
[781]125       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
[888]126       pref_tmp(1:knon)  = pref(1:knon)/100.
127!
[2220]128!* Calculate incoming flux for SW and LW interval: swdown
[888]129!
130       swdown(:) = 0.0
131       DO i = 1, knon
132          swdown(i) = swnet(i)/(1-albedo(i))
133       END DO
134!
135!* Calculate potential air temperature
136!
137       epot_air(:) = 0.0
138       DO i = 1, knon
139          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
140       END DO
[781]141
[888]142       ! temporary for keeping same results using lwdown_m instead of lwdown
[781]143       CALL surf_land_orchidee(itime, dtime, date0, knon, &
[2435]144            knindex, rlon, rlat, yrmu0, pctsrf, &
[781]145            debut, lafin, &
[2298]146            zlev,  u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, &
[1067]147            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
[888]148            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
[1146]149            pref_tmp, q2m, t2m, &
[781]150            evap, fluxsens, fluxlat, &             
[888]151            tsol_rad, tsurf_new, alb1_new, alb2_new, &
[2594]152            emis_new, z0m, z0h, qsurf)       
[781]153
154
[888]155!* Add contribution of relief to surface roughness
[781]156
157       DO i=1,knon
[2298]158          z0m(i) = MAX(1.5e-05,SQRT(z0m(i)**2 + rugoro(i)**2))
[781]159       ENDDO
160
161    ELSE  ! not ok_veget
162!****************************************************************************************
163! No extern vegetation model choosen, call simple bucket calculations instead.
164!
165!****************************************************************************************
166       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
[1067]167            tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, &
168            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
[2298]169            u1, v1, gustiness, rugoro, swnet, lwnet, &
[888]170            snow, qsol, agesno, tsoil, &
[2298]171            qsurf, z0m, alb1_new, alb2_new, evap, &
[888]172            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
[2298]173        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
[781]174
175    ENDIF ! ok_veget
176
[1067]177!****************************************************************************************
178! Calculation for all land models
179! - Flux calculation at first modele level for U and V
180!****************************************************************************************
181! Suppose zero surface speed
182    u0(:)=0.0
183    v0(:)=0.0
184    CALL calcul_flux_wind(knon, dtime, &
[2298]185         u0, v0, u1, v1, gustiness, cdragm, &
[1067]186         AcoefU, AcoefV, BcoefU, BcoefV, &
187         p1lay, temp_air, &
188         flux_u1, flux_v1)
[2258]189
190!albedo SB >>>
191
192
193     select case(NSW)
194     case(2)
195       alb_dir_new(1:knon,1)=alb1_new(1:knon)
196       alb_dir_new(1:knon,2)=alb2_new(1:knon)
197     case(4)
198       alb_dir_new(1:knon,1)=alb1_new(1:knon)
199       alb_dir_new(1:knon,2)=alb2_new(1:knon)
200       alb_dir_new(1:knon,3)=alb2_new(1:knon)
201       alb_dir_new(1:knon,4)=alb2_new(1:knon)
202     case(6)
203       alb_dir_new(1:knon,1)=alb1_new(1:knon)
204       alb_dir_new(1:knon,2)=alb1_new(1:knon)
205       alb_dir_new(1:knon,3)=alb1_new(1:knon)
206       alb_dir_new(1:knon,4)=alb2_new(1:knon)
207       alb_dir_new(1:knon,5)=alb2_new(1:knon)
208       alb_dir_new(1:knon,6)=alb2_new(1:knon)
209     end select
210alb_dif_new=alb_dir_new
211!albedo SB <<<
212
213
[1067]214   
[781]215  END SUBROUTINE surf_land
216!
217!****************************************************************************************
218
219END MODULE surf_land_mod
220!
221!****************************************************************************************
222
Note: See TracBrowser for help on using the repository browser.