subroutine inputdat(pri,ierr)
*
*********************************************************
*     read input; set up data sets
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension pri(*), iwork(200), work(110)
*
      call in1(pri,iwork,work,ierr)
      call in2(pri,iwork,work,ierr)
*
      return
      end
*
*
*
      subroutine in1(pri,iwor,work,ierr)
*
*********************************************************
*     read input file
*********************************************************
*
      implicit double precision (a-h,o-z)
      character*4 com(15)
      dimension pri(*), iwor(*), work(*)
      common /files/ infile,iofile,iscree
      common /misc/ maxpo,numpo,numse,numint,
     & maxsb,numbo,nsab,numms,numcseg,nexmax
*
*********************************************************
*     read and echo commands
*********************************************************
*
      nrec = 0
      numse = 0
      maxpo = 0
      numpo = 0
      numbo = 0
      numint = 0
      numms = 0
      numcseg = 0
      nexmax = 0
*
      write(6,*) 'Start input read. commands:'
    1 continue
      read (infile,501,end=25,err=8000) (com(j),j=1,15)
      nrec = nrec + 1
      call fixup(com,60)
      if (com(1).eq.'    ') go to 1
      if (com(1).eq.'C  ') go to 1
      if (com(1).eq.'POIN') go to 120
      if (com(1).eq.'SEGM') go to 130
      if (com(1).eq.'LINE') go to 130
      if (com(1).eq.'OUTE') go to 140
      if (com(1).eq.'INNE') go to 140
      if (com(1).eq.'INTE') go to 140
      if (com(1).eq.'SIZE') go to 150
      if (com(1).eq.'CURV') go to 160
      if (com(1).eq.'MESH') go to 8050
      if (com(1).eq.'EOD ') go to 1000
      if (com(1).eq.'END ') go to 1000
*      ierr = 101
      go to 1
*
   25 continue
      write(6,*) 'End of file mark detected'
      go to 1000
  120 continue
*
*********************************************************
*     read points
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns=11
      open(ns,file='point.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readpo(iscree,infile,ns,iwor,work,maxpo,numpo,
     & nrec,ierr)
      if (ierr.ne.0) go to 9000
      go to 1
*
  130 continue
*
*********************************************************
*     read (line) segments
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns=12
      open(ns,file='line.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readlin(iscree,infile,ns,iwor,work,
     & numse,nrec,ierr)
      if (ierr.ne.0) go to 9000
      go to 1
*
  140 continue
*
*********************************************************
*     read boundaries
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns=13
      open(ns,file='bound.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readbo(iscree,infile,ns,com(1),iwor,work,
     & maxsb,numbo,numint,nsab,nrec,ierr)
      if (ierr.ne.0) go to 9000
      go to 1
*
  150 continue
*
*********************************************************
*     read meshsize
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns=14
      open(ns,file='size.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readms(iscree,infile,ns,iwor,work,
     & numms,nrec,ierr)
      if (ierr.ne.0) go to 9000
      go to 1
*
  160 continue
*
*********************************************************
*     read curved boundaries
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns=15
      open(ns,file='curve.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readcu(iscree,infile,ns,work,
     & numcseg,nexmax,nrec,ierr)
      if (ierr.ne.0) go to 9000
      go to 1
*
 1000 continue
*
*********************************************************
*     end of file 
*********************************************************
*
      go to 9000
*
*********************************************************
*     error exits
*********************************************************
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 'Error: failed to read from input file, line no.',nrec
      go to 9000
 8010 continue
      write(6,*) 'Error: unrecognized command; record no.',nrec
      go to 9000
*
 8050 continue
      ierr = 116
      write(6,*) 'Mesh already created'
*
 9000 continue
      write(6,*) 'End   input read.'      
      write(6,*) 'Number of lines processed:',nrec
*
      return
  501 format (15a4)
      end
*
*
*
      subroutine readpo(
     i iw,in,ns,
     w iwor,work,
     m maxpo,numpo,nrec,ierr)
*********************************************************
*     read points
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), work(*)
*
*********************************************************
*     read number of points
*********************************************************
*
      read(in,*,err=8000) iwor(1)
      nrec = nrec + 1
      nu = iwor(1)
      iwor(1) = 1
      if (nu.le.0) return
      numpo = numpo + nu
*
*********************************************************
*     read point numbers and coordinates
*********************************************************
*
      do 60 i = 1, nu
      read(in,*,err=8000) iwor(2), (work(j),j=1,2)
      nrec = nrec + 1
      if (iwor(2).le.0) go to 8010
      if (iwor(2).gt.maxpo) maxpo = iwor(2)
      write(ns) (iwor(j),j=1,2), (work(j),j=1,2)
   60 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & 'Error: failed to read from input file, line no.',nrec
      go to 9000
