C     Last change:  PJZ   9 Feb 2001    9:01 am
C
C      ********************************************************
C      *                                                      *
C      *                  *** STRMDEPL ***                    *
C      *                                                      *
C      *    ONE-DIMENSIONAL MODEL OF STREAMFLOW DEPLETION     *
C      *                                                      *
C      *        BY WELLS, BASED ON ANALYTICAL SOLUTIONS       *
C      *                                                      *
C      *    DEVELOPED BY JENKINS (1968) AND HANTUSH (1965)    *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A          *
C      *                                                      *
C      ********************************************************
C
C
C      Although this program has been used by the U.S. Geological
C      Survey, no warranty, expressed or implied, is made by the 
C      USGS as to the accuracy and functioning of the program and
C      related program material, nor shall the fact of distribution
C      constitute any such warranty, and no responsibility is
C      assumed by the USGS in connection therewith
C
C
C---INPUT VARIABLES:
C   LINE 1: TITLE:   Title of problem
C   LINE 2: WELLID:  Well identifier
C   LINE 3: XWELL:   Distance of well from stream, in feet
C           DIFFUS:  Diffusivity of aquifer, in square feet per second
C           IBANK:   On-off switch for streambank leakance:
C                    0 = no streambank leakance term (use Jenkins, 1968)
C                    1 = streambank leakance term (use Hantush, 1965)
C           SLEAK:   Streambank leakance, in feet
C   LINE 4: INTIME:  Number of pumping days prior to start of analysis
C           QWINIT:  Pumping rate prior to start of analysis, in cubic
C                     feet per second
C   LINE 5: NPD:     Number of pumping days in analysis
C   LINE 6: CDATE(I) Date for time-step (day) I
C           QWELL(I) Pumping rate for time-step (day) I, in cubic feet
C                     per second
C---SOLUTION VARIABLES:
C   SDF:     Streamflow depletion factor, in day (converted from seconds)
C   DELT:    Time-step size, assumes 1 day intervals
C   DELQ(I): Difference in pumping rates between time steps I and I-1
C             (DELQ(1) equals QWELL(1)), in cubic feet per second
C   QSINT:   Streamflow-depletion rate due to pumping prior to start of
C             analysis, in cubic feet per second
C   QS(I):   Calculated streamflow-depletion rate for day I, in cubic
C             feet per second
C   T:       Simulation time, in days
C   U,W:     Hydraulic groupings for solutions (see Hantush, 1965)
C
C---SPECIFICATIONS
C
C---THE FOLLOWING CARD MUST BE CHANGED IF PROBLEM DIMENSIONS ARE
C   GREATER THAN 30,000. ALSO CHANGE VALUE OF IMAXX IN
C   SUBROUTINE DATAIO
      PARAMETER (IMAXX=30000)
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      DIMENSION DELQ(IMAXX),QWELL(IMAXX),QS(IMAXX)
      CHARACTER CDATE(IMAXX)*8
C
C---COMMON STATEMENTS
      COMMON /IOUNIT/ IN,IO,IP
      COMMON /PAR1/ XWELL,DIFFUS,SLEAK,QWINIT
      COMMON /PAR2/ IBANK,INTIME,NPD
      COMMON /PAR7/ CDATE,QWELL
C
C1--OPEN INPUT, RESULT, AND PLOT FILES
C     try to get file names from command line first (Call AFILE added for GenScn extension)
      CALL AFILE(IPLOT)
      IF (IPLOT.EQ.-1) THEN
C       could not get file names from command line, so prompt for them
        CALL OFILE(IPLOT)
      END IF
C
C2--READ AND WRITE INPUT DATA
      CALL DATAIO
C
C3--DEFINE PARAMETERS. Note--Assumes a DELT of 1.0 days;
C    Also note that DIFFUS is converted from seconds to days.
      DIFFUS=DIFFUS*86400.0D0
      SDF=(XWELL*XWELL)/DIFFUS
      DELT=1.00D0
