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*40.  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
c      subroutine lxplot(lxfile,lxfmt,lxproj,lxunit,lxtype,ier)
       subroutine lxplot(idsk,ier)
C******MODIFIED CONSIDERABLY FOR PROGRAM CONT - APRIL,1992
C
C VARIABLE DECLARATION
C
      parameter(isize=50)
      character lxfile*40,lxfmt*16
      COMMON /LXCB/ LXFILE,LXFMT,LXPROJ,LXUNIT,LXTYPE
      dimension xlat(isize),xlon(isize),lnum(isize)
      logical eof
      character*1 ctype
      common/captur/icapt,iwhite,ctype

      ier=0
      open(idsk,file=lxfile,status='old',err=900,iostat=icheck)
      eof=.false.
        ltype = 0
        if(ctype.ne.'l') then
          if(ltype.ne.0) then
            ltype = -ltype
          else
           ltype = -7
          endif
        endif
C
C BEGIN A NEW LINE SEGMENT
C
      j=0
C
C INITIALIZE THE BRIDGING NUMBER
C
      icon=0
      icon2=0
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(lxfmt.eq.' ') then
       read(idsk,end=280,err=900,iostat=icheck) xlon(j),xlat(j),lnum(j)
      else 
       read(idsk,*,end=280,err=900,iostat=icheck)xlon(j),xlat(j),lnum(j)
      endif
      if(j.ne.1) then
        if(lnum(j).ne.lnum(j-1)) go to 380
      endif
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(xlon,xlat,j,icon,ltype)
        xlp=xlon(j)
        ylp=xlat(j)
      end if
      if(eof) go to 910
C
C SET ICON FOR NEXT CALL TO LINE
C
      icon=icon2
      if(icon.eq.0) then
C***** BRANCH TO BEGIN NEW LINE SEGMENT
        xlon(1)=xlon(j+1)
        xlat(1)=xlat(j+1)
        lnum(1)=lnum(j+1)
        j=1
      else
C***** CONTINUE WITH PRESENT SEGMENT WHEN BRIDGING
        j=0
        icon2=0
      endif
      go to 330
C
C END SEQUENCE
C
  900 print *,'error no. ',icheck,' with lxfile'
      ier=1
      go to 910
  901 xlon(1)=xlp
      xlat(1)=ylp
      call line(xlon,xlat,1,0,ltype)
  910 close(unit=idsk)
      return
      end
c****************************************************************
      subroutine txplot(idsk,ier)
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*40 txfile
      integer ltext(33)
      character*1 ctype
      common/captur/icapt,iwhite,ctype
      equivalence(text,ltext(1))
      data blank/' '/

      ier=0
      open(idsk,file=txfile,status='old',err=998,iostat=istat)
        if(ctype.eq.'l') then
        icol=1
        else
        icol=-1
        endif
      kdsk = idsk + 1
      open(kdsk,status='scratch',err=997,iostat=istat)
   10 theta=0.
      xoff=0.
      yoff=0.
      call freerd(idsk,nfield,fields,0,*999,*999,ier)
      if(ier.ne.0) return
      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(kdsk,*,err=998,iostat=istat) x,y,ltext(1),icode,size
      else
      read(kdsk,*,err=998,iostat=istat) x,y,text,icode,size
      length=leftj(text)
      endif
      go to 70
   40 if(length.lt.2) then
      read(kdsk,*,err=998,iostat=istat) x,y,ltext(1),icode,size,theta
      else
      read(kdsk,*,err=998,iostat=istat) x,y,text,icode,size,theta
      length=leftj(text)
      endif
      go to 70
   50 if(length.lt.2) then
      read(kdsk,*,err=998,iostat=istat)x,y,ltext(1),icode,size,theta,xoff
      else
      read(kdsk,*,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(kdsk,*,err=998,iostat=istat)x,y,ltext(1),icode,size,theta,
     & xoff,yoff
      else
      read(kdsk,*,err=998,iostat=istat)x,y,text,icode,size,theta,
     & xoff,yoff
      length=leftj(text)
      endif
   70 call vchar(x,y,ltext,length,icode*icol,size,theta,xoff,yoff)
      go to 10
  997 print *,'error opening text scratch file; error no. = ',istat
      ier=1
      go to   999
  998 print *,'error with text file; error no. = ',istat
      ier=1
  999 close(idsk)
      close(kdsk)
      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. FIELDS 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,*,*,ier)
      save
C
      character*(*) fields(1)
      character*80 alphnu,alphn2
      character*5 ftest
      character*1 ditto
      data alphnu /' '/
      ier=0
      kdsk = iunit + 1
C
C REMEMBER LAST READ
C
      alphn2=alphnu
C
C READ THE FILE
C
      i=1
      nfield=0
  102 read(iunit,801,end=998,err=900,iostat=icheck) 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(kdsk)
      write(kdsk,*) (fields(i),i=1,nfield)
      rewind(kdsk)
  999 return
C
C END OF FILE REACHED
C
  900 print *,'error no. ',icheck,' reading free form input'
      ier=1
      return
  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

