C
C________________________________________________________________
C
C     SUBROUTINE  L X P L O T
C________________________________________________________________
C
C SUBROUTINE LINE EXTERNAL PLOT WHEN CALLED BY PROGRAM CONTOUR
C WILL PLOT LINES FROM AN EXTERNAL FILE.  THE PARMS NEEDED ARE
C AS FOLLOWS:
C
C   LXFILE = CHARACTER*56.  THE NAME OF THE EXTERNAL FILE
C            CONTAINING THE ORDERED PAIRS OF THE LINE SEGMENT OR
C            SEGMENTS TO PLOT.  EACH LINE SEGMENT MUST TERMINATE
C            WITH AN END-OF-FILE OR A NUMBER GREATER THAN OR
C            EQUAL TO 1.0E+37 IN EITHER X OR Y OR BOTH FIELDS.
C            DEFAULT IS BLANKS WHICH MEANS NO EXTERNAL LINE
C            PLOTTING WILL BE DONE.
C   LXFMT  = CHARACTER*16.  THE FORMAT OF THE INPUT FILE.
C            IF LXFMT IS NON-BLANK THEN THE DATA IS READ IN
C            LIST FORMAT(I.E.,THE FORMAT IS IGNORED).
C            DEFAULT IS BLANKS WHICH MEANS BINARY XYZ FILE.
C   LXPROJ = INTEGER*4.  THE NUMBER OF THE PROJECTION OF LXFILE.
C            IF THE FILE HAS BEEN PROJECTED IT MUST HAVE THE SAME
C            PROJECTION NUMBER, CENTRAL MERIDIAN, AND BASLAT AS
C            THE GRID FILE.  DEFAULT IS 999 WHICH MEANS
C            UNPROJECTED DATA.
C   LXUNIT = INTEGER*4.  THE NUMBER REPRESENTING THE TYPE OF
C            UNITS IN THE LXFILE.  0 - INCHES (PROJECTED),
C            SECONDS (UNPROJECTED); 1 - METERS, MINUTES; AND
C            DEFAULT IS 2 - KILOMETERS, DEGREES.  NOTE:  IF
C            LXPROJ=999 THEN LXUNIT IS SECONDS, MINUTES, OR
C            DEGREES.  OTHERWISE IT IS INCHES, METERS, OR
C            KILOMETERS.  IF THE GRID IS NOT PROJECTED SETTING
C            UNIT = 0, 1, OR 2 WILL SPECIFY SECONDS, MINUTES,
C            AND DEGREES FOR THE GRID SO THAT THE GRID UNITS
C            (USE UNIT) MAY BE MATCHED TO THE LXFILE UNITS
C            (USE LXUNIT).
C   LXTYPE = INTEGER*4.  THE NUMBER OF THE DESIRED LINE TYPE
C            (SEE IDASHS IN THE CONTOUR DOCUMENTATION).  DEFAULT
C            IS 0 WHICH MEANS A SOLID UNTHICKENED LINE WILL BE
C            USED.  IF LXTYPE IS SET TO 999 THE FIRST POINT OF
C            EACH LINE SEGMENT IN LXFILE WILL BE TAKEN AS THE
C            VALUE FOR LXTYPE.  IN THIS CASE BOTH X AND Y MUST BE
C            EQUAL TO EACH OTHER AND THEY MUST BE EQUAL TO A
C            VALID LINE TYPE NUMBER.
C
C SUBROUTINE LXPLOT WRITTEN BY ROB BRACKEN, USGS, 23FEB87
C
C
      subroutine lxplot(lxfile,lxfmt,lxproj,lxunit,lxtype)
      save
C
C VARIABLE DECLARATION
C
      common/llp/latm(3),latx(3),longm(3),longx(3),cm(3),
     1           baslat(3),iproj,xxx(2),yyy(2),sizep,unit,ip,
     2           neat,tint,itpost,ibound,sizet,phi1,phi2
      integer*4 isize
      parameter(isize=50)
      dimension xlat(isize),xlon(isize),xx(isize),yy(isize)
      dimension lnum(isize)
      integer*4 idsk
      parameter(idsk=14)
      character*80 fields(10)
      character*56 lxfile,blank
      character*16 lxfmt,blank1
      parameter(dval=1.0e+37)
      logical eof