C
      WRITE(IO,100)
C     WRITE(*,101)     Suppress execution message in GenScn Extension
C
C---CALCULATE THE INITIAL DEPLETION DUE TO PUMPING PRIOR TO
C    START OF ANALYSIS
       T=INTIME
C---IF IBANK=0, USE JENKINS (1968)
       IF(IBANK.EQ.0)THEN
        U=DSQRT(SDF/(4.0D0*T))
        CALL EXERFC(0.0D0,U,Z1)
        QSINIT=QWINIT*Z1
       ENDIF
C---IF IBANK=1, USE HANTUSH (1965)
       IF(IBANK.EQ.1)THEN
        U=DSQRT(SDF/(4.0D0*T))
        W=(DSQRT(DIFFUS*T))/SLEAK
        C1= -(U*U) + (U+W)*(U+W)
        C2=U+W
        CALL EXERFC(0.0D0,U,Z1)
        CALL EXERFC(C1,C2,Z2)
        QSINIT=QWINIT*(Z1-Z2)
       ENDIF
C
      WRITE(IO,102)QSINIT
C
C---NOW, DO CONVOLUTION
C
C5--INITIALIZE DEPLETION ARRAY
       DO 5 I=1,NPD
        QS(I)=0.0D0
    5  CONTINUE
C
C6--CALCULATE THE TIME RATE OF CHANGE OF SYSTEM STRESS
       DELQ(1)=QWELL(1)-QWINIT
       DO 10 I=2,NPD
        DELQ(I)=QWELL(I)-QWELL(I-1)
   10  CONTINUE
C
C7--CALCULATE STREAMFLOW DEPLETIONS USING CONVOLUTION
       DO 15 JT=1,NPD
         SUM=0.0D0
C---COMPONENT A (QSINIT)--DEPLETION DUE TO THE CONSTANT PUMPING
C    RATE PRIOR TO START OF ANALYSIS
       T=INTIME+JT
C---IF IBANK=0, USE JENKINS (1968)
       IF(IBANK.EQ.0)THEN
        U=DSQRT(SDF/(4.0D0*T))
        CALL EXERFC(0.0D0,U,Z1)
        QSINIT=QWINIT*Z1
       ENDIF
C---IF IBANK=1, USE HANTUSH (1965)
       IF(IBANK.EQ.1)THEN
        U=DSQRT(SDF/(4.0D0*T))
        W=(DSQRT(DIFFUS*T))/SLEAK
        C1= -(U*U) + (U+W)*(U+W)
        C2=U+W
        CALL EXERFC(0.0D0,U,Z1)
        CALL EXERFC(C1,C2,Z2)
        QSINIT=QWINIT*(Z1-Z2)
       ENDIF
C
C---COMPONENT B (SUM)--DEPLETIONS DUE TO VARIABLE, DAILY
C    PUMPING RATES SINCE START OF ANALYSIS
        DO 20 KT=1,JT
         T=KT*DELT
C---IF IBANK=0, USE JENKINS (1968)
         IF(IBANK.EQ.0)THEN
          U=DSQRT(SDF/(4.0D0*T))
          CALL EXERFC(0.0D0,U,Z1)
          SUM=SUM + DELQ(JT-KT+1)*Z1
         ENDIF
C---IF IBANK=1, USE HANTUSH (1965)
         IF(IBANK.EQ.1)THEN
          U=DSQRT(SDF/(4.0D0*T))
          W=(DSQRT(DIFFUS*T))/SLEAK
          C1= -(U*U) + (U+W)*(U+W)
          C2=U+W
          CALL EXERFC(0.0D0,U,Z1)
          CALL EXERFC(C1,C2,Z2)
          SUM=SUM + DELQ(JT-KT+1)*(Z1-Z2)
         ENDIF
   20   CONTINUE
C
C---NOW, ADD COMPONENTS A AND B FOR TOTAL DEPLETION QS(JT)
        QS(JT)=QSINIT + SUM*DELT
   15  CONTINUE