*
 8010 continue
      ierr = 103
      write(6,*) 
     & 'Error: non-positive point number encountered, line no.',nrec
*
 9000 continue
      return
*
      end
*
*
*
      subroutine readlin(
     i iw,in,ns,
     w iwor,work,
     m numse,nrec,ierr)
*
*********************************************************
*     read (line) segments
*
*     numse - number of defined segments
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), work(*)
*
*********************************************************
*     number of segments to read this time
*********************************************************
*
      do 11 i = 1, 11
      iwor(i) = 0
   11 continue
*
      read(in,*,err=8000) nums
      nrec = nrec + 1
      if (nums.le.0) return
*
*********************************************************
*     read the nums segments
*********************************************************
*
      numse = numse + nums
      do 300 iums = 1, nums
*
*********************************************************
*     read segment name, point names
*********************************************************
*
      iwor(1) = 2
      read(in,*,err=8000) (iwor(j),j=2,4)
      nrec = nrec + 1
      write(ns) (iwor(j),j=1,4)
  300 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & 'Error: failed to read from input file, line no.',nrec
 9000 continue
      return
      end



      subroutine readbo(
     i iw,in,ns,com,
     w iwor,work,
     m maxsb,numbo,numint,nsab,nrec,ierr)
*
*********************************************************
*     read boundaries
*
*     maxsb - max number of segments on any boundary
*     numbo - number of defined boundaries
*     nsab  - number of segments on all boundaries
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), work(*)
      character*4 com
*
*********************************************************
*     number of boundaries to be read this time
*********************************************************
*
      do 11 i = 1, 11
      iwor(i) = 0
   11 continue
*
      read(in,*,err=8000) numb
      nrec = nrec + 1
      if (numb.le.0) return
*
*********************************************************
*     read the numb boundaries
*********************************************************
*
      numbo = numbo + numb
      do 300 iumb = 1, numb
*
*********************************************************
*     read boundary name and number of segments
*********************************************************
*
      iwor(1) = 3
      read(in,*,err=8000) (iwor(j),j=2,3)
      nrec = nrec + 1
      np = iwor(3)
*      if (np.le.2) go to 8010
*
*********************************************************
*     write type of boundary: 
*     1=outer, 2=inner, 3=internal
*********************************************************
*
      if(com.eq.'OUTE') ite=1
      if(com.eq.'INNE') ite=2
      if(com.eq.'INTE') ite=3
      iwor(4) = ite
      if(ite.eq.3) numint=numint+1
      write(ns) (iwor(j),j=1,11)
*
*********************************************************
*     read the np segments on boundary 
*     number iumb (name = iwor(2))
*********************************************************
*
      iwor(1) = 4
      nsab = nsab + np
      if (np.gt.maxsb) maxsb = np
*
      nr = np/10
      if (nr.le.0) go to 70
      do 60 i = 1, nr
      read(in,*,err=8000) (iwor(j),j=2,11)
      nrec = nrec + 1
      write(ns) (iwor(j),j=1,11)
   60 continue
   70 continue
      nr = 10*nr
      nr = np - nr + 1
      if (nr.le.1) go to 300
      read(in,*,err=8000) (iwor(j),j=2,nr)
      nrec = nrec + 1
      write(ns) (iwor(j),j=1,11)
*
  300 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & 'Error: failed to read from input file, line no.',nrec
      go to 9000
 8010 continue
      ierr = 105
      write(6,*) 
     & 'Error: too few segments to define boundary, line no.',nrec
*
 9000 continue
      return
      end



      subroutine readcu(
     i iw,in,ns,
     w work,
     m numcseg,nexmax,nrec,ierr)
*
*********************************************************
*     read curved boundaries
*
*     numcseg - number of curved segments
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension work(*)
*
*********************************************************
*     number of curved segments to be read this time
*********************************************************
*
      read(in,*,err=8000) nrseg
      nrec = nrec + 1
      if (nrseg.le.0) return
*
*********************************************************
*     read the nrseg segments
*********************************************************
*
      numcseg = numcseg + nrseg
      do 300 iumb = 1, nrseg
*
*********************************************************
*     read segment name
*********************************************************
*
      read(in,*,err=8000) isegnr
      nrec = nrec + 1
      read(in,*,err=8000) istart,iend
      nrec = nrec + 1
*
*********************************************************
*     read the normal vectors for the end points of the 
*     segment isegnr
*********************************************************
*
      read(in,*,err=8000) (work(j),j=1,4)
      nrec = nrec + 1