C
C FUNCTIONS
C
c      integer*4 function lintyp
      real*8 min2dg,sec2dg
      parameter(min2dg=1.d0/60.d0,sec2dg=1.d0/3600.d0)
      data blank/' '/,blank1/' '/
      dms2d(a,b,c)=-(a+sign(b,a)*min2dg+sign(c,a)*sec2dg)
      dms2d1(a,b,c)=a+sign(b,a)*min2dg+sign(c,a)*sec2dg
C
C CHECK IF PLOT SHOULD BE DONE
C
      if(lxfile.eq.blank) return
C
C SET UP ASCII FILE TYPE BASED ON LXFMT
C
      eof=.false.
      if(lxfmt.eq.blank1) then
        nftype=0
        open(unit=idsk,file=lxfile,form='unformatted',status='old')
      else
        open(24,status='scratch')
        open(unit=idsk,file=lxfile,form='formatted',status='old')
        call freerd(idsk,nfield,fields,0,*910,*910)
        close(24)
        rewind idsk
        if(nfield.lt.2.or.nfield.gt.3) go to 910
        if(nfield.eq.2) then
        nftype=1
        else
        nftype=2
        endif
      endif
C
C BRANCH IF A PROJECTION NEED NOT BE PERFORMED ON THE INPUT DATA
C
      if(lxproj.eq.iproj) goto 240
C
C PROJECT AND PLOT UNPROJECTED INPUT DATA
C
      if(lxproj.ne.999) goto 901
C
C SET UP FACTORS FOR CONVERTING INPUT UNITS TO DEGREES
C
      dfac=1.0
      if(lxunit.eq.1) dfac=60.0
      if(lxunit.eq.0) dfac=3600.0
C
C SET UP FACTORS FOR CONVERTING OUTPUT UNITS FROM METERS
C
      sfac=.001
      if(unit.eq.1.0) sfac=1.0
      if(unit.eq.0.0) sfac=100.0/2.54
C
C SET UP PROJECTION
C
      if(iproj.gt.4) call setalb(iproj)
      pcm=dms2d(cm(1),cm(2),cm(3))
      pbs=dms2d1(baslat(1),baslat(2),baslat(3))
C
C FIND PROJECTED Y-COORDINATE OF THE BASLAT
C
      xxxx=pbs
      call prjctl(xxxx,pcm,yy(1),pbs,pcm,sfac,iproj)
C
C BEGIN A NEW LINE SEGMENT
C
   50 j=1
C
C INITIALIZE THE BRIDGING NUMBER
C
      icon=0
      icon2=0
C
C READ LXFILE AND DETERMINE THE LINE TYPE
C
      if(nftype.eq.0) then
      read(idsk,end=80) xlon(j),xlat(j)
      else if(nftype.eq.1) then
      read(idsk,*,end=80) xlon(j),xlat(j)
      else
      read(idsk,*,end=80) xlon(j),xlat(j),lnum(j)
      endif
c      print *,xlon(j),xlat(j)
      if(lxtype.eq.999) then
        ltype=lintyp(xlon(j),xlat(j))
        if(ltype.eq.999) ltype=0
        goto 110
      end if
      ltype=lxtype
      goto 170
C
C READ EACH SUCCESSIVE POINT IN LXFILE AND BRANCH TO PLOTTING
C IF THE END OF THE LINE SEGMENT HAS BEEN REACHED.
C
  130 j=j+1
  110 if(nftype.eq.0) then
      read(idsk,end=80) xlon(j),xlat(j)
      else if(nftype.eq.1) then
      read(idsk,*,end=80) xlon(j),xlat(j)
      else
      read(idsk,*,end=80) xlon(j),xlat(j),lnum(j)
      endif
c      print *,xlon(j),xlat(j)
  170 if(xlon(j).ge.dval.or.xlat(j).ge.dval) go to 180
      if(nftype.eq.2.and.j.ne.1) then
      if(lnum(j).ne.lnum(j-1)) go to 180
      endif
C
C CONVERT DATA TO DEGREES AND PROJECT
C
  175 xlon(j)=sign(xlon(j),pcm)*dfac
      xlat(j)=xlat(j)*dfac
      call prjctl(xlat(j),xlon(j),xx(j),yyyy,pcm,sfac,iproj)
      xx(j)=-xx(j)
      yy(j)=yyyy-pbs
