[Fortran] 纯文本查看 复制代码
FUNCTION INTERP (NPAIRS, FUNCT, XVALUE)
C interpolates between points in data functions
IMPLICIT NONE
C input
INTEGER NPAIRS ! number of pairs of values to be used
REAL FUNCT(*)! array of pairs of values: x1, y1, x2, y2, ...
REAL XVALUE ! x value
C output
REAL INTERP ! y value
C local
INTEGER I, J ! DO indexes
REAL XX(1:10) ! Cseries of x values of FUNCT
REAL YY(1:10) ! Cseries of y values of FUNCT
C
C put FUNCT into XX and YY
I = 0
DO 10 j = 1, 2 * NPAIRS - 1, 2
I = I + 1
XX(I) = FUNCT(j)
YY(I) = FUNCT(j + 1)
10 CONTINUE
C interpolate using XX and YY
DO 20 j = 1, NPAIRS
IF (XVALUE .EQ. XX(j)) THEN
INTERP = YY(j)
RETURN
ELSEIF (XVALUE .LT. XX(j)) THEN
INTERP = YY(j - 1) + (XVALUE - XX(j - 1)) *
* (YY(j) - YY(j - 1)) / (XX(j) - XX(j - 1))
RETURN
ELSE
END IF
20 CONTINUE
END
SUBROUTINE CANOPY (DOY, MAXHT, RELHT, MAXLAI, MXMAI,
* RELLAI,RELMAI,SNOW,SNODEN, MXRTLN, MXKPL, CS, DENSEF,
* HEIGHT,LAI, SAI,MAI, RTLEN, RPLANT)
C canopy parameters
IMPLICIT NONE
C input
INTEGER DOY ! day of year (first day of DFILE and run)"
REAL MAXHT ! maximum height for the year, m, minimum of 0.01 m
REAL RELHT(*) ! ten pairs of DOY and relative canopy height
REAL MAXLAI ! maximum projected leaf area index for the year,m2/m2
REAL MXMAI
REAL RELLAI(*) ! ten pairs of DOY and relative LAI
REAL RELMAI(*)
REAL SNOW ! water equivalent of snow on the ground, mm
REAL SNODEN ! snow density, mm/mm
REAL MXRTLN ! maximum root length per unit land area, m/m2
REAL MXKPL ! maximum plant conductivity, (mm/d)/MPa
REAL CS ! ratio of projected SAI to canopy height, m-1
REAL DENSEF ! density factor
C output
REAL HEIGHT ! canopy height above any snow, m, minimum of 0.01 m
REAL LAI ! leaf area index, m2/m2, minimum of 0.00001
REAL SAI ! stem area index, m2/m2
REAL MAI
REAL RTLEN ! root length per unit land area, m/m2
REAL RPLANT ! plant resistivity to water flow, MPa d/mm
C local
REAL SNODEP ! snow depth
REAL HNOSNO ! height of canopy without snow
REAL HSNO ! height of canopy above snow
REAL RATIO ! fraction of canopy above snow
REAL RELHIT ! RELHT for DOY
REAL KPL ! plant conductivity, mm d-1 MPa-1
C intrinsic
C REAL, MAX
C external functions needed
REAL INTERP
C
RELHIT = INTERP(10, RELHT(20), REAL(DOY))
SNODEP = .001 * SNOW / SNODEN
HNOSNO = MAX(.01, RELHIT * MAXHT)
HSNO = MAX(0., HNOSNO - SNODEP)
RATIO = HSNO / HNOSNO
HEIGHT = MAX(.01, HSNO)
C
LAI = RATIO * DENSEF * INTERP(10, RELLAI(20), REAL(DOY)) * MAXLAI
SAI = DENSEF * CS * HEIGHT
MAI = INTERP(10, RELMAI(20), REAL(DOY)) * MXMAI
IF (LAI .LT. .00001) LAI = .00001
C
RTLEN = DENSEF * RELHIT * MXRTLN
KPL = DENSEF * RELHIT * MXKPL
IF (KPL .LT. 1E-08) KPL = 1E-08
RPLANT = 1. / KPL
C
END