UC IPM Online UC ANR home page UC IPM home page

UC IPM Home

SKIP navigation

 

How to Manage Pests

Degree-Days: Computer Routines

      SUBROUTINE DACALC (LTHRES,CTHRES,CM,COFF,CI,MAX,MIN,
     *                   NDAYS,DDAYS,ACCUM,ERROR)
C
C     PURPOSE:
C     CALCULATE HEAT DEGREE-DAYS FOR NDAYS FROM MAX & MIN TEMPERATURES.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  DACALC.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  DOSINE, DOTRIA, DOVRCT, HUBERM, SISINE, SITRIA, VERTCUT
C
C    ************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 ABOVE                  ! TRUE FOR HEAT UNITS
C
      INTEGER*2 CI,                    ! COMPUTATION INTERVAL
     *          CM,                    ! COMPUTATION METHOD
     *          COFF,                  ! CUTOFF METHOD
     *          ERROR                  ! RETURNED ERROR SIGNAL
C
      REAL*4 ACCUM(1001),              ! ACCUMULATED DEGREE-DAYS
     *       CTHRES,                   ! CUTOFF THRESHOLD
     *       DDAYS(1000),              ! DEGREE-DAYS RETURNED
     *       LTHRES,                   ! LOWER THRESHOLD
     *       MAX(1001),                ! MAXIMUM TEMPERATURES
     *       MIN(1001),                ! MINIMUM TEMPERATURES
     *       THRESH(2),                ! BOTH THRESHOLDS FOR VERTICAL CUTOFF
     *       TEMP1,                    ! DD ABOVE CUTOFF THRESHOLD
     *       TEMP2                     ! ADDITIONAL DD FOR VERTICAL CUTOFF
C
C                  INTIALIZATIONS
C
      ABOVE = .TRUE.
      ERROR = 0
      IF (COFF.GE.2) THEN
         IF (CM.LE.2) THEN
            J = 1
         ELSE ! CM.LE.4
            J = 2
         END IF
      END IF
      THRESH(1) = LTHRES
      THRESH(2) = CTHRES