C
C LOOP TO NEXT ORDERED PAIR UNLESS ARRAYS ARE FULL
C
      if(j.lt.isize) goto 130
C
C SET ICON2 TO BRIDGE BETWEEN THIS DATA SET AND THE NEXT ONE
C
      icon2=1
      goto 190
C
C CONTINUE PLOTTING AT END OF FILE ONLY IF ARRAYS ARE NOT EMPTY
C
   80 eof=.true.
   90 if(j-1.lt.2.and.icon.eq.0) goto 901
C
C CALL LINE IF THERE IS MORE THAN ONE POINT OR IF BRIDGING FROM
C THE LAST SEGMENT.  REMEMBER THE COORDS OF THE LAST POINT
C
  180 j=j-1
  190 if(icon.eq.0.and.j.ge.2.or.icon.eq.1.and.j.ge.1) then
c        print *,'line called',icon,ltype
c        print *,(xx(i),yy(i),i=1,j)
        call line(xx,yy,j,icon,ltype)
        xlp=xx(j)
        ylp=yy(j)
      end if
      if(eof) go to 910
C
C SET ICON FOR NEXT CALL TO LINE
C
      icon=icon2
C
C BRANCH TO BEGIN NEW LINE SEGMENT UNLESS BRIDGING
C
      if(icon.eq.0.and.nftype.ne.2) goto 50
      if(icon.eq.0.and.nftype.eq.2) then
      xlon(1)=xlon(j+1)
      xlat(1)=xlat(j+1)
      lnum(1)=lnum(j+1)
      j=1
      go to 175
      endif
C
C CONTINUE WITH PRESENT SEGMENT WHEN BRIDGING
C
      j=0
      icon2=0
      goto 130
C
C PLOT INPUT DATA - NO PROJECTING REQUIRED
C
  240 continue
C
C SET UP FACTORS FOR CONVERTING INPUT UNITS TO DEGREES OR METERS.
C
      if(lxproj.eq.999) then
        dfac=1.0
        if(lxunit.eq.1) dfac=min2dg
        if(lxunit.eq.0) dfac=sec2dg
      else
        dfac=1000
        if(lxunit.eq.1) dfac=1.0
        if(lxunit.eq.0) dfac=2.54/100.0
      end if
C
C SET UP FACTORS FOR CONVERTING OUTPUT UNITS FROM DEGREES OR
C METERS TO DATA UNITS
C
      if(iproj.eq.999) then
        sfac=1.0
        if(unit.eq.1) sfac=60.0
        if(unit.eq.0) sfac=3600.0
      else
        sfac=.001
        if(unit.eq.1) sfac=1.0
        if(unit.eq.0) sfac=100.0/2.54
      end if
C
C BEGIN A NEW LINE SEGMENT
C
  250 j=1
C
C INITIALIZE THE BRIDGING NUMBER
C
      icon=0
      icon2=0
C
C READ LXFILE AND DETERMINE THE LINE TYPE
C
      if(nftype.eq.0) then
      read(idsk,end=280) xlon(j),xlat(j)
      else if(nftype.eq.1) then
      read(idsk,*,end=280) xlon(j),xlat(j)
      else
      read(idsk,*,end=280) xlon(j),xlat(j),lnum(j)
      endif
      if(lxtype.eq.999) then
        ltype=lintyp(xlon(j),xlat(j))
        if(ltype.eq.999) ltype=0
        goto 310
      end if
      ltype=lxtype
      goto 370
C
C READ EACH SUCCESSIVE POINT IN LXFILE AND BRANCH TO PLOTTING
C IF THE END OF THE LINE SEGMENT HAS BEEN REACHED.
C
  330 j=j+1
  310 if(nftype.eq.0) then
      read(idsk,end=280) xlon(j),xlat(j)
      else if(nftype.eq.1) then
      read(idsk,*,end=280) xlon(j),xlat(j)
      else
      read(idsk,*,end=280) xlon(j),xlat(j),lnum(j)
      endif
  370 if(xlon(j).ge.dval.or.xlat(j).ge.dval) go to 380
      if(nftype.eq.2.and.j.ne.1) then
      if(lnum(j).ne.lnum(j-1)) go to 380
      endif