C
C9--WRITE RESULTS TO RESULT AND PLOT FILES
      WRITE(IO,103)
C
      IF(IPLOT.EQ.1)WRITE(IP,104)
C
      DO 80 I=1,NPD
       WRITE(IO,105)CDATE(I),QWELL(I),QS(I)
       IF(IPLOT.EQ.1)THEN
       WRITE(IP,106)CDATE(I),QWELL(I),QS(I)
       ENDIF
  80   CONTINUE
C
C---FORMAT STATEMENTS
  100 FORMAT(/,/,/,28X,'RESULTS',/,28X,'-------',/)
  101 FORMAT(/,3X,'Calculating aquifer responses ...',/)
  102 FORMAT(/,/,3X,'STREAMFLOW DEPLETION AT BEGINNING OF',
     2' ANALYSIS:',/,10X,F10.4,' cubic feet per second')
  103 FORMAT(/,/,16X,'PUMPING RATE    STREAMFLOW DEPLETION',/,
     26X,'DAY              (cubic feet per second)',/,
     3'      ---       ------------    --------------------')
  104 FORMAT(4X,'DATE',10X,'QWELL',9X,'QS')
  105 FORMAT(3X,A8,4X,F10.4,9X,F10.4)
  106 FORMAT(2X,A8,3X,F10.4,3X,F10.4)
C
C10-CLOSE INPUT/RESULT/PLOT FILES, STOP, AND END
      CLOSE(UNIT=IN)
      CLOSE(UNIT=IO)
      IF(IPLOT.EQ.1)CLOSE(UNIT=IP)
      STOP
      END
C
C
C       ******************************************************
C      *                                                      *
C      *                  SUBROUTINE OFILE                    *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A          *
C      *                                                      *
C       ******************************************************
C
C11-SUBROUTINE OFILE OPENS INPUT, RESULT, AND PLOT FILES
C
      SUBROUTINE OFILE(IPLOT)
C
C---SPECIFICATIONS
      CHARACTER*50 IFNAME, OFNAME, PFNAME
      INTEGER IN, IO, IP, N, IPLOT
      COMMON /IOUNIT/ IN,IO,IP
C
      IN = 15
      IO = 16
      IP = 17
C
C---READ INPUT, RESULT, AND PLOT FILE NAMES
   10 WRITE(*,2)
      READ(*,5) IFNAME
      N=LENCHR(IFNAME)
      IF(N.LT.1) GO TO 10
      OPEN(IN,FILE=IFNAME,STATUS='OLD')
C
   11 WRITE(*,3)
      READ(*,5) OFNAME
      N=LENCHR(OFNAME)
      IF(N.LT.1) GO TO 11
      OPEN(IO,FILE=OFNAME)
C
      WRITE(*,4)
      READ(*,5) PFNAME
      N=LENCHR(PFNAME)
      IF(N.LT.1)THEN
       IPLOT=0
       WRITE(*,6)
      ELSE
       IPLOT=1
       OPEN(IP,FILE=PFNAME)
      ENDIF
C
      WRITE(*,7)
C
C---FORMAT STATEMENTS
    2 FORMAT(3X,'Enter name of file containing input data:')
    3 FORMAT(3X,'Enter name of file for program results:')
    4 FORMAT(3X,'Enter name of plot file (return for no plot file):')
    5 FORMAT(A50)
    6 FORMAT(/,3X,'No plot file specified. Results will not be written',
     1' to a plot file.')
    7 FORMAT(/,3X,'File names have been read.')
C
C---RETURN AND END
      RETURN
      END
C
C       ******************************************************
C      *                                                      *
C      *                    FUNCTION LENCHR                   *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A          *
C      *                                                      *
C       ******************************************************
C
C12-FUNCTION LENCHR CALCULATES THE LENGTH OF A CHARACTER STRING
C   (CODE FROM R. STEVE REGAN, USGS)
C
      INTEGER FUNCTION LENCHR
     I                       ( STRING )
