source: LMDZ5/trunk/libf/phylmd/surf_land_mod.F90 @ 2036

Last change on this file since 2036 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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: 7.4 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, &
11       rlon, rlat, &
[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, &
16       pref, u1, v1, rugoro, pctsrf, &
[1146]17       lwdown_m, q2m, t2m, &
[888]18       snow, qsol, agesno, tsoil, &
19       z0_new, alb1_new, alb2_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
26#ifdef ORCHIDEE_NOOPENMP
27    USE surf_land_orchidee_noopenmp_mod
28#else
[1067]29    USE surf_land_orchidee_mod
[1146]30#endif
[1067]31    USE surf_land_bucket_mod
32    USE calcul_fluxs_mod
[1785]33    USE indice_sol_mod
[1067]34
[781]35    INCLUDE "dimsoil.h"
[888]36    INCLUDE "YOMCST.h"
[781]37
38! Input variables 
39!****************************************************************************************
40    INTEGER, INTENT(IN)                     :: itime, jour, knon
41    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
42    REAL, INTENT(IN)                        :: date0
43    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
44    LOGICAL, INTENT(IN)                     :: debut, lafin
45    REAL, INTENT(IN)                        :: dtime
[888]46    REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
47    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
48    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
[781]49    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
50    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
[1067]51    REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
[781]52    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
53    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
[1067]54    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefH, AcoefQ, BcoefH, BcoefQ
55    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefU, AcoefV, BcoefU, BcoefV
[888]56    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
[1067]57    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1
[781]58    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
59    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[888]60    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
61                                                         ! corresponds to previous sollwdown
[1146]62    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
[888]63
[781]64! In/Output variables
65!****************************************************************************************
66    REAL, DIMENSION(klon), INTENT(INOUT)          :: snow, qsol
67    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
68    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
69
70! Output variables
71!****************************************************************************************
[888]72    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
73    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new ! albdeo for shortwave interval 1(visible)
74    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new ! albedo for shortwave interval 2(near infrared)
75    REAL, DIMENSION(klon), INTENT(OUT)       :: evap
76    REAL, DIMENSION(klon), INTENT(OUT)       :: fluxsens, fluxlat
[781]77    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
[888]78    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[781]79    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
[1067]80    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
[781]81
82! Local variables
83!****************************************************************************************
[888]84    REAL, DIMENSION(klon) :: p1lay_tmp
85    REAL, DIMENSION(klon) :: pref_tmp
86    REAL, DIMENSION(klon) :: swdown     ! downwelling shortwave radiation at land surface
87    REAL, DIMENSION(klon) :: lwdown     ! downwelling longwave radiation at land surface
88    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
[781]89    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
[1067]90    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
[781]91    INTEGER               :: i
92
93
94!****************************************************************************************
95! Choice between call to vegetation model (ok_veget=true) or simple calculation below
96!
97!****************************************************************************************
98   IF (ok_veget) THEN
99!****************************************************************************************
[888]100!  Call model sechiba in model ORCHIDEE
[781]101!
102!****************************************************************************************
103       p1lay_tmp(:)      = 0.0
[888]104       pref_tmp(:)       = 0.0
[781]105       p1lay_tmp(1:knon) = p1lay(1:knon)/100.
[888]106       pref_tmp(1:knon)  = pref(1:knon)/100.
107!
108!* Calculate incoming flux for SW and LW interval: swdown, lwdown
109!
110       swdown(:) = 0.0
111       lwdown(:) = 0.0
112       DO i = 1, knon
113          swdown(i) = swnet(i)/(1-albedo(i))
114          lwdown(i) = lwnet(i) + RSIGMA*tsurf(i)**4
115       END DO
116!
117!* Calculate potential air temperature
118!
119       epot_air(:) = 0.0
120       DO i = 1, knon
121          epot_air(i) = RCPD*temp_air(i)*(pref(i)/p1lay(i))**RKAPPA
122       END DO
[781]123
[888]124       ! temporary for keeping same results using lwdown_m instead of lwdown
[781]125       CALL surf_land_orchidee(itime, dtime, date0, knon, &
126            knindex, rlon, rlat, pctsrf, &
127            debut, lafin, &
[1067]128            zlev,  u1, v1, temp_air, spechum, epot_air, ccanopy, &
129            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
[888]130            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
[1146]131            pref_tmp, q2m, t2m, &
[781]132            evap, fluxsens, fluxlat, &             
[888]133            tsol_rad, tsurf_new, alb1_new, alb2_new, &
[781]134            emis_new, z0_new, qsurf)       
135
136
[888]137!* Add contribution of relief to surface roughness
[781]138
139       DO i=1,knon
[1146]140          z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
[781]141       ENDDO
142
143    ELSE  ! not ok_veget
144!****************************************************************************************
145! No extern vegetation model choosen, call simple bucket calculations instead.
146!
147!****************************************************************************************
148       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
[1067]149            tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, &
150            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
151            u1, v1, rugoro, swnet, lwnet, &
[888]152            snow, qsol, agesno, tsoil, &
153            qsurf, z0_new, alb1_new, alb2_new, evap, &
154            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
[781]155
156    ENDIF ! ok_veget
157
[1067]158!****************************************************************************************
159! Calculation for all land models
160! - Flux calculation at first modele level for U and V
161!****************************************************************************************
162! Suppose zero surface speed
163    u0(:)=0.0
164    v0(:)=0.0
165    CALL calcul_flux_wind(knon, dtime, &
166         u0, v0, u1, v1, cdragm, &
167         AcoefU, AcoefV, BcoefU, BcoefV, &
168         p1lay, temp_air, &
169         flux_u1, flux_v1)
170   
[781]171  END SUBROUTINE surf_land
172!
173!****************************************************************************************
174
175END MODULE surf_land_mod
176!
177!****************************************************************************************
178
Note: See TracBrowser for help on using the repository browser.