C
C CONVERT DATA TO MAP UNITS
C
  375 xlon(j)=xlon(j)*dfac
      xlat(j)=xlat(j)*dfac
      xx(j)=xlon(j)*sfac
      yy(j)=xlat(j)*sfac
C
C LOOP TO NEXT ORDERED PAIR UNLESS ARRAYS ARE FULL
C
      if(j.lt.isize) goto 330
C
C SET ICON2 TO BRIDGE BETWEEN THIS DATA SET AND THE NEXT ONE
C
      icon2=1
      goto 390
C
C CONTINUE PLOTTING AT END OF FILE ONLY IF ARRAYS ARE NOT EMPTY
  280 eof=.true.
C
  290 if(j-1.lt.2.and.icon.eq.0) goto 901
C
C CALL LINE IF THERE IS MORE THAN ONE POINT OR IF BRIDGING FROM
C THE LAST SEGMENT.  REMEMBER COORDS OF LAST POINT.
C
  380 j=j-1
  390 if(icon.eq.0.and.j.ge.2.or.icon.eq.1.and.j.ge.1) then
        call line(xx,yy,j,icon,ltype)
        xlp=xx(j)
        ylp=yy(j)
      end if
      if(eof) go to 910
C
C SET ICON FOR NEXT CALL TO LINE
C
      icon=icon2
C
C BRANCH TO BEGIN NEW LINE SEGMENT UNLESS BRIDGING
C
      if(icon.eq.0.and.nftype.ne.2) goto 250
      if(icon.eq.0.and.nftype.eq.2) then
      xlon(1)=xlon(j+1)
      xlat(1)=xlat(j+1)
      lnum(1)=lnum(j+1)
      j=1
      go to 375
      endif
C
C CONTINUE WITH PRESENT SEGMENT WHEN BRIDGING
C
      j=0
      icon2=0
      goto 330
C
C END SEQUENCE
C
  901 xx(1)=xlp
      yy(1)=ylp
      call line(xx,yy,1,0,ltype)
  910 close(unit=idsk)
      return
      end
C
C________________________________________________________________
C
C     FUNCTION  L I N T Y P
C________________________________________________________________
C
C FUNCTION LINE TYPE RETURNS AN INTEGER EQUAL TO A AND B ONLY IF
C A=B, A IS BETWEEN 0 AND 998 INCLUSIVE, AND A IS NEARLY AN
C INTEGER.  OTHERWISE IT RETURNS 999.
C
C FUNCTION LINTYP WRITTEN BY ROB BRACKEN, USGS, 23FEB87
C
C
      function lintyp(a,b)
      lintyp=999
      if(abs(a-b).gt.1.e-5) return
      if(a.gt.998.1.or.a.lt.0.0) return
      if(abs(a-anint(a)).gt.1.e-5) return
      lintyp=nint(a)
      return
      end
      subroutine txplot
c
c     Reads an ascii file to plot text on a contour map.
c     It calls subroutine freerd to determine the number
c     of fields.The minimun number of input fields is five.
c     The order of fields is exactly the same as a call to
c     subroutine vchar with the execption that the number
c     of characters to plot is not included.
c
      character*80 fields(10),text,blank
      common/txcb/txfile
      character*56 txfile
      integer ltext(33)
      equivalence(text,ltext(1))
      data blank/' '/
      open(24,status='scratch')
      open(25,file=txfile,status='old',err=997,iostat=istat)
   10 theta=0.
      xoff=0.
      yoff=0.
      call freerd(25,nfield,fields,0,*999,*999)
      if(nfield.lt.5.or.nfield.gt.8) go to 999
      if(nfield.lt.8) then
      do 20 i=nfield+1,8
      fields(i)=blank
   20 continue
      endif
      length=leftj(fields(3))
      go to (999,999,999,999,30,40,50,60),nfield
   30 if(length.lt.2) then
      read(24,*,err=998,iostat=istat) x,y,ltext(1),icode,size
      else
      read(24,*,err=998,iostat=istat) x,y,text,icode,size
      length=leftj(text)
      endif
      go to 70
   40 if(length.lt.2) then
      read(24,*,err=998,iostat=istat) x,y,ltext(1),icode,size,theta
      else
      read(24,*,err=998,iostat=istat) x,y,text,icode,size,theta
      length=leftj(text)
      endif
      go to 70
   50 if(length.lt.2) then
      read(24,*,err=998,iostat=istat)x,y,ltext(1),icode,size,theta,xoff
      else
      read(24,*,err=998,iostat=istat)x,y,text,icode,size,theta,xoff
      length=leftj(text)
      endif
      go to 70
   60 if(length.lt.2)then
      read(24,*,err=998,iostat=istat)x,y,ltext(1),icode,size,theta,
     & xoff,yoff
      else
      read(24,*,err=998,iostat=istat)x,y,text,icode,size,theta,
     & xoff,yoff
      length=leftj(text)
      endif
   70 call vchar(x,y,ltext,length,icode,size,theta,xoff,yoff)
      go to 10
  997 print *,'error opening text file; error no. = ',istat
      go to   999
  998 print *,'error reading text file; error no. = ',istat
  999 close(24)
      return
      end