C
C                  COMPUTE DEGREE-DAYS
C
      IF (CM.EQ.1) THEN             ! SINGLE SINE
         DO 100 I = 1,NDAYS
            CALL SISINE (ABOVE,MIN(I),MAX(I+1),LTHRES,DDAYS(I),ERROR)
            IF (ERROR.NE.0) RETURN
            IF (COFF.GT.0) THEN        ! CUTOFF THRESHOLD ACTIVE
               CALL SISINE (ABOVE,MIN(I),MAX(I+1),CTHRES,TEMP1,ERROR)
               DDAYS(I) = DDAYS(I) - TEMP1  ! REMOVE DD ABOVE CUTOFF
               IF (COFF.GE.2) THEN          ! CHECK FOR INT. OR VERT. CUTOFF
                  CALL VERTCUT (ABOVE,J,MIN(I),MAX(I+1),THRESH,TEMP2)
                  IF (TEMP1.GT.TEMP2) TEMP1 = TEMP2   ! IC MUST BE <= VC
                  IF (COFF.EQ.3) TEMP1 = TEMP2        ! VERTICAL CUTOFF
                  DDAYS(I) = DDAYS(I) - TEMP1
               END IF
               IF (DDAYS(I).LT.0.0) DDAYS(I) = 0.0
            END IF
            ACCUM(I+1) = ACCUM(I) + DDAYS(I)
  100    CONTINUE
      ELSE IF (CM.EQ.2) THEN        ! DOUBLE SINE
         DO 200 I = 1,NDAYS
            CALL DOSINE (ABOVE,CI,MAX(I),MIN(I),LTHRES,DDAYS(I),ERROR)
            IF (ERROR.NE.0) RETURN
            IF (COFF.GT.0) THEN        ! CUTOFF THRESHOLD ACTIVE
               CALL DOSINE (ABOVE,CI,MAX(I),MIN(I),CTHRES,TEMP1,ERROR)
               DDAYS(I) = DDAYS(I) - TEMP1  ! REMOVE DD ABOVE CUTOFF
               IF (COFF.GE.2) THEN          ! CHECK FOR INT. OR VERT. CUTOFF
                  CALL DOVRCT (ABOVE,J,CI,MAX(I),MIN(I),THRESH,TEMP2)
                  IF (TEMP1.GT.TEMP2) TEMP1 = TEMP2   ! IC MUST BE <= VC
                  IF (COFF.EQ.3) TEMP1 = TEMP2        ! VERTICAL CUTOFF
                  DDAYS(I) = DDAYS(I) - TEMP1
               END IF
               IF (DDAYS(I).LT.0.0) DDAYS(I) = 0.0
            END IF
            ACCUM(I+1) = ACCUM(I) + DDAYS(I)
  200    CONTINUE
      ELSE IF (CM.EQ.3) THEN        ! SINGLE TRIANGLE
         DO 300 I = 1,NDAYS
            CALL SITRIA (ABOVE,MIN(I),MAX(I+1),LTHRES,DDAYS(I),ERROR)
            IF (ERROR.NE.0) RETURN
            IF (COFF.GT.0) THEN        ! CUTOFF THRESHOLD ACTIVE
               CALL SITRIA (ABOVE,MIN(I),MAX(I+1),CTHRES,TEMP1,ERROR)
               DDAYS(I) = DDAYS(I) - TEMP1  ! REMOVE DD ABOVE CUTOFF
               IF (COFF.GE.2) THEN          ! CHECK FOR INT. OR VERT. CUTOFF
                  CALL VERTCUT (ABOVE,J,MIN(I),MAX(I+1),THRESH,TEMP2)
                  IF (TEMP1.GT.TEMP2) TEMP1 = TEMP2   ! IC MUST BE <= VC
                  IF (COFF.EQ.3) TEMP1 = TEMP2        ! VERTICAL CUTOFF
                  DDAYS(I) = DDAYS(I) - TEMP1
               END IF
               IF (DDAYS(I).LT.0.0) DDAYS(I) = 0.0
            END IF
            ACCUM(I+1) = ACCUM(I) + DDAYS(I)
  300    CONTINUE
      ELSE IF (CM.EQ.4) THEN        ! DOUBLE TRIANGLE
         DO 400 I = 1,NDAYS
            CALL DOTRIA (ABOVE,CI,MAX(I),MIN(I),LTHRES,DDAYS(I),ERROR)
            IF (ERROR.NE.0) RETURN
            IF (COFF.GT.0) THEN        ! CUTOFF THRESHOLD ACTIVE
               CALL DOTRIA (ABOVE,CI,MAX(I),MIN(I),CTHRES,TEMP1,ERROR)
               DDAYS(I) = DDAYS(I) - TEMP1  ! REMOVE DD ABOVE CUTOFF
               IF (COFF.GE.2) THEN          ! CHECK FOR INT. OR VERT. CUTOFF
                  CALL DOVRCT (ABOVE,J,CI,MAX(I),MIN(I),THRESH,TEMP2)
                  IF (TEMP1.GT.TEMP2) TEMP1 = TEMP2   ! IC MUST BE <= VC
                  IF (COFF.EQ.3) TEMP1 = TEMP2        ! VERTICAL CUTOFF
                  DDAYS(I) = DDAYS(I) - TEMP1
               END IF
               IF (DDAYS(I).LT.0.0) DDAYS(I) = 0.0
            END IF
            ACCUM(I+1) = ACCUM(I) + DDAYS(I)
  400    CONTINUE
      ELSE ! CM.EQ.5             ! HUBER'S METHOD
         DO 500 I = 1,NDAYS
            CALL HUBERM (MIN(I),MAX(I+1),LTHRES,CTHRES,DDAYS(I),ERROR)
            IF (ERROR.NE.0) RETURN
            ACCUM(I+1) = ACCUM(I) + DDAYS(I)
  500    CONTINUE
      END IF
C
      RETURN
      END
C
      SUBROUTINE DOSINE (AB,CI,MAX,MIN,THRESH,DDAY,ERROR)
C
C     PURPOSE:
C      TO CALCULATE DEGREE-DAYS ACCUMULATED ABOVE or BELOW A THRESHOLD
C     USING A SINE WAVE ESTIMATION OF AREA UNDER THE CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  DOSINE.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  SISINE
C
C    *****************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 CI,                    ! COMPUTATIONAL INTERVAL
     *          ERROR                  !
