      PROGRAM GENEEC2

C     THIS IS A PROGRAM TO CALCULATE BOTH ACUTE AND CHRONIC GENERIC  
C     EXPECTED ENVIRONMENTAL CONCENTRATION (GEEC) VALUES - IT CONSIDERS 
C     REDUCTION IN DISSOLVED PESTICIDE CONCENTRATION DUE TO ADSORPTION 
C     OF PESTICIDE TO SOIL OR SEDIMENT, INCORPORATION, DEGRADATION IN 
C     SOIL BEFORE WASHOFF TO A WATER BODY, DIRECT DEPOSITION OF SPRAY 
C     DRIFT INTO THE WATER BODY, AND DEGRADATION OF THE PESTICIDE WITHIN 
C     THE WATER BODY -IT IS DESIGNED TO MIMIC A PRZM-EXAMS SIMULATION
C   
      DIMENSION X0(153),X1(153),X2(153),X3(153),X4(153),X5(153)
      DIMENSION XV(153,6)
C
      EQUIVALENCE (X0(1),XV(1,1)),(X1(1),XV(1,2)),(X2(1),XV(1,3))
      EQUIVALENCE (X3(1),XV(1,4)),(X4(1),XV(1,5)),(X5(1),XV(1,6))
C
      REAL CHRONIC(101),SDCONC(101),ROCONC(101),DEGFRF(10),ADSFRR(100),
     2     ADSFRS(100),PSTMSF(600),PSTMSP(600)
      REAL INCORP,APPRAT,KOC,KOCFRC,SOL,KADS1,KADSUS,KADSUR,SDINIT,
     2     SDFIN,ROINIT,ROFIN,METHAP,KMETP,KDEGF,APPEFF,PCTSRO,ROAREA,
     3     WBAREA,CONC0,CONC4,CONC21,CONC60,CONC90,DEGHAP,KDEGP,METHAF,
     4     KMETF,HYDHAP,DRIFT,KHYDP,CORECT,FOTHAP,KFOTP,SUM4,SUM21,
     5     SUM60,SUM90,KD,KDFRAC,YLOC,YLOCEN,PONDEP,METRAT
C
      REAL CHECK1,CHECK2,CHECK3,CHECK4,CHECK5,CHECK6,CHECK7
      REAL CHEK4,CHEK21,CHEK60,CHEK90
      REAL CONC4A,CON21A,CON60A,CON90A
      REAL SCON1,SCON2,SCON3,SCON4,SCON5,SCON6,SCON7,SCON8,SCON9,SCON10
      REAL ROCO1,ROCO2,ROCO3,ROCO4,ROCO5,ROCO6,ROCO7,ROCO8,ROCO9,ROCO10
      REAL DEGF1,DEGF2,DEGF3,DEGF4,DEGF5,DEGF6,DEGF7,DEGF8,DEGF9,DEGF10
      REAL LOOK1,LOOK2
C 
      INTEGER CODE,STORM,APFLAG,APPNUM,APSPAC,NASAE
      CHARACTER*1 METHOD,AGAIN,WETTED,ADSORP,AIRFLG,GRNFLG,ORCFLG
      CHARACTER*4 SOLUNI
      CHARACTER*6 SPTYPE
      CHARACTER*10 COLON,COLOFF,CLEAR,CROP
      CHARACTER*16 CHMNAM
      CHARACTER*20 OUTFIL
      CHARACTER*22 UNITS
C
C     DESCRIPTION OF VARIABLES
C
C     ADSFRR   FRACTION OF RUNOFF ADSORTION TO SEDIMENT COMPLETED
C     ADSFRS   FRACTION OF SPRAY DRIFT ADSORTION TO SEDIMENT COMPLETED
C     ADSORP   FLAG TO CHOSE BETWEEN KOC AND Kd PLUS ORGANIC CARBON AS 
C              INPUT VALUES
C     AIRFLG   FLAG TO INDICATE AERIAL DROPLET SIZE DISTRIBUTION
C     APFLAG   FLAG TO INDICATE SURFACE APPLICATION
C     APPEFF   APPLICATION EFFICIENCY
C     APPNUM   MAXIMUM NUMBER OF APPLICATION PERMITTED ON LABEL
C     APPRAT   APPLICATION RATE
C     APSPAC   INTERVAL IN DAYS BETWEEN PESTICIDE APPLICATIONS
C     CONC     PEAK CONCENTRATION IN THE POND
C     CONC4    CONCENTRATION IN THE POND AFTER 4 DAYS
C     CONC21   CONCENTRATION IN THE POND AFTER 21 DAYS
C     CONC60   CONCENTRATION IN THE POND AFTER 60 DAYS
C     CONC90   CONCENTRATION IN THE POND AFTER 90 DAYS
C     DEGFRF   FRACTION OF PESTICIDE REMAINING IN FIELD AT TIME OF RAIN
C     DEGHAP   CALCULATED OVERALL HALFLIFE IN THE POND
C     FOC      FRACTION ORGANIC CARBON
C     FOTHAP   PHOTOLYSIS HALFLIFE IN THE POND = NOMINAL HALF-LIFE / 124
C     GRNFLG   FLAG TO INDICATE GROUND SPRAYER TYPE
C     HYDHAP   HYDROLYSIS HALFLIFE IN THE POND
C     INCORP   DEPTH OF INCORPORATION
C     INITCONC PARTIAL CALCULATION FOR UNITS CONVERSION AND RUNOFF DEPTH
C     KADS1    BINDING RATE FOR SPRAY DRIFT ON DAY 1
C     KADSUR   ULTIMATE BINDING RATE FOR RUNOFF ON DAYS TWO
C              THROUGH SIXTY
C     KADSUS   ULTIMATE BINDING RATE FOR SPRAY DRIFT ON DAYS TWO
C              THROUGH SIXTY
C     KD       SOIL ADSORPTION COEFFICIENT
C     KMETF    METABOLIC DEGREDATION RATE IN THE FIELD
C     KDEGF    OVERALL DEGREDATION RATE IN THE FIELD
C     KDEGP    OVERALL DEGREDATION RATE IN THE POND
C     KFOTP    PHOTOLYSIS DEGREDATION RATE IN THE POND
C     KHYDP    HYDROLYSIS DEGREDATION RATE IN THE POND
C     KMETP    AEROBIC METABOLIC DEGREDATION RATE IN THE POND
C     KOC      ORGANIC CARBON PARTITION COEFFICIENT
C     KDFRAC   DISSOLVED FRACTION OF THE PESTICIDE AFTER ADSORPTION
C     METHAF   AEROBIC METABOLIC SOIL HALFLIFE
C     METHAP   AEROBIC METABOLIC HALFLIFE IN THE POND
C     METRAT   APPLICATION RATE IN KILOGRAMS PER HECTARE
C     ORCFLG   FLAG TO INDICATE TYPE OF ORCHARD AIRBLAST APPLICATION
C     PCTSRO   PERCENT SURFACE RUNOFF FROM THE FIELD
C     POC      PERCENT ORGANIC CARBON
C     PSTMSF   ARRAY WITH VALUES FOR MASS OF PESTICIDE IN THE FIELD ON 
C              THE DAY OF APPLICATION JUST AFTER APPLICATION
C     PSTMSP   ARRAY WITH VALUES FOR MASS OF PESTICIDE IN THE POND ON 
C              THE DAY OF APPLICATION JUST AFTER APPLICATION
C     ROAREA   AREA OF FIELD FROM WHICH RUNOFF OCCURS
C     ROFIN    FINAL CONCENTRATION IN THE POND DUE TO RUNOFF
C     ROINIT   INITIAL CONCENTRATION IN THE POND DUE TO RUNOFF
C     SDINIT   INITIAL CONCENTRATION IN THE POND DUE TO SPRAY DRIFT
C     SDFIN    FINAL CONCENTRATION IN THE POND DUE TO SPRAY DRIFT
C     SOL      SOLUBILITY
C     SUM4     SUM OF THE FIRST 4 DAYS POND CONCENTRATIONS
C     SUM21    SUM OF THE FIRST 21 DAYS POND CONCENTRATIONS
C     SUM60    SUM OF THE FIRST 60 DAYS POND CONCENTRATIONS
C     SUM90    SUM OF THE FIRST 90 DAYS POND CONCENTRATIONS
C     TDEGF    DEGREDATION TIME IN THE FIELD
C     WBAREA   SURFACE AREA OF THE WATERBODY (STANDARD FARM POND)
C     WETTED   FLAG TO INDICATE THE PESTICIDE IS WETTED-IN AND RUNOFF
C              OCCURS ONE THE DAY OF APPLICATION
C     YLOC     DISTANCE FROM EDGE OF DOWNWIND SWATH TO NEAR EDGE OF
C              POND IN METRIC UNITS (METERS)
C     YLOCEN   DISTANCE FROM EDGE OF DOWNWIND SWATH TO NEAR EDGE OF
C              POND IN ENGLISH UNITS (FEET)
C      
      COLON=CHAR(27)//'[34;47m'
      WRITE(*,2) COLON
   2  FORMAT(A10)
C 
      CLEAR=CHAR(27)//'[2J'
      WRITE(*,2) CLEAR
C 
      WRITE(*,5)
   5  FORMAT(///,3X,'                           GENEEC             ',///
     2 3X,'           ENVIRONMENTAL FATE AND EFFECTS DIVISION        ',/
     3 3X,'                OFFICE OF PESTICIDE PROGRAMS              ',/
     4 3X,'            U.S. ENVIRONMENTAL PROTECTION AGENCY         ',//
     5 3X,'                  TIER ONE SCREENING MODEL                ',/
     6 3X,'              FOR PESTICIDE AQUATIC ECOLOGICAL            ',/
     7 3X,'                     EXPOSURE ASSESSMENT                 ',//
     8 3X,'                         VERSION 2.0                      ',/
     9 3X,'                         AUG 1, 2001                       ')
C                                
      WRITE(*,10)                                                      
   10 FORMAT(//,3X,'THIS PROGRAM IS DESIGNED TO CALCULATE A SET OF SCREE
     2NING LEVEL',/
     3 3X,'GENERIC ESTIMATED ENVIRONMENTAL CONCENTRATION (EEC) VALUES',/
     4 3X,'RESULTING FROM RUNOFF FROM A TEN HECTARE TREATED AGRICULTURAL
     5',/
     6 3X,'FIELD INTO A ONE HECTARE BY TWO METER DEEP STATIC WATER BODY'
     7,///
     8 3X,'GENEEC IS USED TO ESTIMATE CONSERVATIVE PESTICIDE CONCENTRATI
     9ON',/
     A 3X,'VALUES FOR AQUATIC ECOLOGICAL EXPOSURE ASSESSMENT        ',//
     B 3X,'PLEASE ENTER A RUN NUMBER TO CONTINUE ---> ',$)
      READ(*,*) CODE