C________________________________________________________________
C
C      SUBROUTINE FREERD
C________________________________________________________________
C SUBROUTINE FREE READ UTILIZES ASCIIP TO READ
C AN ASCII RECORD AND BREAK IT INTO FIELDS. FIELS MAY BE
C SEPARATED BY ANY COMBINATION OF BLANKS AND COMMMAS.  CARRIAGE
C RETURNS (END-OF-RECORD) MAY INDICATE FIELD DELIMITERS, EOR, OR
C EOF DEPENDING ON THE VALUE OF NREAD AND NFIELD.  DITTO MARKS
C (A SINGLE DECIMAL (.)) MAY BE USED TO ASSIGN THE VALUE FROM THE
C LAST (MOST RECENT) CALL TO FREEREAD3 IN THE CORROSPONDING FIELD
C TO THE FIELD OF THE DITTO MARK IN THE PRESENT CALL.
C
C THE MAXIMUM ACCUMULATIVE FIELD LENGTH FOR ANY ONE CALL IS
C 80 CHARACTERS.  THIS SUBROUTINE IS INTENDED FOR TERMINAL
C ENTRY OR SMALL ASCII FILES WHICH REQUIRE GREAT READING
C FLEXIBILITY.
C
C   IUNIT  - INTEGER*4.  UNIT NUMBER TO BE READ.  THIS MAY BE A
C            TERMINAL KEYBOARD OR ANY FILE (DISK, TAPE, ETC).
C   NFIELD - INTEGER*4.  TOTAL NUMBER OF FIELDS ACTUALLY READ.
C   FIELDS - CHARACTER*(*).  CHARACTER ARRAY CONTAINING THE
C            FIELDS WHICH ARE READ IN.  EACH ELEMENT OF THE ARRAY
C            CONTAINS ONE FIELD.
C   NREAD  - INTEGER*4.  DETERMINES WHETHER A CARRIAGE RETURN IS
C            A FIELD DELIMITER (TYPICALLY SPACE, COMMA),
C            AN END-OF-REC MARKER (TYPICALLY CARRIAGE RETURN),
C            OR AN END-OF-FILE MARKER (TYPICALLY CONTROL-Z,
C            E-O-F, EXIT).  THE FIELD DELIMITER INDICATES
C            BEGINNING OF A NEW FIELD AND CONTROL REMAINS IN
C            FREEREAD3.  THE END-OF-REC MARKER INDICATES THAT
C            ALL FIELDS FOR THIS RECORD HAVE BEEN ACCUMULATED AND
C            CONTROL IS TRANSFERED BACK TO THE CALLING ROUTINE.
C            THE END-OF-FILE MARKER INDICATES THAT THERE IS NO
C            DATA AVAILABLE ON THIS CALL AND CONTROL IS
C            TRANSFERED BACK TO THE CALLING ROUTINE VIA THE
C            STARRED (*) RETURN.  FOLLOWING IS A DESCRIPTION OF
C            HOW A CARRIAGE RETURN (OR END OF RECORD) BEHAVES AS
C            A FUNCTION OF THE VALUE OF NREAD AND THE NUMBER OF
C            FIELDS READ IN (NFIELD):
C
C              NREAD > 0:  0 =< NFIELD < NREAD:  FIELD DELIM.
C                          NFIELD >= NREAD:  END-OF-REC.
C              NREAD = 0:  FOR ALL NFIELD:  END-OF-REC.
C              NREAD < 0:  NFIELD = 0:  END-OF-FILE *2.
C                          0 < NFIELD < ABS(NREAD):  FIELD DELIM.
C                          NFIELD >= ABS(NREAD):  END-OF-REC.
C                          LAST FIELD WAS 'EXIT':  END-OF-FILE *1
C
C              FOR ALL NREAD AND NFIELD CONTROL-Z AND E-O-F ARE
C              END-OF-FILE *1 MARKERS.  WARNING:  CONTROL-Z DOES
C              SOME UNPREDICTABLE THINGS IN ADDITION TO WHAT IT'S
C              SUPPOSED TO DO.  IT IS RECOMMENDED THAT THE USER
C              AVOID IT ALL TOGETHER.
C
C   *1     - LINE NUMBER TO WHICH CONTROL IS RETURNED IN THE
C            CASE OF AN END-OF-FILE *1
C   *2     - LINE NUMBER TO WHICH CONTROL IS RETURNED IN THE
C            CASE OF AN END-OF-FILE *2
C
C SUBROUTINE FREEREAD3 WRITTEN BY ROB BRACKEN, USGS, 20JUL87.
C
C
      subroutine freerd(iunit,nfield,fields,nread,*,*)
      save