C
      CHARACTER*(*) STRING
C
C     + + + ARGUMENT DEFINITIONS + + +
C     STRING - Input string to determine length of
C
C     + + + LOCAL VARIABLES + + +
      INTEGER MAX, I
C
C     + + + INTRINSICS + + +
      INTEGER LEN
      INTRINSIC LEN
C
C     + + + END SPECIFICATIONS + + +
C
      MAX = LEN(STRING)
      DO 10 I = MAX, 1, -1
        IF (STRING(I:I).NE.' ') THEN
          LENCHR = I
          GOTO 20
        ENDIF
   10 CONTINUE
      LENCHR = 0
C
   20 RETURN
      END
C
C
C       ******************************************************
C      *                                                      *
C      *                  SUBROUTINE DATAIO                   *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A          *
C      *                                                      *
C       ******************************************************
C
C13-SUBROUTINE DATAIO READS INPUT DATA FROM THE INPUT FILE AND
C   WRITES THIS DATA TO THE RESULT FILE
C
      SUBROUTINE DATAIO
C
C---SPECIFICATIONS
C
C---THE FOLLOWING CARD MUST BE CHANGED IF PROBLEM DIMENSIONS ARE
C   GREATER THAN 30,000. ALSO CHANGE VALUE OF IMAXX IN
c   MAIN PROGRAM
      PARAMETER (IMAXX=30000)
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      DIMENSION QWELL(IMAXX)
      CHARACTER STRING*80,TITLE*70,WELLID*20,CDATE(IMAXX)*8
C
C---COMMON STATEMENTS
      COMMON /IOUNIT/ IN,IO,IP
      COMMON /PAR1/ XWELL,DIFFUS,SLEAK,QWINIT
      COMMON /PAR2/ IBANK,INTIME,NPD
      COMMON /PAR7/ CDATE,QWELL
C
C13a-WRITE PROGRAM BANNER TO RESULT FILE
      CALL BANNER(IO)
C
C13b-READ INPUT DATA
      READ(IN,'(A80)') STRING
      ILINE=1
      READ(STRING,98,ERR=1000) TITLE
C
      READ(IN,'(A80)') STRING
      ILINE=2
      READ(STRING,99,ERR=1000) WELLID
C
      READ(IN,'(A80)') STRING
      ILINE=3
      READ(STRING,*,ERR=1000) XWELL, DIFFUS, IBANK, SLEAK
C
      READ(IN,'(A80)') STRING
      ILINE=4
      READ(STRING,*,ERR=1000) INTIME, QWINIT 
C
      READ(IN,'(A80)') STRING
      ILINE=5
      READ(STRING,*,ERR=1000) NPD 
C
C13c-READ STRESS DATA
       DO 10 ID=1,NPD
         READ(IN,'(A80)') STRING
         ILINE=6
         READ(STRING,*,ERR=1000) CDATE(ID), QWELL(ID)
  10   CONTINUE
C
C13d-WRITE INPUT DATA TO RESULT FILE
C
C---LINE 1 
      WRITE(IO,100)TITLE
C
      WRITE(IO,101)
C
C---LINES 2 AND 3
      WRITE(IO,102)WELLID
      WRITE(IO,103)XWELL
      WRITE(IO,104)DIFFUS
C
      IF(IBANK.EQ.0)WRITE(IO,105)IBANK
      IF(IBANK.EQ.1)WRITE(IO,106)IBANK
      IF(IBANK.GT.1)THEN
       WRITE(IO,107)
       STOP
      ENDIF
C
      IF(IBANK.EQ.1)WRITE(IO,108)SLEAK
      IF(IBANK.EQ.1)THEN
       IF(SLEAK.LE.0.0D0)THEN
        WRITE(IO,109)
        STOP
       ENDIF
      ENDIF
C
C---LINE 4 
      WRITE(IO,110)INTIME
      WRITE(IO,111)QWINIT