C
C  OPEN FILES FOR PROGRAM OUTPUT
C
      WRITE(*,11)
   11 FORMAT(///,3X,'PLEASE SELECT AN OUTPUT FILE NAME ---> ',$)
      READ(*,12) OUTFIL
   12 FORMAT(A20)
C
      OPEN(UNIT=6,FILE=OUTFIL,STATUS='UNKNOWN')
C
   99 WRITE(*,13)
   13 FORMAT(///,3X,'PLEASE ENTER THE CHEMICAL NAME ---> ',$)
      READ(*,14) CHMNAM
   14 FORMAT(A16)   
C
      WRITE(*,15)
   15 FORMAT(///,3X,'PLEASE ENTER THE CROP NAME ---> ',$)
      READ(*,16) CROP
   16 FORMAT(A10)   
C
      WRITE(*,20)
   20 FORMAT(////////////////////
     2 3X,'THE PROGRAM ASSUMES THAT RAINFALL AND RESULTING RUNOFF ARE',/
     3 3X,'SUFFICIENT TO REMOVE UP TO TEN PERCENT OF THE PESTICIDE   ',/
     4 3X,'FROM THE TEN HECTARE TREATED AGRICULTURAL FIELD         ',///
     5 3X,'THE PORTION OF THE CHEMICAL WHICH IS REMOVED FROM THE FIELD',
     6/
     7 3X,'IN THIS WAY, FLOWS INTO THE POND AND IS DISSOLVED IN THE  ',/
     8 3X,'THE POND WATER                                          ',///
     9 3X,'THE CHEMICAL CONCENTATION IN THE POND REPRESENTS THE PART ',/
     A 3X,'WHICH IS DISSOLVED AND NOT BOUND TO FIELD SOIL OR TO POND ',/
     B 3X,'BOTTOM SEDIMENTS                                      ',/////
     C 3X,'THE FOLLOWING INFORMATION SHOULD BE TAKEN FROM THE MOST   ',/ 
     D 3X,'CURRENT, ACCEPTED LABEL FOR THE USE SITE IN QUESTION     ',//
     E 3X,'PLEASE ENTER APPLICATION RATE (IN POUNDS a.i. PER ACRE) --->
C    F 3X,'NOTE: TO ENTER THE RATE IN KG/HA, PLEASE ENTER ZERO (0) ---> 
     G',$)
C
      READ(*,21) APPRAT
   21 FORMAT(F10.0)
C
      IF(APPRAT.LE.0.0)THEN
        WRITE(*,45)
   45   FORMAT(////////////////////////
     2 3X,'PLEASE ENTER THE APPLICATION RATE (IN KG/HA) ---> ',$)
        READ(*,21) METRAT
        APPRAT = METRAT * 0.890309
      ENDIF  
C
      WRITE(*,22)
   22 FORMAT(///
     2 3X,'ENTER MAXIMUM NUMBER OF APPLICATIONS PERMITTED PER YEAR---> '
     3,$)
C
      READ(*,32) APPNUM
C 
   32 FORMAT(I6)
C
      APPTOT=APPRAT*APPNUM
C
      IF(APPNUM.GT.1)THEN
        WRITE(*,36)
   36   FORMAT(///
     2   3x,'PLEASE ENTER INTERVAL BETWEEN APPLICATIONS (DAYS)---> ',$)
C
        READ(*,32) APSPAC
      ELSE
        APSPAC = 1
      ENDIF  
C
      TDEGF = APPNUM * APSPAC
C     
C  THIS IS CODE TO ASK FOR A Kd VALUE OR A Koc VALUE
C
      WRITE(*,23)
   23 FORMAT(////////////////////
     2 3X,'THE DISSOLVED PESTICIDE CONCENTRATION IN THE POND IS      ',/
     3 3X,'CALCULATED BY SUBTRACTION OF THE PORTION OF THE CHEMICAL  ',/
     4 3X,'WHICH IS BOUND TO FIELD SOIL, TO FIELD ORGANIC MATTER OR  ',/
     5 3X,'TO POND BOTTOM SEDIMENTS                                ',///
     6 3X,'THIS BOUND FRACTION IS ESTIMATED BY THE THE SOIL/WATER    ',/
     7 3X,'EQUILIBRIUM PARTITION COEFFICIENT (Kd) OR BY THE ORGANIC  ',/
     8 3X,'CARBON NORMALIZED SOIL/WATER EQUILIBRIUM PARTITION        ',/
     9 3X,'COEFFICIENT (Koc)                                        ',//
     A 3X,'SEE THE GENEEC PROGRAM USERS MANUAL FOR THE APPROPRIATE Kd',/
     B 3X,'OR Koc VALUE TO USE                                     ',///
     C 3X,'TO USE A Kd VALUE, PLEASE ENTER IT HERE - NOTE: TO USE A  ',/
     D 3X,'Koc VALUE PLEASE ENTER ZERO (0) ---> ',$)
C
      READ(*,21) KD
      KOC = KD * 86.207
      ADSORP = 'B'
C
      IF(KD.LE.0.0)THEN
        WRITE(*,37)
C
   37 FORMAT(////////////////////////
     2 3X,'PLEASE ENTER THE APPROPRIATE Koc VALUE ---> ',$)
        READ(*,21) KOC
        ADSORP = 'A'
        KD = 0.0116 * KOC
      ENDIF  
C
C  SET THE DAY ON WHICH THE RAINFALL/RUNOFF EVENT OCCURS
C  CHANGE NOTE: IN VERSION 2.0 STORM OCCURS TWO DAYS AFTER EITHER A
C  SINGLE OR MULTIPLE APPLICATIONS
C
C      IF(APPNUM.GT.1)THEN
C        STORM=0
C      ELSE 
        STORM=2
C      ENDIF    
C
      WRITE(*,24)
   24 FORMAT(///////////////////////
     2 3X,'THE DISSOLVED PESTICIDE CONCENTRATION IS ALSO REDUCED BY  ',/
     3 3X,'DEGREDATION IN THE FIELD PRIOR TO A RAINFALL/RUNOFF EVENT',//
     4/
     5 3X,'THE PROGRAM ASSUMES DEGRADATION BY AEROBIC METABOLISM BETWEEN
     6',/
     7 3X,'APPLICATIONS AND FOR TWO DAYS AFTER THE FINAL APPLICATION',//
     8//
     9 3X,'(IF STABLE TO AEROBIC SOIL METABOLISM OR IF DATA IS       ',/
     A 3X,'UNAVAILABLE, PLEASE ENTER ZERO (0))                     ',///
     B 3X,'ENTER SOIL AEROBIC METABOLIC HALFLIFE (IN DAYS) ---> ',$)
C
      READ(*,21)METHAF
C
      WRITE(*,25)
   25 FORMAT(////////////////////
     2 3X,'SOME PESTICIDE LABELS REQUIRE THAT THE PESTICIDE BE     ',/
     3 3X,'WETTED-IN EITHER THROUGH RAINFALL OR IRRIGATION AT THE  ',/
     5 3X,'TIME OF APPLICATION                                   ',///
     6 3X,'IN THIS CASE, RUNOFF TO THE POND IS ASSUMED TO OCCUR    ',/
     7 3X,'IMMEDIATELY RATHER THAN AFTER TWO DAYS                 ',//
     8 3X,'IS THIS PESTICIDE TO BE WETTED-IN ?  (Y or N) ---> ',$)
C
      READ(*,26) WETTED
   26 FORMAT(A1)    
C
      IF(WETTED.EQ.'Y'.OR.WETTED.EQ.'y') STORM = 0
C
      WRITE(*,27)
   27 FORMAT(////////////////////////
     2 3X,'THE DISSOLVED PESTICIDE CONCENTRATION MAY BE INCREASED    ',/
     3 3X,'BY DIRECT DEPOSITION OF SPRAY DRIFT INTO THE POND       ',///
     4 3X,'THE PROGRAM ASSUMES A TWO HUNDRED AND EIGHT FOOT WIDE POND',/
     5 3X,'LOCATED DIRECTLY DOWN WIND FROM THE SPRAY APPLICATION   ',///
     6 3X,'THE SPRAY DRIFT PERCENTAGE IS BASED UPON THE WIDTH OF THE NO-
     7',/ 
     8 3X,'SPRAY ZONE AND ON THE SPRAY QUALITY (DROPLET SIZE DISTRIBUTIO
     9N)',/////
     A 3X,'ENTER A, B, C or D TO SELECT METHOD OF APPLICATION:       ',/
     B 3X,'A: AERIAL SPRAY                                           ',/
     C 3X,'B: GROUND SPRAY                                           ',/
     D 3X,'C: AIRBLAST SPRAY (ORCHARD & VINEYARD)                    ',/
     E 3X,'D: GRANULAR (NON-SPRAY) ---> ',$)
C
      READ(*,30)METHOD
   30 FORMAT(A1)
C
C  FOR AERIAL OR GROUND APPLICATION CALL FOR NO-SPRAY ZONE WIDTH AND DROPLET 
C  SIZE DISTRIBUTION OR GROUND SPRAYER TYPE
C
   90   FORMAT(/////////////////////////
     2 3X,'SPRAY DRIFT TO THE POND MAY BE REDUCED BY A NO-SPRAY ZONE ',/
     3 3X,'LOCATED BETWEEN THE TREATED FIELD AND THE WATER BODY    ',///
     4 3X,'THE EFED DEFAULT NO-SPRAY ZONE WIDTH IS ZERO (0) UNLESS   ',/
     5 3X,'REQUIRED BY THE PESTICIDE LABEL                         ',///
     6 3X,'PLEASE ENTER THE WIDTH OF THE NO-SPRAY ZONE (FEET)        ',/
     7 3X,'(IF THE LABEL DOES NOT REQUIRE A NO-SPRAY ZONE, ENTER ZERO) -
     8--> ',$)
C
      IF(METHOD.EQ.'A'.OR.METHOD.EQ.'a')THEN
C
  150   WRITE(*,92)
   92   FORMAT(////////////////////////
     2 3X,'THE DISTRIBUTION OF DROPLET SIZES IN PESTICIDE SPRAY      ',/
     3 3X,'(SPRAY QUALITY) IMPACTS THE DISTANCE OF TRAVEL AND        ',/
     4 3X,'THE QUANTITY OF PESTICIDE WHICH WILL DRIFT OFF-SITE       ',/
     5 3X,'WITH THE WIND                                           ',///
     6 3X,'PLEASE CHOOSE AN AERIAL DROPLET SIZE DISTRIBUTION:       ',//
     7 3X,'A: VERY FINE TO FINE                                      ',/
     8 3X,'B: FINE TO MEDIUM (EFED DEFAULT)                          ',/
     9 3X,'C: MEDIUM TO COARSE                                       ',/
     A 3X,'D: COARSE TO VERY COARSE ---> ',$)
        READ(*,30)AIRFLG
C
        IF(AIRFLG.EQ.'A'.OR.AIRFLG.EQ.'a')THEN
          NASAE = 0
          SPTYPE = 'AERL_A'
        ELSEIF(AIRFLG.EQ.'B'.OR.AIRFLG.EQ.'b')THEN
          NASAE = 1
          SPTYPE = 'AERL_B'
        ELSEIF(AIRFLG.EQ.'C'.OR.AIRFLG.EQ.'c')THEN
          NASAE = 2
          SPTYPE = 'AERL_C'
        ELSEIF(AIRFLG.EQ.'D'.OR.AIRFLG.EQ.'d')THEN
          NASAE = 3
          SPTYPE = 'AERL_D'
        ELSE 
          GO TO 150
        ENDIF  
C
        WRITE(*,90)
        READ(*,91) YLOCEN
   91   FORMAT(F5.0)
        YLOC = YLOCEN * 0.3048
C
        CALL AGASAE(NASAE,YLOC,PONDEP)
C
        DRIFT=(PONDEP/100.0)
        APPEFF=0.95
C        
      ELSEIF(METHOD.EQ.'B'.OR.METHOD.EQ.'b')THEN
C
  151   WRITE(*,93)
   93   FORMAT(////////////////////////
     2 3X,'THE AMOUNT OF OFF-SITE SPRAY DRIFT FROM GROUND APPLICATION',/
     3 3X,'DEPENDS ON THE SPRAYER CONFIGURATION AND THE SPRAY QUALITY',/
     4 3X,'(DROPLET SIZE DISTRIBUTION)                             ',///
     5 3X,'PLEASE ENTER THE NOZZLE HEIGHT ABOVE THE CROP OR GROUND: ',//
     6 3X,'A: LOW BOOM GROUND SPRAYER (20 INCHES OR LESS), or        ',/
     7 3X,'B: HIGH BOOM GROUND SPRAYER (20 TO 50 INCHES: EFED DEFAULT) -
     8--> ',$)
          READ(*,30) GRNFLG
C
        IF(GRNFLG.EQ.'A'.OR.GRNFLG.EQ.'a')THEN
          WRITE(*,95)
   95     FORMAT(////////////
     2 3X,'PLEASE CHOOSE SPRAY QUALITY (DROPLET SIZE DISTRIBUTION):  ',/
     3 3X,'A: FINE (EFED DEFAULT)                                    ',/
     4 3X,'B: MEDIUM-COARSE ---> ',$)
          READ(*,30) GRSIZE        
C
          IF(GRSIZE.EQ.'A'.OR.GRSIZE.EQ.'a')THEN
            NASAE = 4
            SPTYPE = 'GRLOFI'
          ELSEIF(GRSIZE.EQ.'B'.OR.GRSIZE.EQ.'b')THEN
            NASAE = 6
            SPTYPE = 'GRLOME'
          ENDIF
C
        ELSEIF(GRNFLG.EQ.'B'.OR.GRNFLG.EQ.'b')THEN
C
          WRITE(*,95)
          READ(*,30) GRSIZE
C
          IF(GRSIZE.EQ.'A'.OR.GRSIZE.EQ.'a')THEN
            NASAE = 5
            SPTYPE = 'GRHIFI'
          ELSEIF(GRSIZE.EQ.'B'.OR.GRSIZE.EQ.'b')THEN
            NASAE = 7
            SPTYPE = 'GRHIME'
          ENDIF
C          
        ELSE 
          GOTO 151
        ENDIF
C
        WRITE(*,90)
        READ(*,91) YLOCEN
        YLOC = YLOCEN * 0.3048
C
        CALL AGASAE(NASAE,YLOC,PONDEP)
C
        DRIFT = PONDEP/100.0
        APPEFF = 0.99        
C IF 6        
      ELSEIF(METHOD.EQ.'C'.OR.METHOD.EQ.'c')THEN
C
  152   WRITE(*,94)
   94   FORMAT(////////////////////////
     2 3X,'PLEASE ENTER AIRBLAST TYPE (NOTE: BOTH AIRBLAST SELECTIONS',/
     3 3X,'INCLUDE A 3x SAFETY FACTOR):                             ',//
     3 3X,'A: ORCHARDS AND DORMANT VINEYARDS                         ',/
     4 3X,'B: FOLIATED VINEYARDS ---> ',$)
        READ(*,30) ORCFLG
C
C IF 9
        IF(ORCFLG.EQ.'A'.OR.ORCFLG.EQ.'a')THEN
          NASAE = 9
          SPTYPE = 'ORCHAR'
        ELSEIF(ORCFLG.EQ.'B'.OR.ORCFLG.EQ.'b')THEN
          NASAE = 8
          SPTYPE = 'VINYAR'
        ELSE 
          GOTO 152
C IF 9
        ENDIF
C
        WRITE(*,90)
        READ(*,91) YLOCEN
        YLOC = YLOCEN * 0.3048
C
        CALL AGASAE(NASAE,YLOC,PONDEP)
C
        DRIFT = PONDEP/100.0
C
C APPLY A 3x SAFETY FACTOR
C
        DRIFT = DRIFT * 3.0
C                
        APPEFF = 0.99        
C
      ELSEIF(METHOD.EQ.'D'.OR.METHOD.EQ.'d')THEN
        YLOCEN = 0.0
        YLOC = 0.0
        DRIFT = 0.0
        APPEFF = 1.0
        SPTYPE = 'GRANUL'
      ENDIF  
C
      IF(METHOD.EQ.'B'.OR.METHOD.EQ.'b'.OR.METHOD.EQ.'D'.OR.METHOD.EQ.'d
     2')THEN
        WRITE(*,28)
   28   FORMAT(////////////////////
     2 3X,'THE DISSOLVED PESTICIDE CONCENTRATION MAY ALSO BE         ',/
     3 3X,'REDUCED BY INCORPORATION OF THE PESTICIDE AT THE TIME     ',/  
     4 3x,'OF APPLICATION - THE FOLLOWING DEPTHS ARE SUGGESTED:     ',//
     5 3X,'     METHOD OF APPLICATION     INCORPORATION DEPTH (IN)   ',/
     6 3X,'   _________________________   ________________________   ',/
     7 3X,'                                                          ',/    
     8 3X,'          BROADCAST                     0.0               ',/
     9 3X,'  DISKED IN AFTER BROADCAST             4.0               ',/
     A 3X,'CHISEL PLOWED AFTER BROADCAST           6.0               ',/
     B 3X,'        SURFACE BANDED                  0.0               ',/
     C 3X,'    BANDED - INCORPORATED               1.2               ',/
     D 3X,'         T - BANDED                     1.5               ',/
     E 3X,'         IN  FURROW                     2.0               ',/
     F 3X,'  AERIAL or AIRBLAST SPRAY              0.0               ',/
     G 3X,'        GROUND SPRAY             DEPENDS ON METHOD       ',//
     H 3X,'PLEASE ENTER DEPTH OF INCORPORATION (IN INCHES) ---> ',$)
C
        READ(*,21) INCORP
        APFLAG = 0
      ENDIF
C
      WRITE(*,31)
   31 FORMAT(////////////////////////
     2 3X,'THE DISSOLVED PESTICIDE CONCENTRATION IN A WATER          ',/
     3 3X,'BODY CANNOT EXCEED THE SOLUBILITY OF THE CHEMICAL       ',///
     4 3X,'PLEASE ENTER THE SOLUBILITY (IN PPM) ---> ',$)
C
      READ(*,21) SOL     
C
C  CALCULATE THE FRACTION OF PESTICIDE WHICH WILL REMAIN DISSOLVED AFTER
C  ADSORPTION TO SOIL OR TO ORGANIC MATER
C
C  IF(KD.LE.A)
C    KDFRAC = 1.0
C  ELSEIF(KD.LE.B)
C    KDFRAC = C + (D-C) * (B-Kd) / (B-A)      
C
      IF(KD.LE.5.00e-3)THEN
        KDFRAC = 1.0
      ELSEIF(KD.LE.1.00e-2.AND.KD.GT.5.00e-3)THEN
        KDFRAC = 0.9991715 + (1.0 - 0.9991715) * (1.00e-2 - KD) /
     2  (1.00e-2 - 5.00e-3)
      ELSEIF(KD.LE.5.00e-2.AND.KD.GT.1.00e-2)THEN
        KDFRAC = 0.9933720 + (0.9991715 - 0.9933720) * (5.00e-2 - KD) /
     2  (5.00e-2 - 1.00e-2)
      ELSEIF(KD.LE.1.00e-1.AND.KD.GT.5.00e-2)THEN
        KDFRAC = 0.9859155 + (0.9933720 - 0.9859155) * (1.00e-1 - KD) /
     2  (1.00e-1 - 5.00e-2)
      ELSEIF(KD.LE.3.00e-1.AND.KD.GT.1.00e-1)THEN
        KDFRAC = 0.9569180 + (0.9859155 - 0.9569180) * (3.00e-1 - KD) /
     2  (3.00e-1 - 1.00e-1)
      ELSEIF(KD.LE.5.00e-1.AND.KD.GT.3.00e-1)THEN
        KDFRAC = 0.9295775 + (0.9569180 - 0.9295775) * (5.00e-1 - KD) /
     2  (5.00e-1 - 3.00e-1)
      ELSEIF(KD.LE.7.50e-1.AND.KD.GT.5.00e-1)THEN
        KDFRAC = 0.8980944 + (0.9295775 - 0.8980944) * (7.50e-1 - KD) /
     2  (7.50e-1 - 5.00e-1)
      ELSEIF(KD.LE.1.00e00.AND.KD.GT.7.50e-1)THEN
        KDFRAC = 0.8682684 + (0.8980944 - 0.8682684) * (1.00e00 - KD) /
     2  (1.00e00 - 7.50e-1)
      ELSEIF(KD.LE.1.25e00.AND.KD.GT.1.00e00)THEN
        KDFRAC = 0.8409279 + (0.8682684 - 0.8409279) * (1.25e00 - KD) /
     2  (1.25e00 - 1.00e00)
      ELSEIF(KD.LE.1.50e00.AND.KD.GT.1.25e00)THEN
        KDFRAC = 0.8147307 + (0.8409279 - 0.8147307) * (1.50e00 - KD) /
     2  (1.50e00 - 1.25e00)
      ELSEIF(KD.LE.1.75e00.AND.KD.GT.1.50e00)THEN
        KDFRAC = 0.7904060 + (0.8147307 - 0.7904060) * (1.75e00 - KD) /
     2  (1.75e00 - 1.50e00)
      ELSEIF(KD.LE.2.00e00.AND.KD.GT.1.75e00)THEN
        KDFRAC = 0.7675973 + (0.7904060 - 0.7675973) * (2.00e00 - KD) /
     2  (2.00e00 - 1.75e00)
      ELSEIF(KD.LE.2.20e00.AND.KD.GT.2.00e00)THEN
        KDFRAC = 0.7461475 + (0.7675973 - 0.7461475) * (2.25e00 - KD) /
     2  (2.25e00 - 2.00e00)
      ELSEIF(KD.LE.2.50e00.AND.KD.GT.2.25e00)THEN
        KDFRAC = 0.7260066 + (0.7461475 - 0.7260066) * (2.50e00 - KD) /
     2  (2.50e00 - 2.25e00)
      ELSEIF(KD.LE.2.75e00.AND.KD.GT.2.50e00)THEN
        KDFRAC = 0.7070340 + (0.7260066 - 0.7070340) * (2.75e00 - KD) /
     2  (2.75e00 - 2.50e00)
      ELSEIF(KD.LE.3.00e00.AND.KD.GT.2.75e00)THEN
        KDFRAC = 0.6891881 + (0.7070340 - 0.6891881) * (3.00e00 - KD) /
     2  (3.00e00 - 2.75e00)
      ELSEIF(KD.LE.3.50e00.AND.KD.GT.3.00e00)THEN
        KDFRAC = 0.6562883 + (0.6891881 - 0.6562883) * (3.50e00 - KD) /
     2  (3.50e00 - 3.00e00)
      ELSEIF(KD.LE.4.00e00.AND.KD.GT.3.50e00)THEN
        KDFRAC = 0.6269097 + (0.6562883 - 0.6269097) * (4.00e00 - KD) /
     2  (4.00e00 - 3.50e00)
      ELSEIF(KD.LE.4.50e00.AND.KD.GT.4.00e00)THEN
        KDFRAC = 0.6004060 + (0.6269097 - 0.6004060) * (4.50e00 - KD) /
     2  (4.50e00 - 4.00e00)
      ELSEIF(KD.LE.5.00e00.AND.KD.GT.4.50e00)THEN
        KDFRAC = 0.5765700 + (0.6004060 - 0.5765700) * (5.00e00 - KD) /
     2  (5.00e00 - 4.50e00)
      ELSEIF(KD.LE.5.50e00.AND.KD.GT.5.00e00)THEN
        KDFRAC = 0.5548384 + (0.5765700 - 0.5548384) * (5.50e00 - KD) /
     2  (5.50e00 - 5.00e00)
      ELSEIF(KD.LE.6.00e00.AND.KD.GT.5.50e00)THEN
        KDFRAC = 0.5352196 + (0.5548384 - 0.5352196) * (6.00e00 - KD) /
     2  (6.00e00 - 5.50e00)
      ELSEIF(KD.LE.7.00e00.AND.KD.GT.6.00e00)THEN
        KDFRAC = 0.5007954 + (0.5352196 - 0.5007954) * (7.00e00 - KD) /
     2  (7.00e00 - 6.00e00)
      ELSEIF(KD.LE.8.00e00.AND.KD.GT.7.00e00)THEN
        KDFRAC = 0.4717896 + (0.5007954 - 0.4717896) * (8.00e00 - KD) /
     2  (8.00e00 - 7.00e00)
      ELSEIF(KD.LE.9.00e00.AND.KD.GT.8.00e00)THEN
        KDFRAC = 0.4471002 + (0.4717896 - 0.4471002) * (9.00e00 - KD) /
     2  (9.00e00 - 8.00e00)
      ELSEIF(KD.LE.1.00e01.AND.KD.GT.9.00e00)THEN
        KDFRAC = 0.4257415 + (0.4471002 - 0.4257415) * (1.00e01 - KD) /
     2  (1.00e01 - 9.00e00)
      ELSEIF(KD.LE.1.25e01.AND.KD.GT.1.00e01)THEN
        KDFRAC = 0.3837614 + (0.4257415 - 0.3837614) * (1.25e01 - KD) /
     2  (1.25e01 - 1.00e01)
      ELSEIF(KD.LE.1.50e01.AND.KD.GT.1.25e01)THEN
        KDFRAC = 0.3528086 + (0.3837614 - 0.3528086) * (1.50e01 - KD) /
     2  (1.50e01 - 1.25e01)
      ELSEIF(KD.LE.1.75e01.AND.KD.GT.1.50e01)THEN
        KDFRAC = 0.3292129 + (0.3528086 - 0.3292129) * (1.75e01 - KD) /
     2  (1.75e01 - 1.50e01)
      ELSEIF(KD.LE.2.00e01.AND.KD.GT.1.75e01)THEN
        KDFRAC = 0.3107208 + (0.3292129 - 0.3107208) * (2.00e01 - KD) /
     2  (2.00e01 - 1.75e01)
      ELSEIF(KD.LE.2.50e01.AND.KD.GT.2.00e01)THEN
        KDFRAC = 0.2834880 + (0.3107208 - 0.2834880) * (2.50e01 - KD) /
     2  (2.50e01 - 2.00e01)
      ELSEIF(KD.LE.3.00e01.AND.KD.GT.2.50e01)THEN
        KDFRAC = 0.2646396 + (0.2834880 - 0.2646396) * (3.00e01 - KD) /
     2  (3.00e01 - 2.50e01)
      ELSEIF(KD.LE.4.00e01.AND.KD.GT.3.00e01)THEN
        KDFRAC = 0.2400580 + (0.2646396 - 0.2400580) * (4.00e01 - KD) /
     2  (4.00e01 - 3.00e01)
      ELSEIF(KD.LE.5.00e01.AND.KD.GT.4.00e01)THEN
        KDFRAC = 0.2249793 + (0.2400580 - 0.2249793) * (5.00e01 - KD) /
     2  (5.00e01 - 4.00e01)
      ELSEIF(KD.LE.1.00e02.AND.KD.GT.5.00e01)THEN
        KDFRAC = 0.1939188 + (0.2249793 - 0.1939188) * (1.00e02 - KD) /
     2  (1.00e02 - 5.00e01)
      ELSEIF(KD.LE.5.00e02.AND.KD.GT.1.00e02)THEN
        KDFRAC = 0.1788732 + (0.1939188 - 0.1788732) * (5.00e02 - KD) /
     2  (5.00e02 - 1.00e02)
      ELSEIF(KD.LE.1.00e03.AND.KD.GT.5.00e02)THEN
        KDFRAC = 0.1615742 + (0.1788732 - 0.1615742) * (1.00e03 - KD) /
     2  (1.00e03 - 5.00e02)
      ELSEIF(KD.LE.5.00e03.AND.KD.GT.1.00e03)THEN
        KDFRAC = 0.1425352 + (0.1615742 - 0.1425352) * (5.00e03 - KD) /
     2  (5.00e03 - 1.00e03)
      ELSEIF(KD.LE.1.00e04.AND.KD.GT.5.00e03)THEN
        KDFRAC = 0.1258409 + (0.1425352 - 0.1258409) * (1.00e04 - KD) /
     2  (1.00e04 - 5.00e03)
      ELSEIF(KD.LE.2.00e04.AND.KD.GT.1.00e04)THEN
        KDFRAC = 0.1021458 + (0.1258409 - 0.1021458) * (2.00e04 - KD) /
     2  (2.00e04 - 1.00e04)
      ELSEIF(KD.LE.3.00e04.AND.KD.GT.2.00e04)THEN
        KDFRAC = 0.0859983 + (0.1021458 - 0.0859983) * (3.00e04 - KD) /
     2  (3.00e04 - 2.00e04)
      ELSEIF(KD.LE.5.00e04.AND.KD.GT.3.00e04)THEN
        KDFRAC = 0.0653521 + (0.0859983 - 0.0653521) * (5.00e04 - KD) /
     2  (5.00e04 - 3.00e04)
      ELSEIF(KD.LE.1.00e05.AND.KD.GT.5.00e04)THEN
        KDFRAC = 0.0408318 + (0.0653521 - 0.0408318) * (1.00e05 - KD) /
     2  (1.00e05 - 5.00e04)
      ELSEIF(KD.LE.5.00e05.AND.KD.GT.1.00e05)THEN
        KDFRAC = 0.0102055 + (0.0408318 - 0.0102055) * (5.00e05 - KD) /
     2  (5.00e05 - 1.00e05)
      ELSEIF(KD.LE.1.00e06.AND.KD.GT.5.00e05)THEN
        KDFRAC = 0.0052672 + (0.0102055 - 0.0052672) * (1.00e06 - KD) /
     2  (1.00e06 - 5.00e05)
      ELSEIF(KD.GT.1.00e06)THEN
        KDFRAC = 0.001
      ENDIF
C
C  VALUES FOR Kd OVER 1,000,000 NOT USED
C
C     ELSEIF(KD.LE.5.00e06.AND.KD.GT.1.00e06)THEN
C       KDFRAC = 0.0010813 + (0.0052672 - 0.0010813) * (5.00e06 - KD) /
C    2  (5.00e06 - 1.00e06)
C     ELSEIF(KD.LE.1.00e07.AND.KD.GT.5.00e06)THEN
C       KDFRAC = 0.0005425 + (0.0010813 - 0.0005425) * (1.00e07 - KD) /
C    2  (1.00e07 - 5.00e06)
C     ELSEIF(KD.LE.5.00e07.AND.KD.GT.1.00e07)THEN
C       KDFRAC = 0.0001088 + (0.0005425 - 0.0001088) * (5.00e07 - KD) /
C    2  (5.00e07 - 1.00e07)
C     ELSEIF(KD.LE.1.00e08.AND.KD.GT.5.00e07)THEN
C       KDFRAC = 0.0000544 + (0.0001088 - 0.0000544) * (1.00e08 - KD) /
C    2  (1.00e08 - 5.00e07)
C     ELSEIF(KD.LE.5.00e08.AND.KD.GT.1.00e08)THEN
C       KDFRAC = 0.0000109 + (0.0000544 - 0.0000109) * (5.00e08 - KD) /
C    2  (5.00e08 - 1.00e08)
C     ELSEIF(KD.LE.1.00e09.AND.KD.GT.5.00e08)THEN
C       KDFRAC = 0.0000054 + (0.0000109 - 0.0000054) * (1.00e09 - KD) /
C    2  (1.00e09 - 5.00e08)
C     ELSEIF(KD.GT.1.00e09)THEN
C       KDFRAC = 0.0000054
C     ENDIF
C
C  CALCULATE THE AMOUNT OF REDUCTION DUE TO DEGREDATION IN THE FIELD
C
      IF(METHAF.LE.0.0) THEN
        KMETF = 0.0
      ELSE 
        KMETF = LOG(2.0) / METHAF
      ENDIF      
C
C  LIMIT THE AMOUNT OF REDUCTION DUE TO INCORPORATION
C
      IF(INCORP.LE.0.0001) APFLAG = 1
      IF(INCORP.LE.1.0) INCORP = 1.0
      IF(INCORP.GE.6.0) INCORP = 6.0
C
C  SET THE PERCENT RUNOFF FROM THE FIELD AND THE AREA OF THE FIELD
C
      PCTSRO = 0.10
      ROAREA = 10.0
      WBAREA = 1.0
C
C  CALCULATE THE FRACTION OF THE APPLICATION RATE REMAINING IN THE FIELD 
C  ON EACH OF THE SEVEN DAYS AFTER APPLICATION - SHIFT ALLOWS CALCULATION
C  OF A ZERO DAY VALUE
C
      SHIFT = 0
C
      DO 100 I = 1,8
        SHIFT = I-1
        DEGFRF(I) = EXP(-KMETF*SHIFT)
        DEGF1 = DEGFRF(1)
        DEGF2 = DEGFRF(2)
        DEGF3 = DEGFRF(3)
        DEGF4 = DEGFRF(4)
        DEGF5 = DEGFRF(5)
        DEGF6 = DEGFRF(6)
        DEGF7 = DEGFRF(7)
        DEGF8 = DEGFRF(8)
        DEGF9 = DEGFRF(9)
        DEGF10 = DEGFRF(10)
  100 CONTINUE
C
C  INCREASE THE VALUE OF 'STORM' TO FIT THIS SHIFTED VALUE
C 
      STORM = STORM + 1
C      
C  CALCULATE CHRONIC EEC,s 
C        
C  ASK FOR POND DEGRADATION HALFLIVES
C
      WRITE(*,33)
      READ(*,21) METHAP
      IF(METHAP.LE.0.0) THEN
        KMETP = 0.0
        METHAP = 0.00
C
        WRITE(*,34)
        READ(*,21) HYDHAP
C      
        IF(HYDHAP.LE.0.0) THEN
          KHYDP = 0.0
        ELSE  
          KHYDP =LOG(2.0) / HYDHAP
        ENDIF  
      ELSE  
        KMETP = LOG(2.0) / METHAP
      ENDIF  
C        
      WRITE(*,35)
      READ(*,21) FOTHAP
C
      IF(FOTHAP.LE.0.0) THEN
        KFOTP = 0.0
      ELSE  
        KFOTP = (LOG(2.0) / FOTHAP) / 124
      ENDIF  
C               
   33 FORMAT(////////////////////////
     2 3X,'CHRONIC GENERIC EEC VALUES ARE CALCULATED BY SUMMING      ',/
     3 3X,'THE INDIVIDUAL AQUATIC DEGRADATION RATES (THE AEROBIC     ',/
     4 3X,'AQUATIC METABOLIC RATE IS ASSUMED TO INCLUDE HYDROLYSIS)',///
     5 3X,'ENTER ANY OR ALL OF THE FOLLOWING WHICH ARE AVAILABLE:   ',//
     6 3X,'(PLEASE ENTER ZERO (0) FOR ANY WHICH ARE STABLE OR        ',/
     7 3X,'FOR WHICH VALUES ARE UNAVAILABLE)                        ',//
     8 3X,'AEROBIC AQUATIC METABOLIC HALFLIFE - DAYS (IF UNAVAILABLE,',/
     9 3X,'RECOMMENDED EFED DEFAULT IS 2x AEROBIC SOIL INPUT VALUE) --->
     A ',$)
C
   34 FORMAT(///,3x,'PLEASE ENTER pH 7 HYDROLYSIS HALFLIFE (DAYS) ---> '
     2,$)
C
   35 FORMAT(///,3x,'PLEASE ENTER PHOTOLYSIS HALFLIFE (DAYS) ---> ',$)
C
C  CALCULATE THE OVERALL DEGRADATION RATE IN THE POND
C
      KDEGP = KHYDP + KFOTP + KMETP
      IF(KDEGP.LE.0.0) THEN
        DEGHAP = 0.00
      ELSE  
        DEGHAP =LOG(2.0) / KDEGP
      ENDIF
C
C  CALIBRATE FOR PRZM/EXAMS RESULTS
C
      KDEGP = 0.55 * KDEGP
C
C  ZERO OUT PESTICIDE MASS LEFT FROM PREVIOUS RUNS
C
      DO 80 I = 1 , 600
          PSTMSF(I) = 0.0
   80 CONTINUE
C
      DO 81 I = 1 , 600
          PSTMSP(I) = 0.0
   81 CONTINUE
C
C  SET THE INITIAL PESTICIDE IN THE FIELD AT THE TIME OF APPLICATION TO
C  THE APPLICATION RATE
C
      I = 1
      PSTMSF(1) = APPRAT
C
C  SET THE INITIAL PESTICIDE IN THE POND AT THE TIME OF APPLICATION TO
C  THE APPLICATION RATE
C
      I = 1
      PSTMSP(1) = APPRAT
C
C  SET OVERALL FIELD DEGRADATION RATE TO SOIL METABOLISM RATE
C
      IF(METHAF.LE.0.0) THEN
        KDEGF = 0.0
      ELSE  
        KDEGF = LOG(2.0) / METHAF
      ENDIF
C
C  CALCULATE THE AMOUNT OF PESTICIDE IN THE FIELD ON EACH APPLICATION DATE
C
      DO 85 I = 2 , APPNUM
        PSTMSF(I) = PSTMSF(I-1) * EXP(-KDEGF*APSPAC) + APPRAT
        CHECK1 = PSTMSF(1)
        CHECK2 = PSTMSF(2)
        CHECK3 = PSTMSF(3)
        CHECK4 = PSTMSF(4)
        CHECK5 = PSTMSF(5)
        CHECK6 = PSTMSF(6)
        CHECK7 = PSTMSF(7)
   85 CONTINUE
C
C  CALCULATE THE AMOUNT OF PESTICIDE IN THE POND ON EACH APPLICATION DATE
C
      DO 86 I = 2 , APPNUM
        PSTMSP(I) = PSTMSP(I-1) * EXP(-KDEGP*APSPAC) + APPRAT
   86 CONTINUE
C
C  CALCULATE THE DISSOLVED CONCENTRATION DUE TO SPRAY DRIFT
C
C  CALCULATE RATE OF ADSORPTION TO SEDIMENT ON DAY 1 AND THE INITIAL 
C  DISSOLVED CONCENTRATION RESULTING FROM SPRAY DRIFT ALONE
C
      KADS1 = (9.2529+1.751*KOC) / (1.341E6+KOC)
C
C  CALIBRATE FOR PRZM/EXAMS RESULTS
C 
      KADS1 = 0.12 * KADS1 
C
      SDINIT = (1.123206*PSTMSP(APPNUM) * DRIFT * WBAREA * EXP(-KADS1)) 
     2         / 20
      LOOK1 = PSTMSP(APPNUM)
      LOOK2 = EXP(-KADS1)
C
C  CALCULATE THE ULTIMATE RATE OF ADSORPTION OF PESTICIDE IN SPRAY 
C  DRIFT TO SEDIMENT
C
      KADSUS = (9366.5+12.4*KOC) / (655000+KOC)
C
C  CALIBRATE FOR PRZM/EXAMS RESULTS
C 
      KADSUS = 0.12 * KADSUS 
C
C  CALCULATE THE DAILY FRACTION OF PESTICIDE IN SPRAY DRIFT WHICH IS 
C  ADSORBED
C
      DO 105 I = 1,100
        ADSFRS(I) = EXP(-KADSUS*I)
  105 CONTINUE      
C
C  CALCULATE THE FINAL DISSOLVED CONCENTRATION DUE TO SPRAY DRIFT LOAD 
C
      SDFIN = 1.123206 * PSTMSP(APPNUM) * DRIFT * ((37.0388+9E-6*KOC) /
     2        (750+KOC))
C
C  CALCULATE THE DAILY DISSOLVED CONCENTRATION IN THE POND DUE TO SPRAY 
C  DRIFT
C
      DO 110 I = 1,99 
        SDCONC(I) = (SDFIN + ADSFRS(I) * (SDINIT-SDFIN)) * EXP(-KDEGP*I)
        SCON1 = SDCONC(1)
        SCON2 = SDCONC(2)
        SCON3 = SDCONC(3)
        SCON4 = SDCONC(4)
        SCON5 = SDCONC(5)
        SCON6 = SDCONC(6)
        SCON7 = SDCONC(7)
        SCON8 = SDCONC(8)
        SCON9 = SDCONC(9)
        SCON10 = SDCONC(10)
  110 CONTINUE
C
C  CALCULATE THE INITIAL DISSOLVED CONCENTRATION IN THE POND DUE TO THE 
C  RUNOFF EVENT AND THE RESULTING DAILY DISSOLVED CONCENTRATION VALUES
C
      ROINIT = (1.123206 * PSTMSF(APPNUM) * APPEFF * ROAREA * PCTSRO *
     2   KDFRAC * DEGFRF(STORM) / INCORP) / 20
C
C  CALCULATE THE ULTIMATE RATE OF ADSORPTION OF PESTICIDE IN RUNOFF TO 
C  SEDIMENT
C
      KADSUR = (5742.9+7.6*KOC) / (405000+KOC)
C
C  CALIBRATE FOR PRZM/EXAMS RESULTS
C 
      KADSUR = 0.12 * KADSUR 
C
C  CALCULATE THE DAILY FRACTION OF PESTICIDE IN RUNOFF WHICH IS ADSORBED
C
      DO 205 I = 1,100
        ADSFRR(I) = EXP(-KADSUR*I)
  205 CONTINUE      
C
C  CALCULATE THE FINAL DISSOLVED CONCENTRATION DUE TO RUNOFF LOAD - 6.262
C  IS RUNOFF LOAD IN PRZM-EXAMS SIMULATION
C
      ROFIN = 1.123206 * PSTMSF(APPNUM) * APPEFF * PCTSRO * ROAREA * 
     2      DEGFRF(STORM) * ((157.845+4.3E-6*KOC**1.215) /
     3      (510+KOC**1.215)) / INCORP / 6.262
C
C  CALCULATE THE DAILY DISSOLVED CONCENTRATION IN THE POND DUE TO RUNOFF
C
      DO 210 I=1,100 
        ROCONC(I) = (ROFIN+ADSFRR(I) * (ROINIT-ROFIN)) * EXP(-KDEGP*I)
        ROCO1 = ROCONC(1)
        ROCO2 = ROCONC(2)
        ROCO3 = ROCONC(3)
        ROCO4 = ROCONC(4)
        ROCO5 = ROCONC(5)
        ROCO6 = ROCONC(6)
        ROCO7 = ROCONC(7)
        ROCO8 = ROCONC(8)
        ROCO9 = ROCONC(9)
        ROCO10 = ROCONC(10)
  210 CONTINUE
C
C  CALCULATE TOTAL DAILY DISSOLVED CONCENTRATION VALUES BY SUMMING THE
C  DISSOLVED CONCENTRATION DUE TO RUNOFF AND THE CONCENTRATION DUE TO SPRAY 
C  DRIFT (IF APPLICABLE)
C
      IF(METHOD.EQ.'A'.OR.METHOD.EQ.'a'.OR.METHOD.EQ.'B'.OR.
     2 METHOD.EQ.'b'.OR.METHOD.EQ.'C'.OR.METHOD.EQ.'c')THEN
        CONC0 = ROINIT + SDCONC(STORM)
        DO 215 I = 1,99
          CHRONIC(I) = ROCONC(I) + SDCONC(I+STORM-1)  
  215   CONTINUE 
C
      ELSEIF(METHOD.EQ.'D'.OR.METHOD.EQ.'d')THEN
        CONC0 = ROINIT
        DO 220 I = 1,99
          CHRONIC(I) = ROCONC(I)  
  220   CONTINUE
      ENDIF  
C
      SUM4 = 0.0
      SUM21 = 0.0
      SUM60 = 0.0
      SUM90 = 0.0
C
C  CALCULATE THE 96 HOUR AVERAGE GEEC
C
      DO 225 I = 1,3
        SUM4 = SUM4 + CHRONIC(I)
  225 CONTINUE
      CONC4 = (CONC0 + SUM4) / 4
C
C  CALCULATE THE 21 DAY AVERAGE GEEC
C
      DO 230 I = 1,20
        SUM21 = SUM21 + CHRONIC(I)
  230 CONTINUE
C  
      CONC21 = (CONC0 + SUM21) / 21
C     
C  CALCULATE THE 60 DAY AVERAGE GEEC
C
      DO 240 I=1,59
        SUM60 = SUM60 + CHRONIC(I)
  240 CONTINUE
      CONC60 = (CONC0 + SUM60) / 60
C
C  CALCULATE THE 90 DAY AVERAGE GEEC
C
      DO 250 I=1,89
        SUM90 = SUM90 + CHRONIC(I)
  250 CONTINUE
C  
      CONC90 = (CONC0 + SUM90) / 90
C     
C     BE SURE THE FINAL DISSOLVED CONCENTRATION DOES NOT EXCEED THE 
C     SOLUBILITY OF THE CHEMICAL
C
C  CALIBRATE TO PRZM/EXAMS RESULTS
C
      IF(KD.GE.10.0) THEN
        CONC0 = CONC0 / LOG10(KD)
        CONC4 = CONC4 / LOG10(KD)
        CONC21 = CONC21 / LOG10(KD)
        CONC60 = CONC60 / LOG10(KD)
        CONC90 = CONC90 / LOG10(KD)
      ENDIF  
C
      IF(CONC0.GE.SOL) CONC0 = SOL
      IF(CONC4.GE.SOL) CONC4 = SOL
      IF(CONC21.GE.SOL) CONC21 = SOL
      IF(CONC60.GE.SOL) CONC60 = SOL
      IF(CONC90.GE.SOL) CONC90 = SOL
C
C     CALCULATE THE UNITS OF THE ANSWER
C
      IF(CONC0.GE.1.0)THEN
C        UNITS='PPM'
        UNITS = 'MILLIGRAMS/LITER (PPM)'
      ENDIF
C
      IF(CONC0.LT.1.0.AND.CONC0.GE.0.001)THEN        
        CONC0 =CONC0 * 1000
        CONC4 = CONC4 * 1000
        CONC21 = CONC21 * 1000
        CONC60 = CONC60 * 1000
        CONC90 = CONC90 * 1000
C        UNITS = 'PPB'
        UNITS = 'MICROGRAMS/LITER (PPB)'
      ENDIF
C        
      IF(CONC0.LT.0.001)THEN
        CONC0 = CONC0 * 1000000
        CONC4 = CONC4 * 1000000
        CONC21 = CONC21 * 1000000
        CONC60 = CONC60 * 1000000
        CONC90 = CONC90 * 1000000
C        UNITS = 'PPTr'
        UNITS = 'NANOGRAMS/LITER (PPTr)'
      ENDIF
C
      IF(SOL.GE.1.0)THEN
        SOLUNITS='PPM'
      ENDIF
C
      IF(SOL.LT.1.0.AND.SOL.GE.0.001) THEN
        SOL = SOL * 1000
        SOLUNITS = 'PPB'
      ENDIF
C        
      IF(SOL.LT.0.001) THEN
        SOL = SOL * 1000000
        SOLUNITS = 'PPTr'
      ENDIF
C
C  WRITE OUTPUT TO THE SCREEN AND TO THE OUTPUT FILE
C
      IF(ADSORP.EQ.'A'.OR.ADSORP.EQ.'a')THEN
C
        WRITE(*,50)CODE,CHMNAM,CROP,SOLUNITS
        WRITE(6,50)CODE,CHMNAM,CROP,SOLUNITS
   50 FORMAT(//,3X,'RUN No.',I4,' FOR ',A16,' ON ',A12,'    * INPUT VALU
     2ES * ',/
     3 3X,'-------------------------------------------------------------
     4-------',/
     5 3X,' RATE (#/AC)   No.APPS &   SOIL  SOLUBIL   APPL TYPE NO-SPRAY
     6 INCORP',/
     7 3X,'  ONE(MULT)    INTERVAL    Koc   (',A4,')    (%DRIFT)   (FT)
     8    (IN)',/
     9 3X,'-------------------------------------------------------------
     A-------')
C
        IF(APFLAG.EQ.1) INCORP = 0.0
C
        WRITE(*,51)APPRAT,'(',PSTMSF(APPNUM),')',APPNUM,APSPAC,KOC,SOL,
     2           SPTYPE,'(',DRIFT*100,')',YLOCEN,INCORP
        WRITE(6,51)APPRAT,'(',PSTMSF(APPNUM),')',APPNUM,APSPAC,KOC,SOL,
     2           SPTYPE,'(',DRIFT*100,')',YLOCEN,INCORP
   51 FORMAT(F7.3,A1,F7.3,A1,1X,I3,1X,I3,F10.1,F7.1,3X,A6,A1,F5.1,A1,
     2       2X,F5.1,2X,F4.1)
C
      ELSEIF(ADSORP.EQ.'B'.OR.ADSORP.EQ.'b')THEN        
C
        WRITE(*,57)CODE,CHMNAM,CROP,SOLUNITS
        WRITE(6,57)CODE,CHMNAM,CROP,SOLUNITS
C       
   57 FORMAT(//,3X,'RUN No.',I4,' FOR ',A16,' ON ',A12,'    * INPUT VALU
     2ES * ',/
     3 3X,'-------------------------------------------------------------
     4-------',/
     5 3X,'RATE (#/AC)   No.APPS &   SOIL  SOLUBIL   APPL TYPE  NO-SPRAY
     6 INCORP',/
     7 3X,' ONE(MULT)    INTERVAL     Kd   (',A4,')    (%DRIFT)   ZONE(F
     8T)  (IN)',/
     9 3X,'-------------------------------------------------------------
     A-------')
C
        IF(APFLAG.EQ.1) INCORP = 0.0
C
        WRITE(*,58)APPRAT,'(',PSTMSF(APPNUM),')',APPNUM,APSPAC,KD,SOL,
     2           SPTYPE,'(',DRIFT*100,')',YLOCEN,INCORP
        WRITE(6,58)APPRAT,'(',PSTMSF(APPNUM),')',APPNUM,APSPAC,KD,SOL,
     2           SPTYPE,'(',DRIFT*100,')',YLOCEN,INCORP
   58 FORMAT(F7.3,A1,F7.3,A1,1X,I3,1X,I3,F10.1,F7.1,3X,A6,A1,F5.1,A1,
     2       1X,F5.1,2X,F4.1)
C
      ENDIF
C
      IF(HYDHAP.LE.0.0)THEN
        WRITE(6,60)
        WRITE(*,60)
        WRITE(6,61)METHAF,STORM-1,'N/A ',FOTHAP,'-',FOTHAP*124,METHAP,
     2             DEGHAP
        WRITE(*,61)METHAF,STORM-1,'N/A ',FOTHAP,'-',FOTHAP*124,METHAP,
     2             DEGHAP
      ELSE
        WRITE(6,60)
        WRITE(*,60)
        WRITE(6,62)METHAF,STORM-1,HYDHAP,FOTHAP,'-',FOTHAP*124,METHAP,
     2             DEGHAP
        WRITE(*,62)METHAF,STORM-1,HYDHAP,FOTHAP,'-',FOTHAP*124,METHAP,
     2             DEGHAP
      ENDIF
C
   60 FORMAT(//,1X,'  FIELD AND STANDARD POND HALFLIFE VALUES (DAYS) ',/
     1   3X,'-----------------------------------------------------------
     2---------',/
     3   3X,'METABOLIC  DAYS UNTIL  HYDROLYSIS   PHOTOLYSIS   METABOLIC 
     4 COMBINED',/
     5   3X,' (FIELD)   RAIN/RUNOFF   (POND)     (POND-EFF)    (POND)   
     6  (POND) ',/
     7   3X,'-----------------------------------------------------------
     8---------')
C
   61 FORMAT(3X,F7.2,7X,I2,7X,A7,3X,F6.2,A1,F8.2,3X,F6.2,3X,F7.2)
C
   62 FORMAT(3X,F7.2,7X,I2,8X,F7.2,2X,F6.2,A1,F8.2,2X,F6.2,4X,F7.2)
C      
      WRITE(6,70)UNITS
      WRITE(*,70)UNITS
      WRITE(6,71)CONC0,CONC4,CONC21,CONC60,CONC90
      WRITE(*,71)CONC0,CONC4,CONC21,CONC60,CONC90
C
   70 FORMAT(//,1X,'  GENERIC EECs (IN ',A22,')     Version 2.0 Aug 1, 2
     2001',/
     3 3X,'-------------------------------------------------------------
     4-------',/
     5 3X,'    PEAK      MAX 4 DAY     MAX 21 DAY    MAX 60 DAY    MAX 9
     60 DAY',/
     7 3X,'    GEEC      AVG GEEC       AVG GEEC      AVG GEEC      AVG 
     8GEEC',/
     9 3X,'-------------------------------------------------------------
     A-------')
C
   71 FORMAT(5X,F7.2,5X,F7.2,7X,F7.2,7X,F7.2,7X,F7.2)
C
      WRITE(*,53)
   53 FORMAT(/,3X,'DO YOU WANT TO DO ANOTHER RUN (Y OR N) ---> ',$)
      READ(*,30) AGAIN 
C
      IF(AGAIN.EQ.'Y'.OR.AGAIN.EQ.'y')THEN
        WRITE(*,54)
   54   FORMAT(///3X,'PLEASE ENTER A NEW RUN NUMBER ---> ',$)
        READ(*,*) CODE
        APPRAT = 0
        APPNUM = 0
        APPTOT = 0
        KD = 0
        KOC = 0
        KDFRAC = 0
        CORECT = 0
        SOL = 0
        METHAF = 0
        METHAP = 0
        HYDHAP = 0
        FOTHAP = 0
        DEGHAP = 0
        INCORP = 0
        PCTSRO = 0
        ROAREA = 0
        ROINIT = 0 
        ROFIN = 0
        SDINIT = 0
        SDFIN = 0
        SHIFT = 0
        STORM = 0
        KADS1 = 0
        KADSUR = 0
        KADSUS = 0
        KDEGP = 0
        KMETF = 0
        KHYDP = 0
        KMETP = 0
        KFOTP = 0
        CONC0 = 0
        CONC4 = 0
        CONC21 = 0
        CONC60 = 0
        CONC90 = 0
        SUM4 = 0
        SUM21 = 0
        SUM60 = 0
        SUM90 = 0
C
        DO 1000 K=1,99
          ROCONC(K) = 0
          SDCONC(K) = 0
          CHRONIC(K) = 0
 1000   CONTINUE       
C
        DO 1001 K = 1,100
          ADSFRR(K) = 0
          ADSFRS(K) = 0
 1001   CONTINUE       
C
        DO 1002 K = 1,8
          DEGFRF(K) = 0
 1002   CONTINUE       
C
        I = 0
        K = 0
C
        GOTO 99
      ENDIF  
C
      COLOFF = CHAR(27)//'[0m'
      WRITE(*,2) COLOFF
      WRITE(*,2) CLEAR
C      
      STOP
      END      
C
C     SUBROUTINE AGBCPC(NBCPC,YLOC,PONDEP)
C
C**AGASAE
C  Continuum Dynamics, Inc.
C  Version 4.0 06/19/00
C
      SUBROUTINE AGASAE(NASAE,YLOC,PONDEP)
C
C  AGASAE returns the pond-integrated deposition level
C
C  INPUT:
C  NASAE  - AgDRIFT result: 0 = aerial very fine to fine
C                           1 = aerial fine to medium
C                           2 = aerial medium to coarse
C                           3 = aerial coarse to very coarse
C                           4 = ground sprayer low boom fine
C                           5 = ground sprayer high boom fine
C                           6 = ground sprayer low boom medium-coarse
C                           7 = ground sprayer high boom medium-coarse
C                           8 = vineyard
C                           9 = orchard
C  YLOC   - Distance from edge of field to pond (m)
C
C  OUTPUT:
C  PONDEP - Pond-integrated deposition for a standard EPA pond
C           beginning at YLOC and extending 63.6 m away from the
C           spray block, in % Applied
C
      DIMENSION X0(153),X1(153),X2(153),X3(153),X4(153),X5(153)
      DIMENSION X6(153),X7(153),X8(153),X9(153),XV(153,10)
C
      EQUIVALENCE (X0(1),XV(1,1)),(X1(1),XV(1,2)),(X2(1),XV(1,3))
      EQUIVALENCE (X3(1),XV(1,4)),(X4(1),XV(1,5)),(X5(1),XV(1,6))
      EQUIVALENCE (X6(1),XV(1,7)),(X7(1),XV(1,8)),(X8(1),XV(1,9))
      EQUIVALENCE (X9(1),XV(1,10))
C
      DATA X0 /
     $  24.1087, 23.0052, 22.0199, 21.1251, 20.3037, 19.5370, 18.8120,
     $  18.1255, 17.4778, 16.8699, 16.3036, 15.7771, 15.2845, 14.8218,
     $  14.3861, 13.9741, 13.5811, 13.2046, 12.8461, 12.5081, 12.1911,
     $  11.8934, 11.6117, 11.3433, 11.0870, 10.8427, 10.6099, 10.3879,
     $  10.1774,  9.9792,  9.7921,  9.6141,  9.4434,  9.2784,  9.1195,
     $   8.9671,  8.8211,  8.6811,  8.5475,  8.4198,  8.2968,  8.1778,
     $   8.0622,  7.9497,  7.8408,  7.7360,  7.6354,  7.5393,  7.4472,
     $   7.3584,  7.2722,  7.1882,  7.1064,  7.0271,  6.9505,  6.8766,
     $   6.8052,  6.7363,  6.6692,  6.6036,  6.5391,  6.4756,  6.4134,
     $   6.3528,  6.2937,  6.2363,  6.1806,  6.1261,  6.0727,  6.0200,
     $   5.9676,  5.9159,  5.8653,  5.8161,  5.7684,  5.7222,  5.6769,
     $   5.6324,  5.5883,  5.5439,  5.4993,  5.4553,  5.4124,  5.3711,
     $   5.3312,  5.2920,  5.2534,  5.2154,  5.1778,  5.1404,  5.1033,
     $   5.0671,  5.0321,  4.9982,  4.9647,  4.9312,  4.8983,  4.8660,
     $   4.8340,  4.8022,  4.7706,  4.7400,  4.7102,  4.6807,  4.6513,
     $   4.6223,  4.5938,  4.5656,  4.5374,  4.5094,  4.4821,  4.4559,
     $   4.4301,  4.4044,  4.3790,  4.3537,  4.3286,  4.3036,  4.2789,
     $   4.2547,  4.2309,  4.2073,  4.1840,  4.1609,  4.1381,  4.1157,
     $   4.0936,  4.0718,  4.0502,  4.0288,  4.0076,  3.9866,  3.9659,
     $   3.9455,  3.9254,  3.9055,  3.8860,  3.8666,  3.8473,  3.8283,
     $   3.8094,  3.7908,  3.7724,  3.7543,  3.7364,  3.7188,  3.7013,
     $   3.6839,  3.6667,  3.6496,  3.6327,  3.6160,  3.5996 /
C
      DATA X1 /
     $  12.9565, 11.6976, 10.7250,  9.9284,  9.2564,  8.6758,  8.1579,
     $   7.6828,  7.2376,  6.8193,  6.4343,  6.0883,  5.7788,  5.4992,
     $   5.2422,  5.0067,  4.7928,  4.5965,  4.4152,  4.2464,  4.0885,
     $   3.9416,  3.8053,  3.6786,  3.5614,  3.4534,  3.3534,  3.2602,
     $   3.1730,  3.0908,  3.0125,  2.9383,  2.8686,  2.8025,  2.7395,
     $   2.6791,  2.6214,  2.5665,  2.5141,  2.4641,  2.4163,  2.3706,
     $   2.3267,  2.2846,  2.2443,  2.2056,  2.1688,  2.1336,  2.1000,
     $   2.0678,  2.0370,  2.0074,  1.9790,  1.9517,  1.9255,  1.9003,
     $   1.8760,  1.8527,  1.8301,  1.8084,  1.7874,  1.7670,  1.7473,
     $   1.7282,  1.7097,  1.6918,  1.6744,  1.6576,  1.6412,  1.6252,
     $   1.6097,  1.5945,  1.5797,  1.5653,  1.5513,  1.5375,  1.5241,
     $   1.5109,  1.4980,  1.4853,  1.4729,  1.4607,  1.4487,  1.4370,
     $   1.4255,  1.4141,  1.4030,  1.3920,  1.3812,  1.3706,  1.3602,
     $   1.3500,  1.3399,  1.3300,  1.3203,  1.3107,  1.3012,  1.2919,
     $   1.2827,  1.2737,  1.2648,  1.2560,  1.2474,  1.2390,  1.2306,
     $   1.2223,  1.2142,  1.2062,  1.1983,  1.1906,  1.1830,  1.1756,
     $   1.1682,  1.1609,  1.1537,  1.1466,  1.1396,  1.1328,  1.1260,
     $   1.1193,  1.1127,  1.1061,  1.0996,  1.0932,  1.0868,  1.0805,
     $   1.0742,  1.0681,  1.0620,  1.0560,  1.0501,  1.0443,  1.0385,
     $   1.0327,  1.0270,  1.0214,  1.0158,  1.0103,  1.0049,  0.9996,
     $   0.9943,  0.9890,  0.9838,  0.9786,  0.9734,  0.9684,  0.9633,
     $   0.9584,  0.9534,  0.9485,  0.9436,  0.9388,  0.9339 /
C
      DATA X2 /
     $   9.1624,  7.8767,  6.9513,  6.2564,  5.7050,  5.2531,  4.8692,
     $   4.5300,  4.2203,  3.9311,  3.6628,  3.4225,  3.2145,  3.0354,
     $   2.8769,  2.7324,  2.5989,  2.4759,  2.3632,  2.2597,  2.1654,
     $   2.0800,  2.0018,  1.9286,  1.8593,  1.7936,  1.7315,  1.6731,
     $   1.6187,  1.5682,  1.5210,  1.4767,  1.4349,  1.3952,  1.3576,
     $   1.3219,  1.2883,  1.2567,  1.2267,  1.1983,  1.1713,  1.1457,
     $   1.1213,  1.0981,  1.0760,  1.0551,  1.0351,  1.0160,  0.9978,
     $   0.9803,  0.9635,  0.9473,  0.9318,  0.9168,  0.9025,  0.8887,
     $   0.8754,  0.8626,  0.8503,  0.8384,  0.8269,  0.8158,  0.8050,
     $   0.7946,  0.7846,  0.7749,  0.7656,  0.7565,  0.7477,  0.7391,
     $   0.7308,  0.7226,  0.7147,  0.7071,  0.6996,  0.6923,  0.6852,
     $   0.6782,  0.6714,  0.6646,  0.6580,  0.6516,  0.6452,  0.6390,
     $   0.6330,  0.6270,  0.6212,  0.6154,  0.6097,  0.6041,  0.5986,
     $   0.5932,  0.5880,  0.5828,  0.5777,  0.5727,  0.5677,  0.5628,
     $   0.5580,  0.5533,  0.5486,  0.5440,  0.5396,  0.5352,  0.5308,
     $   0.5265,  0.5223,  0.5181,  0.5140,  0.5100,  0.5061,  0.5023,
     $   0.4985,  0.4948,  0.4911,  0.4875,  0.4839,  0.4804,  0.4770,
     $   0.4736,  0.4703,  0.4670,  0.4637,  0.4605,  0.4573,  0.4541,
     $   0.4510,  0.4480,  0.4449,  0.4420,  0.4390,  0.4361,  0.4333,
     $   0.4304,  0.4276,  0.4249,  0.4221,  0.4195,  0.4169,  0.4143,
     $   0.4117,  0.4091,  0.4066,  0.4041,  0.4017,  0.3992,  0.3968,
     $   0.3945,  0.3922,  0.3899,  0.3876,  0.3853,  0.3830 /
C
      DATA X3 /
     $   7.1216,  5.8417,  4.9591,  4.3198,  3.8360,  3.4540,  3.1474,
     $   2.8969,  2.6828,  2.4911,  2.3152,  2.1551,  2.0131,  1.8902,
     $   1.7827,  1.6860,  1.5973,  1.5154,  1.4404,  1.3717,  1.3089,
     $   1.2515,  1.1987,  1.1497,  1.1041,  1.0619,  1.0226,  0.9860,
     $   0.9521,  0.9206,  0.8913,  0.8642,  0.8390,  0.8156,  0.7937,
     $   0.7733,  0.7542,  0.7362,  0.7194,  0.7035,  0.6886,  0.6745,
     $   0.6612,  0.6486,  0.6367,  0.6254,  0.6147,  0.6045,  0.5947,
     $   0.5854,  0.5765,  0.5679,  0.5596,  0.5517,  0.5440,  0.5367,
     $   0.5295,  0.5226,  0.5159,  0.5094,  0.5032,  0.4971,  0.4912,
     $   0.4855,  0.4799,  0.4744,  0.4690,  0.4638,  0.4587,  0.4537,
     $   0.4488,  0.4440,  0.4393,  0.4347,  0.4302,  0.4257,  0.4213,
     $   0.4170,  0.4128,  0.4086,  0.4045,  0.4005,  0.3965,  0.3926,
     $   0.3888,  0.3850,  0.3813,  0.3776,  0.3740,  0.3705,  0.3670,
     $   0.3635,  0.3601,  0.3568,  0.3535,  0.3502,  0.3470,  0.3439,
     $   0.3408,  0.3377,  0.3347,  0.3318,  0.3289,  0.3260,  0.3232,
     $   0.3205,  0.3177,  0.3151,  0.3125,  0.3099,  0.3074,  0.3049,
     $   0.3025,  0.3001,  0.2978,  0.2955,  0.2932,  0.2910,  0.2888,
     $   0.2867,  0.2846,  0.2825,  0.2805,  0.2784,  0.2764,  0.2745,
     $   0.2725,  0.2706,  0.2688,  0.2669,  0.2651,  0.2633,  0.2615,
     $   0.2598,  0.2580,  0.2563,  0.2546,  0.2530,  0.2514,  0.2498,
     $   0.2482,  0.2466,  0.2451,  0.2435,  0.2420,  0.2405,  0.2390,
     $   0.2376,  0.2361,  0.2347,  0.2333,  0.2319,  0.2305 /
C
      DATA X4 /
     $   2.8606,  1.5995,  1.2498,  1.0650,  0.9471,  0.8619,  0.7959,
     $   0.7423,  0.6973,  0.6588,  0.6251,  0.5954,  0.5687,  0.5447,
     $   0.5229,  0.5029,  0.4845,  0.4676,  0.4518,  0.4371,  0.4234,
     $   0.4106,  0.3985,  0.3872,  0.3764,  0.3663,  0.3567,  0.3475,
     $   0.3389,  0.3306,  0.3227,  0.3152,  0.3080,  0.3011,  0.2945,
     $   0.2882,  0.2821,  0.2763,  0.2706,  0.2652,  0.2600,  0.2550,
     $   0.2502,  0.2455,  0.2410,  0.2366,  0.2324,  0.2283,  0.2244,
     $   0.2205,  0.2168,  0.2132,  0.2097,  0.2063,  0.2030,  0.1998,
     $   0.1967,  0.1937,  0.1907,  0.1878,  0.1850,  0.1823,  0.1797,
     $   0.1771,  0.1746,  0.1721,  0.1697,  0.1674,  0.1651,  0.1629,
     $   0.1607,  0.1586,  0.1565,  0.1545,  0.1525,  0.1506,  0.1487,
     $   0.1468,  0.1450,  0.1432,  0.1415,  0.1398,  0.1381,  0.1365,
     $   0.1349,  0.1333,  0.1318,  0.1303,  0.1288,  0.1274,  0.1260,
     $   0.1246,  0.1232,  0.1219,  0.1205,  0.1192,  0.1180,  0.1167,
     $   0.1155,  0.1143,  0.1131,  0.1120,  0.1108,  0.1097,  0.1086,
     $   0.1075,  0.1065,  0.1054,  0.1044,  0.1034,  0.1024,  0.1014,
     $   0.1004,  0.0995,  0.0986,  0.0976,  0.0967,  0.0958,  0.0950,
     $   0.0941,  0.0933,  0.0924,  0.0916,  0.0908,  0.0900,  0.0892,
     $   0.0884,  0.0877,  0.0869,  0.0862,  0.0854,  0.0847,  0.0840,
     $   0.0833,  0.0826,  0.0819,  0.0812,  0.0806,  0.0799,  0.0793,
     $   0.0786,  0.0780,  0.0774,  0.0768,  0.0762,  0.0756,  0.0750,
     $   0.0744,  0.0738,  0.0733,  0.0727,  0.0722,  0.0716 /
C
      DATA X5 /
     $   6.5841,  4.5102,  3.5507,  2.9838,  2.6109,  2.3424,  2.1356,
     $   1.9687,  1.8297,  1.7112,  1.6084,  1.5180,  1.4375,  1.3653,
     $   1.3000,  1.2406,  1.1862,  1.1362,  1.0900,  1.0472,  1.0073,
     $   0.9702,  0.9354,  0.9028,  0.8722,  0.8433,  0.8161,  0.7903,
     $   0.7659,  0.7428,  0.7208,  0.6999,  0.6800,  0.6611,  0.6430,
     $   0.6257,  0.6092,  0.5933,  0.5782,  0.5636,  0.5497,  0.5363,
     $   0.5234,  0.5110,  0.4990,  0.4876,  0.4765,  0.4658,  0.4555,
     $   0.4456,  0.4360,  0.4267,  0.4177,  0.4090,  0.4006,  0.3925,
     $   0.3846,  0.3770,  0.3696,  0.3624,  0.3554,  0.3487,  0.3421,
     $   0.3358,  0.3296,  0.3235,  0.3177,  0.3120,  0.3065,  0.3011,
     $   0.2959,  0.2908,  0.2858,  0.2810,  0.2763,  0.2717,  0.2672,
     $   0.2628,  0.2586,  0.2544,  0.2504,  0.2464,  0.2425,  0.2388,
     $   0.2351,  0.2315,  0.2280,  0.2245,  0.2212,  0.2179,  0.2147,
     $   0.2116,  0.2085,  0.2055,  0.2026,  0.1997,  0.1969,  0.1941,
     $   0.1915,  0.1888,  0.1862,  0.1837,  0.1812,  0.1788,  0.1764,
     $   0.1741,  0.1718,  0.1696,  0.1674,  0.1652,  0.1631,  0.1610,
     $   0.1590,  0.1570,  0.1551,  0.1532,  0.1513,  0.1494,  0.1476,
     $   0.1458,  0.1441,  0.1424,  0.1407,  0.1390,  0.1374,  0.1358,
     $   0.1342,  0.1327,  0.1312,  0.1297,  0.1282,  0.1268,  0.1254,
     $   0.1240,  0.1226,  0.1213,  0.1200,  0.1187,  0.1174,  0.1161,
     $   0.1149,  0.1137,  0.1125,  0.1113,  0.1101,  0.1090,  0.1079,
     $   0.1068,  0.1057,  0.1046,  0.1036,  0.1025,  0.1015 /
C
      DATA X6 /
     $   0.7554,  0.5749,  0.5271,  0.4925,  0.4646,  0.4409,  0.4202,
     $   0.4020,  0.3856,  0.3709,  0.3575,  0.3451,  0.3338,  0.3232,
     $   0.3134,  0.3043,  0.2957,  0.2876,  0.2800,  0.2728,  0.2660,
     $   0.2596,  0.2535,  0.2476,  0.2421,  0.2368,  0.2317,  0.2269,
     $   0.2222,  0.2177,  0.2134,  0.2093,  0.2054,  0.2015,  0.1978,
     $   0.1943,  0.1909,  0.1876,  0.1843,  0.1812,  0.1782,  0.1753,
     $   0.1725,  0.1698,  0.1671,  0.1646,  0.1621,  0.1597,  0.1573,
     $   0.1550,  0.1528,  0.1506,  0.1485,  0.1464,  0.1444,  0.1425,
     $   0.1406,  0.1387,  0.1369,  0.1351,  0.1334,  0.1317,  0.1300,
     $   0.1284,  0.1268,  0.1253,  0.1238,  0.1223,  0.1209,  0.1195,
     $   0.1181,  0.1167,  0.1154,  0.1141,  0.1128,  0.1116,  0.1104,
     $   0.1092,  0.1080,  0.1069,  0.1057,  0.1046,  0.1035,  0.1025,
     $   0.1014,  0.1004,  0.0994,  0.0984,  0.0974,  0.0965,  0.0955,
     $   0.0946,  0.0937,  0.0928,  0.0919,  0.0910,  0.0902,  0.0894,
     $   0.0885,  0.0877,  0.0869,  0.0862,  0.0854,  0.0846,  0.0839,
     $   0.0832,  0.0824,  0.0817,  0.0810,  0.0803,  0.0796,  0.0790,
     $   0.0783,  0.0777,  0.0770,  0.0764,  0.0758,  0.0752,  0.0745,
     $   0.0740,  0.0734,  0.0728,  0.0722,  0.0716,  0.0711,  0.0705,
     $   0.0700,  0.0695,  0.0689,  0.0684,  0.0679,  0.0674,  0.0669,
     $   0.0664,  0.0659,  0.0654,  0.0650,  0.0645,  0.0640,  0.0636,
     $   0.0631,  0.0627,  0.0622,  0.0618,  0.0614,  0.0609,  0.0605,
     $   0.0601,  0.0597,  0.0593,  0.0589,  0.0585,  0.0581 /
C
      DATA X7 /
     $   1.2189,  0.9356,  0.8528,  0.7931,  0.7449,  0.7040,  0.6685,
     $   0.6372,  0.6092,  0.5840,  0.5610,  0.5400,  0.5207,  0.5028,
     $   0.4862,  0.4707,  0.4562,  0.4426,  0.4297,  0.4177,  0.4062,
     $   0.3954,  0.3852,  0.3754,  0.3661,  0.3573,  0.3488,  0.3407,
     $   0.3330,  0.3256,  0.3185,  0.3117,  0.3051,  0.2988,  0.2927,
     $   0.2869,  0.2812,  0.2758,  0.2705,  0.2654,  0.2605,  0.2558,
     $   0.2512,  0.2467,  0.2424,  0.2383,  0.2342,  0.2303,  0.2264,
     $   0.2227,  0.2191,  0.2156,  0.2122,  0.2089,  0.2057,  0.2025,
     $   0.1995,  0.1965,  0.1936,  0.1907,  0.1880,  0.1853,  0.1827,
     $   0.1801,  0.1776,  0.1751,  0.1728,  0.1704,  0.1681,  0.1659,
     $   0.1637,  0.1616,  0.1595,  0.1575,  0.1555,  0.1535,  0.1516,
     $   0.1497,  0.1479,  0.1461,  0.1443,  0.1426,  0.1409,  0.1393,
     $   0.1376,  0.1360,  0.1345,  0.1329,  0.1314,  0.1300,  0.1285,
     $   0.1271,  0.1257,  0.1243,  0.1230,  0.1216,  0.1203,  0.1191,
     $   0.1178,  0.1166,  0.1154,  0.1142,  0.1130,  0.1118,  0.1107,
     $   0.1096,  0.1085,  0.1074,  0.1064,  0.1053,  0.1043,  0.1033,
     $   0.1023,  0.1013,  0.1003,  0.0994,  0.0985,  0.0975,  0.0966,
     $   0.0957,  0.0949,  0.0940,  0.0931,  0.0923,  0.0915,  0.0907,
     $   0.0899,  0.0891,  0.0883,  0.0875,  0.0868,  0.0860,  0.0853,
     $   0.0845,  0.0838,  0.0831,  0.0824,  0.0817,  0.0811,  0.0804,
     $   0.0797,  0.0791,  0.0784,  0.0778,  0.0772,  0.0766,  0.0759,
     $   0.0753,  0.0748,  0.0742,  0.0736,  0.0730,  0.0724 /
C
      DATA X8 /
     $   0.5141,  0.3426,  0.2649,  0.2185,  0.1875,  0.1649,  0.1474,
     $   0.1334,  0.1218,  0.1120,  0.1036,  0.0963,  0.0898,  0.0841,
     $   0.0790,  0.0745,  0.0703,  0.0665,  0.0631,  0.0599,  0.0570,
     $   0.0544,  0.0519,  0.0496,  0.0474,  0.0454,  0.0436,  0.0418,
     $   0.0402,  0.0386,  0.0372,  0.0358,  0.0345,  0.0333,  0.0321,
     $   0.0311,  0.0300,  0.0290,  0.0281,  0.0272,  0.0264,  0.0256,
     $   0.0248,  0.0241,  0.0233,  0.0227,  0.0220,  0.0214,  0.0208,
     $   0.0203,  0.0197,  0.0192,  0.0187,  0.0182,  0.0178,  0.0173,
     $   0.0169,  0.0165,  0.0161,  0.0157,  0.0153,  0.0150,  0.0146,
     $   0.0143,  0.0140,  0.0137,  0.0134,  0.0131,  0.0128,  0.0125,
     $   0.0122,  0.0120,  0.0117,  0.0115,  0.0113,  0.0110,  0.0108,
     $   0.0106,  0.0104,  0.0102,  0.0100,  0.0098,  0.0096,  0.0095,
     $   0.0093,  0.0091,  0.0090,  0.0088,  0.0086,  0.0085,  0.0083,
     $   0.0082,  0.0080,  0.0079,  0.0078,  0.0076,  0.0075,  0.0074,
     $   0.0073,  0.0072,  0.0070,  0.0069,  0.0068,  0.0067,  0.0066,
     $   0.0065,  0.0064,  0.0063,  0.0062,  0.0061,  0.0060,  0.0059,
     $   0.0059,  0.0058,  0.0057,  0.0056,  0.0055,  0.0054,  0.0054,
     $   0.0053,  0.0052,  0.0051,  0.0051,  0.0050,  0.0049,  0.0049,
     $   0.0048,  0.0047,  0.0047,  0.0046,  0.0046,  0.0045,  0.0044,
     $   0.0044,  0.0043,  0.0043,  0.0042,  0.0042,  0.0041,  0.0041,
     $   0.0040,  0.0040,  0.0039,  0.0039,  0.0038,  0.0038,  0.0037,
     $   0.0037,  0.0036,  0.0036,  0.0036,  0.0035,  0.0035 /
C
      DATA X9 /
     $   3.2169,  2.6677,  2.2877,  2.0032,  1.7817,  1.6032,  1.4557,
     $   1.3314,  1.2250,  1.1330,  1.0524,  0.9813,  0.9180,  0.8614,
     $   0.8105,  0.7644,  0.7225,  0.6842,  0.6492,  0.6170,  0.5874,
     $   0.5599,  0.5345,  0.5109,  0.4889,  0.4684,  0.4493,  0.4313,
     $   0.4144,  0.3986,  0.3837,  0.3697,  0.3564,  0.3439,  0.3320,
     $   0.3208,  0.3102,  0.3000,  0.2904,  0.2813,  0.2726,  0.2643,
     $   0.2564,  0.2488,  0.2416,  0.2347,  0.2281,  0.2218,  0.2157,
     $   0.2099,  0.2044,  0.1990,  0.1939,  0.1889,  0.1842,  0.1796,
     $   0.1752,  0.1710,  0.1669,  0.1629,  0.1591,  0.1555,  0.1519,
     $   0.1485,  0.1452,  0.1420,  0.1389,  0.1359,  0.1330,  0.1302,
     $   0.1275,  0.1249,  0.1223,  0.1199,  0.1175,  0.1152,  0.1129,
     $   0.1107,  0.1086,  0.1065,  0.1045,  0.1026,  0.1007,  0.0988,
     $   0.0970,  0.0953,  0.0936,  0.0919,  0.0903,  0.0887,  0.0872,
     $   0.0857,  0.0843,  0.0829,  0.0815,  0.0801,  0.0788,  0.0775,
     $   0.0763,  0.0751,  0.0739,  0.0727,  0.0716,  0.0705,  0.0694,
     $   0.0683,  0.0673,  0.0663,  0.0653,  0.0643,  0.0634,  0.0624,
     $   0.0615,  0.0606,  0.0598,  0.0589,  0.0581,  0.0573,  0.0565,
     $   0.0557,  0.0549,  0.0542,  0.0535,  0.0527,  0.0520,  0.0513,
     $   0.0507,  0.0500,  0.0494,  0.0487,  0.0481,  0.0475,  0.0469,
     $   0.0463,  0.0457,  0.0451,  0.0446,  0.0440,  0.0435,  0.0430,
     $   0.0424,  0.0419,  0.0414,  0.0409,  0.0404,  0.0400,  0.0395,
     $   0.0390,  0.0386,  0.0381,  0.0377,  0.0373,  0.0369 /
C
      N=MAX0(0,MIN0(9,NASAE))
      I=MAX0(1,MIN0(152,IFIX(0.5*YLOC)+1))
      YM=2.0*(I-1)
      YP=2.0*I
      PONDEP=0.5*(XV(I,N+1)*(YP-YLOC)+XV(I+1,N+1)*(YLOC-YM))
      RETURN
      END