*
*********************************************************
*     read the number of extra points given
*********************************************************
*
      read(in,*,err=8000) nextra
      nexmax=max0(nexmax,nextra)
*
      nrec = nrec + 1
*
      write(ns) isegnr,istart,iend,nextra
      write(ns) (work(j),j=1,4)
*
      if(nextra.gt.0) then
         do j=1,nextra
            read(in,*,err=8000) (work(k),k=1,4)
            nrec = nrec + 1
            write(ns) (work(k),k=1,4)
         enddo
      endif
*
  300 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & 'Error: failed to read from input file, line no.',nrec
 9000 continue
      return
      end



      subroutine readms(
     i iw,in,ns,
     w iwor,work,
     m numms,nrec,ierr)
*********************************************************
*     read meshsizes
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), work(*)
*
*********************************************************
*     read number of points with mesh data
*********************************************************
*
      read(in,*,err=8000) nu
      nrec = nrec + 1
      if (nu.le.0) return
      numms = numms + nu
*
*********************************************************
*     read point numbers and coordinates
*********************************************************
*
      do 60 i = 1, nu
      read(in,*,err=8000) (work(j),j=1,3)
      nrec = nrec + 1
      write(ns) (work(j),j=1,3)
   60 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*)
     & 'Error: failed to read from input file, line no.',nrec
      go to 9000
*
 9000 continue
      return
*
      end
*
*
*
      subroutine fixup(com,nc)
*
*********************************************************
*     remove initial blanks from a string; 
*     convert lower to upper case
*********************************************************
*
      implicit double precision (a-h,o-z)
      character com(*)
*
*********************************************************
*     if 4 first are blank: do not remove initial blanks*
*********************************************************
*
      k = 0
      do 1 i = 1, 4
      j = ichar(com(i))
      if (j.ne.32) go to 2
      k = k + 1
    1 continue
*
*********************************************************
*     first 4 are blanks -> command card; return
*********************************************************
*
      return
    2 continue
*
*********************************************************
*     remove first k blanks
*********************************************************
*
      if (k.le.0) go to 5
      kk = k + 1
      do 3 i = kk, nc
      com(i-k) = com(i)
    3 continue
*
*********************************************************
*     append blanks
*********************************************************
*
      do 4 i = 1, k
      com(nc-i+1) = char(32)
    4 continue
    5 continue
*
*********************************************************
*     convert lower case to upper case
*********************************************************
*
      kk = nc - k
      do 6 i = 1, kk
      j = ichar(com(i))
      if (j.lt.97.or.j.gt.122) go to 6
      j = j - 32
      com(i) = char(j)
    6 continue
*
      return
      end
*
*
*
      subroutine in2(pri,iwor,work,ierr)
*
*********************************************************
*     check and arrange input data
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension pri(*), iwor(*), work(*)
      common /files/ infile,iofile,iscree
      common /misc/ maxpo,numpo,numse,numint,
     & maxsb,numbo,nsab,numms,numcseg,nexmax
      common /point/ lacoep,laiseg,laibnd,lalbnd,
     & larpbg,laics,lacseg
*
      if (ierr.ne.0) return
      write(6,*) 'Start input check and data set generation.'
*
*********************************************************
*     ns = scratch file with point coordinates 
*     numpo = number of defined points
*     maxpo = max point number of any point
*     create array to store point coordinates
*********************************************************
*
      ns=11
      write(6,*) 'Check',numpo,' points'
*
      if (numpo.le.0) ierr = 106
      if (ierr.ne.0) go to 8000
      call dimpri(pri,2,maxpo,8,lacoep,1)
      call in21(iscree,ns,numpo,maxpo,iwor,work,pri(lacoep),ierr)
      if (ierr.ne.0) go to 9000
*
*********************************************************
*     ns = scratch file with segment definitions 
*     numse = number of defined segments
*     create array to store integer info about segments
*********************************************************
*
      ns=12
      write(6,*) 'Process',numse,' segments'
*
      if (numse.le.2) ierr = 107
      if (ierr.ne.0) go to 8000
      call dimpri(pri,4,numse,4,laiseg,1)
      call in22(iscree,ns,3,numse,iwor,pri(laiseg),ierr)
      if (ierr.ne.0) go to 9000
*
*********************************************************
*     ns = scratch file with boundary definitions 
*     nsu = number of defined boundaries
*     nse = number of segments on all boundaries
*     create array to store integer info about bound.
*     create array to store segments on all boundaries
*********************************************************
*
      ns=13
      write(6,*) 'Process',numbo,' boundaries'
      if (numbo.le.0) ierr = 108
      if (ierr.ne.0) go to 8000
      call dimpri(pri,4,numbo+numint,4,laibnd,1)
      call dimpri(pri,1,nsab,4,lalbnd,1)
      call in23(iscree,ns,4,numbo,iwor,pri(laibnd),pri(lalbnd),
     & ierr)
      numbo = numbo + numint
      if (ierr.ne.0) go to 9000