C
      character*(*) fields(1)
      character*80 alphnu,alphn2
      character*5 ftest
      character*1 ditto
      data alphnu /' '/
C
C REMEMBER LAST READ
C
      alphn2=alphnu
C
C READ THE FILE
C
      i=1
      nfield=0
  102 read(iunit,801,end=998) alphnu
  801 format(a80)
C
C PARSE THE LINE FROM THE FILE
C
      ditto=' '
      call asciip(80,alphnu,ditto,nfield,fields(i))
C
C DETERMINE IF THE PROPER NUMBER OF FIELDS HAVE BEEN READ
C
      i=i+nfield
      nfield=i-1
      if(nread.lt.0) then
        if(i.eq.1) goto 997
        ftest=fields(i-1)
        call upperc(ftest,5)
        if(ftest.eq.'EXIT ') goto 998
      endif
      if(nread.ne.0.and.i.le.abs(nread)) goto 102
C
C FILL IN THE DITTO MARKS
C
      ditto='.'
      call asciip(80,alphn2,ditto,nfld2,fields)
C
C SET UP ALPHNU WITH PRESENT SET OF FIELDS
C
      lent=0
      do 20 j=1,nfield
        do 10 len=1,80
          if(fields(j)(len:len).eq.' ') goto 101
   10   continue
  101   alphnu(lent+1:lent+len)=fields(j)(1:len)
        lent=lent+len
   20 continue
      if(lent.lt.80) alphnu(lent+1:80)=' '
C
C CUT OUT ANY FIELDS BEYOND THE LAST FIELD IN THIS READ
C
      if(nfield.lt.nfld2) then
        do 30 i=nfield+1,nfld2
          fields(i)=' '
   30   continue
      endif
C
C NORMAL RETURN
C
      rewind(24)
      write(24,*) (fields(i),i=1,nfield)
      rewind(24)
  999 return
C
C END OF FILE REACHED
C
  998 alphnu=' '
      return 1
  997 alphnu=' '
      return 2
      end