C
C---LINES 5 AND HIGHER
      WRITE(IO,112)NPD
C
C---FORMAT STATEMENTS
   98 FORMAT(A70)
   99 FORMAT(A20)
  100 FORMAT(5X,A70)
  101 FORMAT(/,/,20X,'SUMMARY OF INPUT DATA',
     2/,20X,'---------------------'/)
  102 FORMAT(2X,' WELL IDENTIFIER: ',20X,A20)
  103 FORMAT(2X,' WELL DISTANCE TO STREAM (XWELL): ',3X,D10.3,
     2' feet')
  104 FORMAT(2X,' DIFFUSIVITY (DIFFUS): ',12X,D12.3,
     2' square feet per second')
  105 FORMAT(2X,' STREAMBANK CODE (IBANK): ',8X,I5,
     2' (semipervious streambank absent)')
  106 FORMAT(2X,' STREAMBANK CODE (IBANK): ',8X,I5,
     2' (semipervious streambank simulated)')
  107 FORMAT(3X,'STREAMBANK CODE (IXA) INVALID. PROGRAM STOPPED.')
  108 FORMAT(2X,' STREAMBANK LEAKANCE (SLEAK): ',7X,D10.3,
     2' feet')
  109 FORMAT(3X,'STREAMBANK LEAKANCE (SLEAK) LESS THAN OR EQUAL',
     2' TO ZERO.',/,5X,' PROGRAM STOPPED.')
  110 FORMAT(2X,' INITIAL TIME (INTIME): ',13X,I5,' days')
  111 FORMAT(2X,' INITIAL PUMPING RATE (QWINIT): ',3X,D12.3,
     2' cubic feet per second')
  112 FORMAT(2X,' NUMBER OF PUMPING DAYS (NPD): ',6X,I5)
C
      RETURN
C---CALL RDERR FOR INPUT READ ERRORS
 1000 CALL RDERR(IO,STRING,ILINE)
      END
C
C       ******************************************************
C      *                                                      *
C      *                  SUBROUTINE BANNER                   *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A          *
C      *                                                      *
C       ******************************************************
C
C14-SUBROUTINE BANNER WRITES A PROGRAM BANNER TO RESULT FILE
C
      SUBROUTINE BANNER(IO)
      WRITE(IO,100)
 100  FORMAT(/,10X,
     2'      *****************************************************',/,
     3 10X,
     4'      *                                                   *',/,
     5 10X,
     6'      *         ****  U.S. GEOLOGICAL SURVEY  ****        *',/,
     7 10X,
     8'      *                                                   *',/,
     9 10X,
     &'      *          *** STRMDEPL: PROGRAM OUTPUT ***         *',/,
     1 10X,
     2'      *                                                   *',/,
     3 10X,
     4'      *    ONE-DIMENSIONAL MODEL OF STREAMFLOW DEPLETION  *',/,
     5 10X,
     6'      *                                                   *',/,
     7 10X,
     8'      *       BY WELLS, BASED ON ANALYTICAL SOLUTIONS     *',/,
     9 10X,
     &'      *                                                   *',/,
     1 10X,
     2'      *   DEVELOPED BY JENKINS (1968) AND HANTUSH (1965)  *',/,
     3 10X,
     4'      *                                                   *',/,
     5 10X,
     6'      *           VERSION CURRENT AS OF 04/21/00 A         *',/,
     7 10X,
     8'      *                                                   *',/,
     9 10X,
     &'      *****************************************************',
     1/,/)
C
      RETURN
      END
C
C
C       ******************************************************
C      *                                                      *
C      *                  SUBROUTINE RDERR                    *
C      *                                                      *
C      *            VERSION CURRENT AS OF 04/21/00 A            *
C      *                                                      *
C       ******************************************************
C
C15-SUBROUTINE RDERR WRITES AN ERROR MESSAGE TO THE RESULT FILE
C   AND STOPS PROGRAM EXECUTION
C
      SUBROUTINE RDERR(IO,STRING,ILINE)