*
      ns=14
      write(6,*) 'Check',numms,' meshsizes'
      if (numms.le.0) ierr = 114
      if (ierr.ne.0) go to 8000
      call dimpri(pri,numms,3,8,larpbg,1)
      call in24(iscree,ns,numms,pri(larpbg),ierr)
      if (ierr.ne.0) go to 8000
*
      ns=15
      if (numcseg.le.0) goto 7000
      write(6,*) 'Check',numcseg,' curved segments'
      call dimpri(pri,numcseg,4,4,laics,1)
      call dimpri(pri,numcseg,4*(nexmax+1),8,lacseg,1)
      call in25(iscree,ns,numcseg,pri(laics),pri(lacseg),ierr)
 7000 continue
*
      go to 9000
*
 8000 continue
      if (ierr.eq.106) write(6,*) 
     & 'Error: no point has been defined.'
*
      if (ierr.eq.107) write(6,*) 
     & 'Error: too few segments have been defined.'
*
      if (ierr.eq.108) write(6,*) 
     & 'Error: no boundary has been defined.'
*
      if (ierr.eq.114) write(6,*) 
     & 'Error: no meshsize has been defined.'
*
 9000 continue
*
*     close files
*
      do 100 i=11,15
      close(unit=i,status='delete')
100   continue
*
      write(6,*) 
     & 'End   input check and data set generation.'
      return
      end
*
*
*
      subroutine in21(
     i iw,ns,numpo,max,
     w iwor,work,
     o coor,ierr)
*
*********************************************************
*     read point coordinates from scratch file
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), work(*), coor(2,*)
*
      do 2 j = 1, max
      do 1 i = 1, 2
      coor(i,j) = 0.d0
    1 continue
    2 continue
*
      rewind ns
*
      iumpo = 0
    3 continue
*
      read(ns,err=8000) (iwor(i),i=1,2), (work(i),i=1,2)
      if (iwor(1).ne.1) go to 3
*
      iumpo = iumpo + 1
      j = iwor(2)
      do 50 i = 1, 2
      coor(i,j) = work(i)
   50 continue
*
      if (iumpo.eq.numpo) go to 9000
      go to 3
*
 8000 continue
      write(6,*)
     & 'Error: failed to read from point scratch file.'
      ierr = 7
*
 9000 continue
      return
      end
*
*
*
      subroutine in22(
     i iw,ns,nrow,nums,
     w iwor,
     o nsegs,ierr)
*
*********************************************************
*     get integer segment information from scratch file
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), nsegs(nrow,*)
*
      do 2 j = 1, nums
      do 1 i = 1, nrow
      nsegs(i,j) = 0
    1 continue
    2 continue
*
      rewind ns
*
      iums = 0
    3 continue
*
*********************************************************
*     if more segments: read a record from scratch; 
*        if data for segment (iwor(1).eq.2): process
*********************************************************
*
      if (iums.eq.nums) go to 150
      read(ns,err=8000) (iwor(i),i=1,4)
      if (iwor(1).ne.2) go to 3
*
      iums = iums + 1
      do 50 i = 1, 3
      nsegs(i,iums) = iwor(i+1)
   50 continue
      go to 3
  150 continue
*
*********************************************************
*     check that segment names are unique
*********************************************************
*
      nr = nums - 1
      if (nr.le.0) go to 9000
      do 190 i = 1, nr
      name = nsegs(1,i)
      i2 = i + 1
      do 180 j = i2, nums
      if (nsegs(1,j).eq.name) go to 8010
  180 continue
  190 continue
c
      go to 9000
c
 8000 continue
      write(6,*)
     & 'Error: failed to read from segment scratch file.'
      ierr = 8
      go to 9000
 8010 continue
      write(6,*) 'Error: duplicate segment name',name
      ierr = 109
*
 9000 continue
*      call dwmatg(nsegs,nrow,nums,0,'i    ','nsegs')
      return
      end
*
*
*
      subroutine in23(
     i iw,ns,nrow,numbo,
     w iwor,
     o nbnd,lbnd,ierr)
*
*********************************************************
*     get integer boundary info from scratch file;
*     store segments on all boundaries in lbnd
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension iwor(*), nbnd(nrow,*), lbnd(*)
*
      numb = numbo