C
      REAL*4 DDAY,                     ! DEGREE-DAYS
     *       MAX(2),                   ! YESTERDAY'S AND TODAY'S MAXIMUM
     *       MIN(2),                   ! TODAY'S AND TOMORROW'S MINIMUM
     *       THRESH                    ! THRESHOLD
C
C                  COMPUTE DEGREE-DAYS
C
      IF (CI.EQ.1) THEN                ! MINIMUM TO MINIMUM
         CALL SISINE (AB,MIN(1),MAX(2),THRESH,DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         CALL SISINE (AB,MIN(2),MAX(2),THRESH,TEMP,ERROR)
      ELSE                             ! MAXIMUM TO MAXIMUM
         CALL SISINE (AB,MIN(1),MAX(1),THRESH,DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         CALL SISINE (AB,MIN(1),MAX(2),THRESH,TEMP,ERROR)
      END IF
      IF (ERROR.NE.0) RETURN
C
      DDAY = (DDAY + TEMP) / 2.0
C
      RETURN
      END
C
      SUBROUTINE DOTRIA (AB,CI,MAX,MIN,THRESH,DDAY,ERROR)
C
C     PURPOSE:
C      TO CALCULATE DEGREE-DAYS ACCUMULATED ABOVE or BELOW A THRESHOLD
C     USING A TRIANGULAR ESTIMATION OF AREA UNDER THE CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  DOTRIA.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  SITRIA
C
C    *****************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 CI,                    ! COMPUTATIONAL INTERVAL
     *          ERROR                  !
C
      REAL*4 DDAY,                     ! DEGREE-DAYS
     *       MAX(2),                   ! YESTERDAY'S AND TODAY'S MAXIMUM
     *       MIN(2),                   ! TODAY'S AND TOMORROW'S MINIMUM
     *       THRESH                    ! THRESHOLD
C
C                  COMPUTE DEGREE-DAYS
C
      IF (CI.EQ.1) THEN                ! MINIMUM TO MINIMUM
         CALL SITRIA (AB,MIN(1),MAX(2),THRESH,DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         CALL SITRIA (AB,MIN(2),MAX(2),THRESH,TEMP,ERROR)
      ELSE                             ! MAXIMUM TO MAXIMUM
         CALL SITRIA (AB,MIN(1),MAX(1),THRESH,DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         CALL SITRIA (AB,MIN(1),MAX(2),THRESH,TEMP,ERROR)
      END IF
      IF (ERROR.NE.0) RETURN
C
      DDAY = (DDAY + TEMP) / 2.0
C
      RETURN
      END
C
      SUBROUTINE DOVRCT (AB,METHOD,CI,MAX,MIN,THRESH,AREA)
C
C     PURPOSE:
C        PRODUCE VERTICAL CUTOFF AREAS FOR DOUBLE SINE & DOUBLE
C     TRIANGULAR METHODS.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  DOVRCT.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  VERTCUT
C
C    *******************************************************************

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 CI,                    ! COMPUTATIONAL INTEVAL
     *          METHOD                 ! COMPUTATIONAL METHOD
C
      REAL*4 AREA,                     !
     *       MAX(2),                   ! YESTERDAY'S & TODAY'S MAX
     *       MIN(2),                   ! TODAY'S & TOMORROW'S MIN
     *       TEMP,                     !
     *       THRESH(2)                 ! THRESHOLDS
C
C                  COMPUTE FOR PEAK : MIN,MAX,MIN
C
      IF (CI.EQ.1) THEN
         CALL VERTCUT (AB,METHOD,MIN(1),MAX(2),THRESH,AREA)
         CALL VERTCUT (AB,METHOD,MIN(2),MAX(2),THRESH,TEMP)
C
C                  COMPUTE FOR TROUGH : MAX,MIN,MAX
C
      ELSE ! CI.EQ.2
         CALL VERTCUT (AB,METHOD,MIN(1),MAX(1),THRESH,AREA)
         CALL VERTCUT (AB,METHOD,MIN(1),MAX(2),THRESH,TEMP)
      END IF
C
C                  AVERAGE AREAS
C
      AREA = (AREA + TEMP) / 2.0
C
      RETURN
      END
C
      SUBROUTINE HEATU (CM,CI,MAX,MIN,THRESH,DDAY,ERROR)
C
C     PURPOSE:
C     CALCULATE DEGREE-DAYS FOR ONE DAY FROM MAX & MIN.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  HEATU.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  DOSINE, DOTRIA, DOVRCT, HUBERM, SISINE, SITRIA, VERTCUT
C
C    ************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 ABOVE                  ! TRUE FOR HEAT UNITS
C
      INTEGER*2 CI,                    ! COMPUTATION INTERVAL
     *          CM(2),                 ! COMPUTATION METHOD
     *          ERROR                  ! RETURNED ERROR SIGNAL
C
      REAL*4 DDAY,                     ! DEGREE-DAYS RETURNED
     *       THRESH(2),                ! THRESHOLDS
     *       MAX(2),                   ! YESTERDAY'S & TODAY'S MAX TEMPS.
     *       MIN(2),                   ! TODAY'S & TOMORROW'S MIN TEMPS.
     *       TEMP1,                    ! DD ABOVE CUTOFF THRESHOLD
     *       TEMP2                     ! ADDITIONAL DD FOR VERTICAL CUTOFF
C
C                  INITIALIZATIONS
C
      ABOVE = .TRUE.
      ERROR = 0
      TEMP1 = 0.0
C
C                  COMPUTE DEGREE-DAYS
C
      IF (CM(1).EQ.1) THEN             ! SINGLE SINE WAVE
         CALL SISINE (ABOVE,MIN(1),MAX(2),THRESH(1),DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         IF (CM(2).GT.0)               ! CUTOFF THRESHOLD ACTIVE
     *      CALL SISINE (ABOVE,MIN(1),MAX(2),THRESH(2),TEMP1,ERROR)
      ELSE IF (CM(1).EQ.2) THEN        ! DOUBLE SINE WAVE
         CALL DOSINE (ABOVE,CI,MAX(1),MIN(1),THRESH(1),DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         IF (CM(2).GT.0)               ! CUTOFF THRESHOLD ACTIVE
     *      CALL DOSINE (ABOVE,CI,MAX(1),MIN(1),THRESH(2),TEMP1,ERROR)
      ELSE IF (CM(1).EQ.3) THEN        ! SINGLE TRIANGULAR
         CALL SITRIA (ABOVE,MIN(1),MAX(2),THRESH(1),DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         IF (CM(2).GT.0)               ! CUTOFF THRESHOLD ACTIVE
     *      CALL SITRIA (ABOVE,MIN(1),MAX(2),THRESH(2),TEMP1,ERROR)
      ELSE IF (CM(1).EQ.4) THEN        ! DOUBLE TRIANGULAR
         CALL DOTRIA (ABOVE,CI,MAX(1),MIN(1),THRESH(1),DDAY,ERROR)
         IF (ERROR.NE.0) RETURN
         IF (CM(2).GT.0)               ! CUTOFF THRESHOLD ACTIVE
     *      CALL DOTRIA (ABOVE,CI,MAX(1),MIN(1),THRESH(2),TEMP1,ERROR)
      ELSE ! CM(1).EQ.5             ! HUBER'S METHOD
         CALL HUBERM (MIN(1),MAX(2),THRESH(1),THRESH(2),DDAY,ERROR)
      END IF
      IF (ERROR.NE.0) RETURN
      DDAY = DDAY - TEMP1              ! REMOVE DD ABOVE CUTOFF, IF ANY
C
C                  GENERATE INTERMEDIATE OR VERTICAL CUTOFF, IF ANY
C
      IF (CM(2).GE.2) THEN
C
C                  SET METHOD TYPE
C
         IF (CM(1).EQ.1 .OR. CM(1).EQ.2) THEN
            I = 1                               ! SINE METHODS
         ELSE ! CM(1).EQ.3 .OR. CM(1).EQ.4
            I = 2                               ! TRIANGULAR METHODS
         END IF
C
C                  COMPUTE INTERMEDIATE OR VERTICAL CUTOFF
C
         IF (CM(1).EQ.1 .OR. CM(1).EQ.3) THEN   ! SINGLE METHODS
            CALL VERTCUT (ABOVE,I,MIN(1),MAX(2),THRESH,TEMP2)
         ELSE ! CM(1).EQ.2 .OR. CM(1).EQ.4   ! DOUBLE METHODS
            CALL DOVRCT (ABOVE,I,CI,MAX(1),MIN(1),THRESH,TEMP2)
         END IF
         IF (TEMP1.GT.TEMP2) TEMP1 = TEMP2   ! INTERM. CUTOFF MUST BE <= VERT.
         IF (CM(2).EQ.3) TEMP1 = TEMP2       ! VERTICAL CUTOFF
         DDAY = DDAY - TEMP1
         IF (DDAY.LT.0.0) DDAY = 0.0
      END IF
C
      RETURN
      END
C
      SUBROUTINE HTEMPS (CI,MAX,MIN,HOURLY,ERROR)
C
C     PURPOSE:
C        COMPUTE THE TEMPERATURES FOR EACH HOUR IN A DAY, GIVEN
C     THE MAXIMUM AND MINIMUM TEMPERATURES.
C
C     NOTE: ASSUMES TEMPERATURES ON A DOUBLE SINE CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  HTEMPS.FOR
C                  MICROSOFT FORTRAN 5.0
C
C    *****************************************************************
C
      INTEGER*2 CI,                    ! COMPUTATIONAL INTERVAL
     *          ERROR
C
      REAL*4 A,                        ! AMPLITUDE OF SINE WAVE
     *       B,                        ! AVERAGE TEMPERATURE
     *       C,                        ! PERIOD OF SINE WAVE
     *       HOURLY(24),               ! HOURLY TEMPERATURES
     *       MAX(2),                   ! YESTERDAY'S & TODAY'S MAXIMUMS
     *       MIN(2),                   ! TODAY'S & TOMMORROW'S MINIMUMS
     *       MN,                       ! LOCAL MINIMUM
     *       MX,                       ! LOCAL MAXIMUM
     *       PI,
     *       X                         ! POSITION ON SINE WAVE
C
      PARAMETER  (PI = 3.141592654)
C
C                  SET CHARACTERISTICS FOR EACH HALF DAY
C
      C = PI / 12.0
      ERROR = 0
      K = 0
      IF (CI.EQ.1) THEN
         X = 18.0
      ELSE ! CI.EQ.2
         X = 6.0
      END IF
      DO 120 I = 1,2
         IF (CI.EQ.1) THEN             ! MIN TO MIN
            MN = MIN(I)
            MX = MAX(2)
         ELSE ! CI.EQ.2             ! MAX TO MAX
            MN = MIN(1)
            MX = MAX(I)
         END IF
         IF (MN.GT.MX) THEN
            ERROR = 1
            RETURN
         END IF
C
         A = (MX - MN) / 2.0
         B = (MX + MN) / 2.0
C
C                  COMPUTE THE HOURLY TEMPERATURES
C
         DO 100 J = 1,12
            K = K + 1
            HOURLY(K) = A * SIN(C*X) + B
            X = X + 1.0
  100    CONTINUE
  120 CONTINUE
C
      RETURN
      END
C
      SUBROUTINE HTEMPST (CI,MAX,MIN,HOURLY,ERROR)
C
C     PURPOSE:
C        COMPUTE THE TEMPERATURES FOR EACH HOUR IN A DAY, GIVEN
C     THE MAXIMUM AND MINIMUM TEMPERATURES.
C
C     NOTE: ASSUMES TEMPERATURES ON A DOUBLE TRIANGLE (SAWTOOTH) CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  HTEMPST.FOR
C                  MICROSOFT FORTRAN 5.0
C
C    *****************************************************************
C
      INTEGER*2 CI,                    ! COMPUTATIONAL INTERVAL
     *          ERROR
C
      REAL*4 HOURLY(24),               ! HOURLY TEMPERATURES
     *       INCREMENT,                ! HOURLY INCREMENT
     *       MAX(2),                   ! YESTERDAY'S & TODAY'S MAXIMUMS
     *       MIN(2),                   ! TODAY'S & TOMMORROW'S MINIMUMS
     *       X                         ! POSITION ON SAWTOOTH
C
C                  INITIALIZATION
C
      ERROR = 0
C
C                  SET CHARACTERISTICS FOR FIRST HALF DAY
C
      IF (CI .EQ. 1) THEN              ! MIN TO MIN
         X = MIN(1)
         INCREMENT = (MAX(2) - MIN(1))/12.0
      ELSE ! CI .EQ. 2              ! MAX TO MAX
         X = MAX(1)
         INCREMENT = (MIN(1) - MAX(1))/12.0
      END IF
C
C                  COMPUTE THE HOURLY TEMPERATURES
C
      DO 100 J = 1,12
         HOURLY(J) = X
         X = X + INCREMENT
  100 CONTINUE
C
C                  SET CHARACTERISTICS FOR SECOND HALF DAY
C
      IF (CI .EQ. 1) THEN              ! MIN TO MIN
         X = MAX(2)
         INCREMENT = (MIN(2) - MAX(2))/12.0
      ELSE ! CI .EQ. 2              ! MAX TO MAX
         X = MIN(1)
         INCREMENT = (MAX(2) - MIN(1))/12.0
      END IF
C
C                  COMPUTE THE HOURLY TEMPERATURES
C
      DO 200 J = 13,24
         HOURLY(J) = X
         X = X + INCREMENT
  200 CONTINUE
C
      RETURN
      END
C
SUBROUTINE HUBERM (MIN,MAX,LTHRES,UTHRES,TU,HU,ERROR)
C
C     PURPOSE:
C      TO CALCULATE DEGREE-DAYS ACCUMULATED ABOVE A THRESHOLD
C     USING A SINE WAVE ESTIMATION OF AREA UNDER THE CURVE WITH
C     REDUCED CONTRIBUTIONS ABOVE THE UPPER THRESHOLD.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  HUBERM.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  NO EXTERNAL ROUTINES
C
C    *****************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

      INTEGER*2 ERROR                  ! RETURNED ERROR FLAG
C
      REAL*4 HALFPI,                   ! A CONSTANT
     *       HU,                       ! HEAT UNITS
     *       LTHRES,                   ! LOWER THRESHOLD
     *       MAX,                      ! MAXIMUM TEMPERATURE
     *       MEAN,                     ! MEAN TEMPERATURE
     *       MIN,                      ! MINIMUM TEMPERATURE
     *       PI,                       ! A CONSTANT
     *       THETA1,                   !
     *       THETA2,                   !
     *       UTHRES,                   ! UPPER THRESHOLD
     *       W                         !
C
      CHARACTER*1 TU                   ! TEMPERATURE UNITS
C
      DATA HALFPI / 1.570795/
      DATA PI     / 3.14159 /
C
      ERROR = 0
      HU = 0.0
      IF (MIN.GT.MAX) THEN
         ERROR = 1
         RETURN
      END IF
C
      MEAN = (MAX + MIN)/2.0
C
      IF (MIN.LT.LTHRES) THEN
         IF (MAX.LE.LTHRES) THEN
            RETURN
         ELSE IF (MAX.LE.UTHRES) THEN
            W = MAX - MEAN
            THETA1 = ASIN((LTHRES - MEAN)/W)
            HU = (W*COS(THETA1) - (LTHRES-MEAN)*(HALFPI-THETA1))/PI
         ELSE ! MAX.GT.UTHRES
            W = MAX - MEAN
            THETA1 = ASIN((LTHRES - MEAN)/W)
            THETA2 = ASIN((UTHRES - MEAN)/W)
            HU =   W * (COS(THETA1) - COS(THETA2))
     *           - (LTHRES - MEAN) * (HALFPI - THETA1)
     *           + (UTHRES - MEAN) * (HALFPI - THETA2)
            HU = HU / PI
         END IF
C
      ELSE ! MIN.GE.LTHRES
         IF (MIN.LT.UTHRES) THEN
            IF (MAX.LE.UTHRES) THEN
               IF (TU.EQ.'F') THEN
                  HU = MEAN - LTHRES - 0.3
               ELSE  ! (TU.EQ.'C')
                  HU = MEAN - LTHRES - .166667
               END IF
               IF (HU.LT.0.0) HU = 0.0
            ELSE ! MAX.GT.UTHRES
               W = MAX - MEAN
               THETA2 = ASIN((UTHRES-MEAN)/W)
               HU = (MEAN-LTHRES) - (W*COS(THETA2)-(UTHRES-MEAN)*
     *              (HALFPI-THETA2))/PI
            END IF
         ELSE ! MIN.GE.UTHRES
            HU = UTHRES - LTHRES
         END IF
      END IF
C
      RETURN
      END
C
      SUBROUTINE SISINE (AB,MIN,MAX,THRESH,DDAY,ERROR)
C     PURPOSE:
C      TO CALCULATE DEGREE-DAYS ACCUMULATED ABOVE or BELOW A
C     THRESHOLD USING A SINE WAVE ESTIMATION OF AREA UNDER THE CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  SISINE.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  NO EXTERNAL ROUTINES
C
C    *****************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 ERROR                  !
C
      REAL*4 ARG,                      !
     *       DDAY,                     ! DEGREE-DAYS
     *       MAX,                      ! MAXIMUM TEMPERATURE
     *       MIN,                      ! MINIMUM TEMPERATURE
     *       MN,                       ! LOCAL COMPUTATIONAL MIN
     *       MX,                       ! LOCAL COMPUTATIONAL MAX
     *       PI,                       !
     *       Q,                        !
     *       TA,                       !
     *       TM,                       !
     *       THRESH,                   ! THRESHOLD
     *       XA                        !
C
      DATA PI /3.14159265/
C
C                  INITIALIZE VARIABLES
C
      DDAY = 0.0
      ERROR = 0
      IF (AB) THEN                     ! DEGREE-DAYS ABOVE
         MN = MIN
         MX = MAX
      ELSE                             ! DEGREE-DAYS BELOW (USE MIRROR IMAGE)
         MN = THRESH - (MAX - THRESH)
         MX = THRESH + (THRESH - MIN)
      END IF
C
C                  COMPUTE DEGREE-DAYS
C
      IF (MN.LT.MX) THEN
         IF (MX.LE.THRESH) RETURN
         TM = 0.5 * (MX + MN)
         TA = 0.5 * (MX - MN)
C
         ARG = (THRESH - TM)/TA
         IF (ARG.GT.1.0) ARG = 1.0
         IF (ARG.LT.-1.0) ARG = -1.0
C
C            APPROXIMATE VALUE OF THETA AT ARG
C
         XA = ABS(ARG)
         Q = 1.57079632 - SQRT(1.0-XA) * (1.5707288 + XA*
     *       (-0.2121144 + XA * (0.0745610 - XA * 0.0187293)))
         Q = ABS(Q)
         IF (ARG.LT.0) Q = -Q
         THETA = Q                     ! THETA = ARCSIN (ARG)
         THETA = THETA + 1.57079632    ! THETA = ARCCOS (ARG)
C
         DDAY = ((TM - THRESH) * (PI-THETA) + TA * SIN (THETA))/PI
      ELSE IF (MN.EQ.MX) THEN
         IF (MX.GT.THRESH) THEN
            DDAY = MX - THRESH
         END IF
      ELSE  ! MN.GT.MX
         ERROR = 1
      END IF
C
      RETURN
      END
C
      SUBROUTINE SITRIA (AB,MIN,MAX,THRESH,DDAY,ERROR)
C
C     PURPOSE:
C      TO CALCULATE DEGREE-DAYS ACCUMULATED ABOVE or BELOW A THRESHOLD
C     USING TRIANGULAR ESTIMATION OF AREA UNDER THE CURVE.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  SITRIA.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  NO EXTERNAL ROUTINES
C
C    *****************************************************************
C

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 ERROR                  !
C
      REAL*4 DDAY,                     ! DEGREE-DAYS
     *       MAX,                      ! MAXIMUM TEMPERATURE
     *       MIN,                      ! MINIMUM TEMPERATURE
     *       MN,                       ! LOCAL COMPUTATIONAL MIN
     *       MX,                       ! LOCAL COMPUTATIONAL MAX
     *       THRESH                    ! THRESHOLD
C
C                  INITIALIZE VARIABLES
C
      DDAY = 0.0
      ERROR = 0
      IF (AB) THEN                     ! DEGREE-DAYS ABOVE
         MN = MIN
         MX = MAX
      ELSE                             ! DEGREE-DAYS BELOW (USE MIRROR IMAGE)
         MN = THRESH - (MAX - THRESH)
         MX = THRESH + (THRESH - MIN)
      END IF
C
C                  COMPUTE DEGREE-DAYS
C
      IF (MN.LT.MX) THEN
         IF (MN.LT.THRESH) THEN
            IF (MX.GT.THRESH) THEN
               DDAY = (0.5 * (MX-THRESH)*(MX-THRESH))/(MX-MN)
            END IF
         ELSE
            DDAY = 0.5 * (MX + MN - (2 * THRESH))
         END IF
      ELSE IF (MN.EQ.MX) THEN
         IF (MX.GT.THRESH) THEN
            DDAY = MX - THRESH
         END IF
      ELSE ! MN.GT.MX
         ERROR = 1
      END IF
C
      RETURN
      END
C
      SUBROUTINE VERTCUT (AB,METHOD,MIN,MAX,THRESH,AREA)
C
C     PURPOSE:
C        CALCULATE THE AREA TO BE SUBTRACTED FROM DEGREE-DAYS
C     COMPUTED WITH A HORIZONTAL CUT OFF TO PRODUCE A VERTICAL
C     CUT OFF.
C
C     COMPILE AS:  FL %4I2 %4Nt %FPi  VERTCUT.FOR
C                  MICROSOFT FORTRAN 5.0
C
C     CALLS:  NO EXTERNAL ROUTINES
C
C    *******************************************************************

Copyright 1985 - Regents of the University of California.  All rights reserved.

C
      LOGICAL*2 AB                     ! T=ABOVE; F=BELOW
C
      INTEGER*2 METHOD                 ! 1=SINE WAVE; 2=TRIANGULAR
C
      REAL*4 AREA,                     ! AREA TO BE REMOVED
     *       LT,                       ! LOCAL LOWER THRESHOLD
     *       MAX,                      ! MAXIMUM TEMPERATURE
     *       MIN,                      ! MINIMUM TEMPERATURE
     *       MN,                       ! LOCAL COMPUTATIONAL MIN
     *       MX,                       ! LOCAL COMPUTATIONAL MAX
     *       Q,                        !
     *       TA,                       ! TEMPERATURE AMPLITUDE
     *       THRESH(2),                ! THRESHOLDS
     *       TM,                       ! AVERAGE TEMPERATURE
     *       UT                        ! LOCAL UPPER THRESHOLD
C
C                  INITIALIZATIONS
C
      AREA = 0.0
      PI = 3.14159                     ! PI
      LT = THRESH(1)
      IF (AB) THEN                     ! DEGREE-DAYS ABOVE
         MN = MIN
         MX = MAX
         UT = THRESH(2)
      ELSE                             ! DEGREE-DAYS BELOW (USE MIRROR IMAGE)
         MN = LT - (MAX - LT)
         MX = LT + (LT - MIN)
         UT = LT + (LT - THRESH(2))
      END IF
C
C                  CHECK FOR APPROPRIATE CONDITIONS
C
      IF (MX.LE.UT) RETURN
      IF (MN.EQ.MX .OR. MN.GE.UT) THEN
         AREA = UT - LT
         RETURN
      END IF
C
C                  COMPUTE AREA FOR SINE WAVE
C
      IF (METHOD.EQ.1) THEN
         TM = 0.5 * (MX + MN)
         TA = 0.5 * (MX - MN)
C
         THETA = ASIN ((UT-TM)/TA)
         Q = PI - 2.0 * THETA
         AREA = Q * (UT-LT)/(PI * 2.0)
C
C                  COMPUTE AREA FOR TRIANGULAR METHOD
C
      ELSE ! METHOD.EQ.2
         Q = (MX - UT) / (MX - MN)
         AREA = Q * (UT - LT)
      END IF
C
      RETURN
      END

Top of page


Statewide IPM Program, Agriculture and Natural Resources, University of California
All contents copyright 2014 The Regents of the University of California. All rights reserved.

For noncommercial purposes only, any Web site may link directly to this page. FOR ALL OTHER USES or more information, read Legal Notices. Unfortunately, we cannot provide individual solutions to specific pest problems. See our Home page, or in the U.S., contact your local Cooperative Extension office for assistance.

Agriculture and Natural Resources, University of California

Accessibility   /WEATHER/ddroutines.html revised: July 10, 2014. Contact webmaster.