C
C---SPECIFICATIONS
      CHARACTER STRING*80,VAR(6)*40
      DATA VAR/' TITLE',
     2         ' WELLID',
     3         ' XWELL  DIFFUS  IBANK  SLEAK',
     4         ' INTIME  QWINIT',
     5         ' NPD',
     6         ' TIME-PUMPING DATA'/
C
      WRITE(IO,1)ILINE
      WRITE(IO,'(A80)')STRING
      WRITE(IO,2) VAR(ILINE)
      WRITE(IO,3)

   1  FORMAT(' Aborting due to error in line from input file:',
     2 2X,I5)
   2  FORMAT(' While attempting to read variables',A40)
   3  FORMAT(' Check for incorrect positions or data types...')
      STOP
      END
C
C
C       ******************************************************
C      *                                                      *
C      *                  SUBROUTINE EXERFC                   *
C      *                                                      *
C      *            VERSION CURRENT AS OF 10/01/87            *
C      *              CODE CLEANUP 03/27/96 - RSR             *
C      *                                                      *
C       ******************************************************
C
      SUBROUTINE EXERFC(X,YY,Z)
      DOUBLE PRECISION X, YY, Z
C
C       THIS ROUTINE USES RATIONAL CHEBYSHEV APPROXIMATIONS
C       FOR EVALUATING THE ERROR FUNCTION AND COMPLEMENTARY
C       ERROR FUNCTION IN ORDER TO EVALUATE THE PRODUCT OF
C       EXP(X) AND ERFC(Y)
C
C---Local variables
      DOUBLE PRECISION erf, erfcy, p1(5), p2(9), p3(6), q1(5), q2(9), 
     &                 q3(6), sqrtpi, sump, sumq, y, y2i, yi
      INTEGER i
C
C---Intrinsics
      DOUBLE PRECISION DABS, DEXP
      INTRINSIC DABS, DEXP
C
      DATA p1/3.209377589138469472562D03, 3.774852376853020208137D02, 
     &     1.138641541510501556495D02, 3.161123743870565596947D0, 
     &     1.857777061846031526730D-01/
      DATA q1/2.844236833439170622273D03, 1.282616526077372275645D03, 
     &     2.440246379344441733056D02, 2.360129095234412093499D01, 
     &     1.0D0/
      DATA p2/1.23033935479799725272D03, 2.05107837782607146532D03, 
     &     1.71204761263407058314D03, 8.81952221241769090411D02, 
     &     2.98635138197400131132D02, 6.61191906371416294775D01, 
     &     8.88314979438837594118D00, 5.64188496988670089180D-01, 
     &     2.15311535474403846343D-08/
      DATA q2/1.23033935480374942043D03, 3.43936767414372163696D03, 
     &     4.36261909014324715820D03, 3.29079923573345962678D03, 
     &     1.62138957456669018874D03, 5.37181101862009857509D02, 
     &     1.17693950891312499305D02, 1.57449261107098347253D01, 1.0D0/
      DATA p3/ - 6.58749161529837803157D-04, 
     &     -1.60837851487422766278D-02, -1.25781726111229246204D-01, 
     &     -3.60344899949804439429D-01, -3.05326634961232344035D-01, 
     &     -1.63153871373020978498D-02/
      DATA q3/2.33520497626869185443D-03, 6.05183413124413191178D-02, 
     &     5.27905102951428412248D-01, 1.87295284992346047209D00, 
     &     2.56852019228982242072D00, 1.0D0/
C
C---FOR  Y = 0.0
      IF (YY.EQ.0.0D0) THEN
        Z = DEXP(X)
      ELSE
        y = DABS(YY)
        sump = 0.0D0
        sumq = 0.0D0