C________________________________________________________________
C
C     SUBROUTINE  A S C I I P
C________________________________________________________________
C
C SUBROUTINE ASCII PARSE TAKES A CHARACTER VARIABLE OF ANY LENGTH
C AND DETERMINES WHERE THE DATA FIELDS ARE.  THE FIELDS MUST BE
C SEPARATED BY A BLANK SPACE OR A COMMA (AS IN THE VMS STANDARD).
C
C   MXLEN  - INTEGER*4.  MAXIMUM ALLOWABLE LENGTH OF THE INPUT
C            CHARACTER VARIABLE.
C   ALPHNU - CHARACTER*(*).  CHARACTER (ALPHA-NUMERIC) VARIABLE
C            TO BE PARSED.
C   DITTO  - CHARACTER*1.  THE SYMBOL WHICH IS TO BE USED AS A
C            DITTO MARK.  IF DITTO IS BLANK THEN NO DITTO
C            FUNCTION WILL BE PERFORMED.  SEE "FIELDS".
C   NFIELD - INTEGER*4.  THE NUMBER OF FIELDS WHICH WERE READ IN.
C   FIELDS - CHARACTER*(*).  CHARACTER (ALPHA-NUMERIC) VARIABLE
C            ARRAY TO WHICH THE FIELDS WILL BE READ FROM ALPHNU.
C            EACH ARRAY POSITION IN "FIELDS" WILL CONTAIN A
C            SINGLE FIELD.  IF DITTO IS BLANK ALL FIELDS WILL BE
C            READ FROM ALPHNU TO "FIELDS".  IF DITTO IS NOT BLANK
C            THEN ONLY THOSE ARRAY POSITIONS IN "FIELDS" WHICH
C            CONTAIN A SINGLE DITTO CHARACTER WILL BE FILLED.
C
C SUBROUTINE ASCIIPARSE WRITTEN BY ROB BRACKEN, USGS, 20JUL87.
C
C
      subroutine asciip(mxlen,alphnu,ditto,nfield,fields)
C
      character*(*) alphnu,fields(1)
      character*1 ditto,apos
      logical*4 blank,text,iapos
      data apos/''''/
C
C INIALIZE VARIABLES
C
      blank=.true.
      iapos=.false.
      text=.false.
      nfield=0
C
C SET UP ARRAY CONTAINING FIELDS.
C
      do 10 i=1,mxlen
      if(alphnu(i:i).eq.apos) then
       if(.not.text) then
       if(.not.iapos) then
C      FIRST APOSTROPHY READ
       text=.true.
       ibeg=i
       else
C      TWO APOSTROPHYS IN A ROW SO IT IS PART OF TEXT
       text=.true.
       nfield=nfield-1
       endif
      else
C      SECOND APOSTROPHY READ-TEXT FIELD COMPLETE
       text=.false.
       nfield=nfield+1
       if(ditto.eq.' '.or.fields(nfield).eq.ditto)
     1 fields(nfield)=alphnu(ibeg:i)
       blank=.true.
       iapos=.true.
      endif
        else if(alphnu(i:i).eq.' '.or.alphnu(i:i).eq.','
     1          .and.(.not.text)) then
          iapos=.false.
          if(.not.blank) then
C ---       PREVIOUS FIELD NON-BLANK/PRESENT FIELD BLANK ---
            nfield=nfield+1
            if(ditto.eq.' '.or.fields(nfield).eq.ditto)
     1       fields(nfield)=alphnu(ibeg:i-1)
            blank=.true.
          end if
        else
          if(blank.and.(.not.text)) then
C ---       PREVIOUS FIELD BLANK/PRESENT FIELD NON-BLANK ---
            ibeg=i
            blank=.false.
          end if
        end if
   10 continue
      if(.not.blank) then
C ---   FINAL FIELD NON-BLANK ---
        nfield=nfield+1
        if(ditto.eq.' '.or.fields(nfield).eq.ditto)
     1   fields(nfield)=alphnu(ibeg:i-1)
        blank=.true.
      end if
C
C EXIT PROCEDURE
C
  199 return
      end
C________________________________________________________________
C
C     SUBROUTINE  U P P E R C
C________________________________________________________________
C
C SUBROUTINE UPPER CASE CONVERTS ALPHA-NUMERIC VARIABLES INTO
C ALL UPPER CASE LETTERS.
C
C   ALPHA  - CHARACTER*(*).  ALPHA-NUMERIC TO BE CONVERTED.
C   LENGTH - INTEGER*4.  LENGTH OF ALPHA.
C
C SUBROUTINE UPPERC WRITTEN BY ROB BRACKEN, USGS, 17JUL87.
C
C
      subroutine upperc(alpha,length)
C
      character*(*) alpha
C
      do 10 i=1,length
        k=ichar(alpha(i:i))
        if(k.ge.97.and.k.le.122) then
          alpha(i:i)=char(k-32)
        end if
   10 continue
      return
      end