*
      do 2 j = 1, numbo
      do 1 i = 1, nrow
      nbnd(i,j) = 0
    1 continue
    2 continue
*
      rewind ns
*
      lase = 1
      iumbo = 0
    3 continue
*
*********************************************************
*     if more boundaries: read a record from scratch; 
*          if data for boundary (iwor(1).eq.3): process
*********************************************************
*
      if (iumbo.eq.numbo) go to 150
*
*********************************************************
*     read the type of boundary, check if interior 
*********************************************************
*
      read(ns,err=8000) (iwor(i),i=1,11)
      if (iwor(1).ne.3) go to 3
*
    5 continue
      iumbo = iumbo + 1
      do 50 i = 1, 2
      nbnd(i,iumbo) = iwor(i+1)
   50 continue
      nbnd(3,iumbo) = lase
      nbnd(4,iumbo) = iwor(4)
      itype = iwor(4)
*
*********************************************************
*     read and store the segments for boundary n:o iumbo*
*********************************************************
*
      nr = nbnd(2,iumbo)/10
      if (nr.le.0) go to 100
      do 80 i = 1, nr
      read(ns,err=8000) (iwor(j),j=1,11)
      do 70 j = 1, 10
      lbnd(lase) = iwor(j+1)
      lase = lase + 1
   70 continue
   80 continue
  100 continue
      nr = nbnd(2,iumbo) - 10*nr
      if (nr.le.0) go to 120
      read(ns,err=8000) (iwor(j),j=1,11)
      do 110 j = 1, nr
      lbnd(lase) = iwor(j+1)
      lase = lase + 1
  110 continue
  120 continue
      if(itype.eq.3) then
         nbnd(4,iumbo) = 3
         numb=numb + 1
         nbnd(1,numb) = nbnd(1,iumbo)
         nbnd(2,numb) = nbnd(2,iumbo)
         nbnd(3,numb) = nbnd(3,iumbo)
         nbnd(4,numb) = 4
      endif
      go to 3
*
  150 continue
*
*********************************************************
*     check that boundary names are unique
*********************************************************
*
      nr = numbo - 1
      if (nr.le.0) go to 9000
      do 190 i = 1, nr
      name = nbnd(1,i)
      i2 = i + 1
      do 180 j = i2, numbo
      if (nbnd(1,j).eq.name) go to 8010
  180 continue
  190 continue
*
      go to 9000
*
 8000 continue
      write(6,*) 'Error: failed to read from boundary scratch file.'
      ierr = 9
      go to 9000
 8010 continue
      write(6,*) 'Error: duplicate boundary name',name
      ierr = 110
*
 9000 continue
*      call dwmatg(nbnd,nrow,numb,0,'i    ','nbnd')
*      call dwmatg(lbnd,1,lase,0,'i    ','lbnd01')
      return
      end



      subroutine in24(
     i iw,ns,numms,
     o rpbg,ierr)
*
*********************************************************
*     get meshsize info from scratch file;
*     store meshsizes in rpbg
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension rpbg(numms,*)
*
      rewind ns
*
*********************************************************
*     check that meshsizes are positive 
*********************************************************
*
      do 50 iumms = 1,numms
      read(ns,err=8000) (rpbg(iumms,i),i=1,3)
      hmesh = rpbg(iumms,3)
      if(hmesh.le.0.d0) go to 8010
   50 continue
*
      go to 9000
*
 8000 continue
      write(6,*) 'Error: failed to read from meshsize scratch file.'
      ierr = 9
      go to 9000
 8010 continue
      write(6,*) 'Error: negative meshsize given'
      ierr = 115
*
 9000 continue
      return
      end



      subroutine in25(
     i iw,ns,numcseg,
     o icseg,cseg,ierr)
*
*********************************************************
*     get curved segments
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension icseg(4,*),cseg(numcseg,4,*)
*
      rewind ns
*
*********************************************************
*     check that meshsizes are positive 
*********************************************************
*
      do 50 iumms = 1,numcseg
         read(ns,err=8000) (icseg(j,iumms),j=1,4)
*
         nextra=icseg(4,iumms)
         read(ns,err=8000) (cseg(iumms,j,1),j=1,4)
         do i=2,nextra+1
            read(ns,err=8000) (cseg(iumms,j,i),j=1,4)
         enddo
   50 continue
      call dwmatg(icseg,1,numcseg,0,'i','icseg')
      call dwmatg(cseg(1,1,1),4,4,0,'rd','cseg')
*
      go to 9000
*
 8000 continue
      write(6,*) ' Error: failed to read from meshsize scratch file.'
      ierr = 9
      go to 9000
*
 9000 continue
      return
      end