C
C---FOR 0.0 < Y <= .46875
        IF (y.LE.0.46875D0) THEN
          DO 10 i = 1, 5
            y2i = y**(2*(i-1))
            sump = sump + p1(i)*y2i
            sumq = sumq + q1(i)*y2i
   10     CONTINUE
          erf = y*sump/sumq
          IF (YY.LT.0.0D0) erf = -erf
          erfcy = 1.0D0 - erf
          Z = DEXP(X)*erfcy
C
C---FOR .46875 < Y <= 4.0
        ELSEIF (y.LE.4.0D0) THEN
          DO 20 i = 1, 9
            yi = y**(i-1)
            sump = sump + p2(i)*yi
            sumq = sumq + q2(i)*yi
   20     CONTINUE
          Z = DEXP(X-y*y)*sump/sumq
          IF (YY.LT.0.0D0) Z = 2.0D0*DEXP(X) - Z
C
C---FOR  Y > 4.0
        ELSE
          DO 30 i = 1, 6
            y2i = y**(-2*(i-1))
            sump = sump + p3(i)*y2i
            sumq = sumq + q3(i)*y2i
   30     CONTINUE
          sqrtpi = 0.5641895835477562869481D0
          Z = sqrtpi + sump/(y*y*sumq)
          Z = DEXP(X-y*y)*Z/y
          IF (YY.LT.0.0D0) Z = 2.0D0*DEXP(X) - Z
        ENDIF
      ENDIF
      RETURN
      END
C
C
C
C      /******************************************************\
C      *                                                      *
C      *                  SUBROUTINE AFILE                    *
C      *                                                      *
C      *            VERSION CURRENT AS OF 08/09/99            *
C      *       Subroutine added by Paul Duda Aqua Terra       *
C      *   For STRMDEPL to be run as an extension to GenScn   *
C      *                                                      *
C      \******************************************************/
C
C   SUBROUTINE AFILE GETS INPUT, RESULT, AND PLOT FILE NAMES FROM
C     THE COMMAND LINE AND OPENS THEM
C
      SUBROUTINE AFILE(IPLOT)
C
C---SPECIFICATIONS
      CHARACTER*50 IFNAME, OFNAME, PFNAME
      CHARACTER*80 CLINE
      INTEGER IN, IO, IP, IPLOT, I, ISTR, IPOS
      COMMON /IOUNIT/ IN,IO,IP
C
      IN = 15
      IO = 16
      IP = 17
C
C     getcl is lahey specific, this line may have to be replaced
C     for other compilers
      CALL GETCL (CLINE)
C
C     assume there is nothing on the command line
      IPLOT = -1
C
      IF (LENCHR(CLINE).GT.0) THEN
C       there is something on the command line
C
        ISTR = 0
        IFNAME = ' '
        OFNAME = ' '
        PFNAME = ' '
C
C       parse out file names from command line
        DO 100 I = 1,80
          IF (CLINE(I:I).EQ.' ') THEN
            IF (ISTR.EQ.1) THEN
              IFNAME = CLINE(IPOS:I-1)
              ISTR = -1
            ELSE IF (ISTR.EQ.2) THEN
              OFNAME = CLINE(IPOS:I-1)
              ISTR = -2
            ELSE IF (ISTR.EQ.3) THEN
              PFNAME = CLINE(IPOS:I-1)
              ISTR = -3
            END IF
          ELSE
            IF (ISTR.EQ.0) THEN
              ISTR = 1
              IPOS = I
            ELSE IF (ISTR.EQ.-1) THEN
              ISTR = 2
              IPOS = I
            ELSE IF (ISTR.EQ.-2) THEN
              ISTR = 3
              IPOS = I
            END IF
          END IF
 100    CONTINUE

        OPEN(IN,FILE=IFNAME,STATUS='OLD',ERR=10)
C
        OPEN(IO,FILE=OFNAME,ERR=10)
C
        IPLOT=0
        IF(PFNAME.NE.' ')THEN
          OPEN(IP,FILE=PFNAME,ERR=10)
          IPLOT=1
        ENDIF
      END IF
 10   CONTINUE
C
C---RETURN AND END
      RETURN
      END