FUNCTION CURV(CTYPE,XB,X1,X2,XM,X)
IMPLICIT NONE
CHARACTER*3 CTYPE
REAL CURV,XB,X1,X2,XM,X
CURV = 1.0
IF (CTYPE .EQ. 'NON' .OR. CTYPE .EQ. 'non') RETURN
首先是線性反應方程式(LIN)，它是個梯形公式，在X1, X2 之間是1，XB和X1之間以及X2和XM之間是線性變化。 我們選擇XB = 8, X1 = 25, X2 = 34, XM = 44，得到結果如下：
C--------------------------------------------------------------------
IF(CTYPE .EQ. 'LIN' .OR. CTYPE .EQ. 'lin') THEN
CURV = 0.
IF(X .GT. XB .AND. X .LT. X1)CURV = (X-XB)/(X1-XB)
IF(X .GE. X1 .AND. X .LE. X2)CURV = 1.
IF(X .GT. X2 .AND. X .LT. XM)CURV = 1.0 - (X-X2)/(XM-X2)
CURV = MAX(CURV,0.0)
CURV = MIN(CURV,1.0)
ENDIF
C--------------------------------------------------------------------
這個曲線假定在 XB和X1之間以及X2和XM之間是二次曲線變化， 同樣的我們選擇XB = 8, X1 = 25, X2 = 34, XM = 44，得到結果如下：
C------------------------------------------------------------------------
IF(CTYPE .EQ. 'QDR' .OR. CTYPE .EQ. 'qdr') THEN
CURV = 0.
IF(X .GT. XB .AND. X .LT. X1)CURV = 1. -((X1-X)/(X1-XB))**2
IF(X .GE. X1 .AND. X .LE. X2)CURV = 1.
IF(X .GT. X2 .AND. X .LT. XM)CURV = 1. - ((X-X2)/(XM-X2))**2
CURV = MAX(CURV,0.0)
CURV = MIN(CURV,1.0)
ENDIF
C-------------------------------------------------------------------------
這個曲線只要應用在光周期反應使用，XM是最低速率，X1 與 X2 是關鍵日長
C----------------------------------------------------------------------------
C Curve type INL is the inverse linear with a minimum for use in photoperiod
C In this case, XM is the lowest relative rate, X1 and X2 are critical dayl
C----------------------------------------------------------------------------
IF(CTYPE .EQ. 'INL' .OR. CTYPE .EQ. 'inl') THEN
CURV = 1.0
IF(X .GT. X1 .AND. X .LT. X2)CURV = 1.-(1.-XM)*((X-X1)/(X2-X1))
! IF(X .GT. X2) CURV = XM
IF(X .GE. X2) CURV = XM !CHP per Stu Rymph 10/8/2004
CURV = MAX(CURV,XM)
CURV = MIN(CURV,1.0)
ENDIF
C---------------------------------------------------------------------------
C Curve type SHO for use with short day plants.
C The curve is the inverse linear with a minimum for use in photoperiod
C In this case, XM is the lowest relative rate, X1 and X2 are critical dayl
C---------------------------------------------------------------------------
IF(CTYPE .EQ. 'SHO' .OR. CTYPE .EQ. 'sho') THEN
IF (X .LE. X1) THEN
CURV = 1.0
ELSE IF ((X .GT. X1) .AND. (X .LT. X2)) THEN
CURV = 1.-(1.-XM)*((X-X1)/(X2-X1))
ELSE IF (X .GE. X2) THEN
CURV = XM
ENDIF
CURV = MAX(CURV,XM)
CURV = MIN(CURV,1.0)
ENDIF
C-------------------------------------------------------------------------------
C Curve type LON for use with long day plants.
C The curve is the inverse linear with a minimum for use in photoperiod
C In this case, XM is the lowest relative rate, X1 and X2 are critical dayl
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'LON' .OR. CTYPE .EQ. 'lon') THEN
IF (X .LT. X2) THEN
CURV = XM
ELSE IF ((X .GE. X2) .AND. (X .LT. X1)) THEN
CURV = 1.-(1.-XM)*((X1-X)/(X1-X2))
ELSE
CURV = 1.0
ENDIF
CURV = MAX(CURV,XM)
CURV = MIN(CURV,1.0)
ENDIF
C-------------------------------------------------------------------------------
C
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'SIN' .OR. CTYPE .EQ. 'sin') THEN
CURV = 0.
IF(X .GT. XB .AND. X .LT. X1)
& CURV = 0.5*(1.+COS(2.*22./7.*(X-X1)/(2.*(X1-XB))))
IF(X .GE. X1 .AND. X .LE. X2)CURV = 1.
IF(X .GT. X2 .AND. X .LT. XM)
& CURV = 0.5*(1.+COS(2.*22./7.*(X2-X)/(2.*(XM-X2))))
CURV = MAX(CURV,0.0)
CURV = MIN(CURV,1.0)
ENDIF
C-------------------------------------------------------------------------------
C-------------------------------------------------------------------------------
C-------------------------------------------------------------------------------
C Curve type REV - Reversible process - used for cold hardening
C Rate of cold hardening increases as TMIN decreases from X1 to XB
C Cold hardening reverses at an increasing rate as TMIN increases from X1 to X2
C Process at maximum rate at or below XB
C Rate decreases linearly to 0 at X1
C Process reverses at a linear rate from X1 to X2
C XM is the maximum absolute rate
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'REV' .OR. CTYPE .EQ. 'rev') THEN
CURV = 1.
IF(X .GT. XB .AND. X .LT. X1)CURV = 1.0-((X-XB)/(X1-XB))
IF(X .GE. X1 .AND. X .LE. X2)CURV = 0.0-((X-X1)/(X2-X1))
IF(X .GT. X2 )CURV = -1.0
CURV = MAX(CURV,-1.0)
CURV = MIN(CURV,1.0)
CURV = CURV * XM
ENDIF
C-------------------------------------------------------------------------------
C Curve type DHD - used for cold dehardening in spring
C No cold dehardening below XB (rate=0)
C Rate of cold dehardening increases as TMIN increases from XB to X1
C Process at maximum rate at or above X1
C X2 is not used
C XM is the maximum absolute rate
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'DHD' .OR. CTYPE .EQ. 'dhd') THEN
CURV = 0.
IF(X .GT. XB .AND. X .LT. X1)CURV = (X-XB)/(X1-XB)
IF(X .GE. X1 .AND. X .LE. X2)CURV = 1
IF(X .GT. X2 )CURV = 1
CURV = MAX(CURV,0.0)
CURV = MIN(CURV,1.0)
CURV = CURV * XM
ENDIF
C-------------------------------------------------------------------------------
C Curve type DRD - used for reducing rates of processes as dormancy advances
C Multiply rates by this factor to reduce them on short days,
C no effect on long days
C XM is the maximum reduction factor at full dormancy (daylength=XB)
C Less reduction as daylength gets longer
C Process at maximum rate at or above X1
C X2 is not used
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'DRD' .OR. CTYPE .EQ. 'drd') THEN
CURV = X2
IF(X .GT. XB .AND. X .LT. X1)
& CURV = X2+(XM-X2)*(X-XB)/(X1-XB)
IF(X .GE. X1 )CURV = XM
CURV = MAX(CURV,X2)
CURV = MIN(CURV,XM)
ENDIF
C-------------------------------------------------------------------------------
C Curve type CDD - used for reducing rates of processes as dormancy advances
C Multiply rates by this factor to reduce them on short days,
C Long day effect depends on value of XM
C X2 is the maximum reduction factor at full dormancy (daylength=XB)
C Less reduction as daylength gets longer
C Process at maximum rate at or above X1
C Curvilinear version of DRD
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'CDD' .OR. CTYPE .EQ. 'cdd') THEN
CURV = X2
IF(X .GT. XB .AND. X .LT. X1)
& CURV = XM-((XM-X2)*((X1-X)/(X1-XB))**2)
IF(X .GE. X1)CURV = XM
CURV = MAX(CURV,X2)
CURV = MIN(CURV,XM)
ENDIF
C-------------------------------------------------------------------------------
C Curve type EXK - generic exponential function with "k"
C XB sets the amplitude of the curve (max Y value)
C X1/XM sets the amount of curvature (k) and shape of the curve (+ or -)
C X2 shifts the curve left (- X2) or right (+X2) on the X axis
C If X1/XM is positive, X2 is the X-intercept
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'EXK' .OR. CTYPE .EQ. 'exk') THEN
CURV = XB - EXP(X1*(X-X2)/XM)
ENDIF
C-------------------------------------------------------------------------------
C-------------------------------------------------------------------------------
C Curve type VOP - Variable Order Polynomial
C Polynomial order (quadratic, cubic, etc.) is continuously variable
C (not discete steps)
C XB=T0, the lower temperature where the function scales to 0
C XM=T0', the upper temperature where the function scales to 0
C X1=Tref, reference temperature at which the functio scales to 1.0
C X2=qft, variable that sets the order of the polynomial
C Set X2=1 the function is quadratic, X2=2 cubic, X2=3 quartic, etc.
C X2 does not have to be an integer
C Function scales to 0 below XB and above XM
C Minimum CURV value =0.0, maximum can exceed 1.0
C Can use mft, a multiplier, to set the scale of the function
C Read mft in from file and apply in main section of code (ex. mft*CURV)
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'VOP' .OR. CTYPE .EQ. 'vop') THEN
CURV=0.0
IF(X .GT. XB .AND. X .LT. XM)
& CURV = (((X-XB)**X2)*(XM-X))/(((X1-XB)**X2)*(XM-X1))
IF(X .GE. XM ) CURV = 0.0
CURV = MAX(CURV,0.0)
ENDIF
C-------------------------------------------------------------------------------
C-------------------------------------------------------------------------------
C Curve type Q10 - basic Q10 function
C XB=Tref, reference temperature
C X1=k, te response at Tref
C X2= Q10 increase in the response for every 10°K increase in temperature
C XM is not used
C-------------------------------------------------------------------------------
IF(CTYPE .EQ. 'Q10' .OR. CTYPE .EQ. 'q10') THEN
CURV=X1*(X2**((X-XB)/10))
ENDIF
C-------------------------------------------------------------------------------
C-------------------------------------------------------------------------------
C Curve type PWR - basic function raising X to some power with scaling
C XB=multiplier for main function
C X1=power to raise X to
C X2= scaling multiplier to scale reults to a given range
C XM is not used
C Added condition for negative values of X - was generating NaN with
C negative values of X and fractional vlaues of X1
C (ex. Temp=-1.8C and X1=1.5905). Now uses value for 0.0 when X<0 .0="" .eq.="" .lt.="" .or.="" 0.0="" c-------------------------------------------------------------------------------="" code="" ctype="" curv="" else="" end="" endif="" function="" if="" pwr="" then="">
沒有留言:
張貼留言