subroutine inputpoi(pri,infile,iscree,ierr,coeg,
     & node,nocon,nelcon,refchr)
*
*********************************************************
*     read input; set up data sets     
*********************************************************
*
*     output arrays:
*
*     segd "pri(lasegd)" data for boundary condtitions
*          for all boundary segments
*     isegd "pri(laisgd)" type of boundary for all b. seg.
*                         = 1 neumann
*                         = 2 robin
*                         =-1 dirichlet
*
*********************************************************
      implicit double precision (a-h,o-z)
      character*3 refchr
      dimension pri(*), iwork(200), work(110)
      dimension coeg(2,*), node(3,*), nocon(*), nelcon(3,*)
*
      common /comnav/
     & tol,digits,
     & mact,nelr,nno,ielfr,neltot,maxt,maxv,maxl,lvl,
     & inofr,nrgre,nvact,nrtri,nelact
*
      call re1(pri,iwork,work,infile,iscree,ierr,
     & coeg,node,nocon,nelcon,refchr)
*
      return
      end
*
*
*
      subroutine re1(pri,iwor,work,infile,iscree,ierr,
     & coeg,node,nocon,nelcon,refchr)
*
*********************************************************
*     read input file        
*********************************************************
*
      implicit double precision (a-h,o-z)
      character*4 com(15)
      character*3 refchr
      character*80 rhscha,cndcha(3),cnvcha(2),abscha,extract
      dimension pri(*), iwor(*), work(*)
      dimension coeg(2,*), node(3,*), nocon(*), nelcon(3,*)
*
      common /poisson/ nrhs,ncond,nconv,nabso,numseg
      common /pointer/ larhd,lacond,laconv,laabso,lasegd,laisgd
      common /comnav/
     & tol,digits,
     & mact,nelr,nno,ielfr,neltot,maxt,maxv,maxl,lvl,
     & inofr,nrgre,nvact,nrtri,nelact
      common /chardata/ idrhs,idcnd,idcnv,idabs,
     $     rhscha,cndcha,cnvcha,abscha
*
*********************************************************
*     read and echo commands      
*********************************************************
*
      nrec = 0
      nrhs = 0
      ncond = 0
      nconv = 0
      nabso = 0
      numsb = 0
*
      write(6,*) ' Start input read. commands:'
*
*     first: read in mesh
*
 5    continue
      read (infile,501,end=8050,err=8000) (com(j),j=1,15)
      if (com(1).eq.'MESH') then
*
*********************************************************
*     read mesh    
*********************************************************
*
         write(6,*) (com(j),j=1,15)
         read (infile,*,err=8000) nno,mact
         call readme(iscree,infile,coeg,node,
     &        nno,mact,nrec,ierr)
         nrtri=mact
         rewind(infile)
         go to 1
      endif
      goto 5
    1 continue
*
      read (infile,501,end=25,err=8000) (com(j),j=1,15)
      nrec = nrec + 1
      if (com(1).eq.'Conv') goto 1
      call fixupp(com,60)
      if (com(1).eq.'    ') go to 1
      if (com(1).eq.'C   ') go to 1
      if (com(1).eq.'RIGH') then
         write(6,*) (com(j),j=1,15)
         read (infile,*,err=8000) nrhs
         read (infile,*,err=8000) idrhs
         go to 120
      endif
      if (com(1).eq.'COND') then
         write(6,*) (com(j),j=1,15)
         read (infile,*,err=8000) ncond
         read (infile,*,err=8000) idcnd
         go to 130
      endif
      if (com(1).eq.'CONV') then
         write(6,*) (com(j),j=1,15)
         read (infile,*,err=8000) nconv
         read (infile,*,err=8000) idcnv
         go to 140
      endif
      if (com(1).eq.'ABSO') then
         write(6,*) (com(j),j=1,15)
         read (infile,*,err=8000) nabso
         read (infile,*,err=8000) idabs
         go to 150
      endif
      if (com(1).eq.'REFI') go to 160
      if (com(1).eq.'NODE') go to 180
      if (com(1).eq.'BOUN') go to 190
      if (com(1).eq.'EOD ') go to 1000
      if (com(1).eq.'END ') go to 1000
      goto 1
*
   25 continue
      write(6,*) 'End of file mark detected'
      go to 1000
  120 continue
*
*********************************************************
*     read right-hand side 
*********************************************************
*
      if(idrhs.eq.0) then
         ndata=1
         larhd=1
      endif
      if(idrhs.eq.1) then
         ndata=3
         call dimpr(pri,ndata,nrhs,8,larhd,1)
         lairhd=1
      endif
      if(idrhs.eq.2) then
         ndata=nrhs
         nrhs=1
         call dimpr(pri,nrhs,nrtri,8,larhd,1)
      endif
*
      call readsc(iscree,infile,pri(larhd),
     & nrhs,ndata,nrec,idrhs,extract,ierr)
      if(idrhs.eq.0) call exchar(extract,rhscha,1)
      if (ierr.ne.0) go to 9000
      go to 1
*
  130 continue
*
*********************************************************
*     read conductivity data 
*********************************************************
*
      if(idcnd.eq.0) then
         ndata=1
         lacond=1
      endif
      if(idcnd.eq.1) then
         ndata=5
         call dimpr(pri,ndata,ncond,8,lacond,1)
      endif
      if(idcnd.eq.2) then
         ndata=ncond
         ncond=3
         call dimpr(pri,ncond,nrtri,8,lacond,1)
      endif
*
      call readsc(iscree,infile,pri(lacond),
     & ncond,ndata,nrec,idcnd,extract,ierr)
      if(idcnd.eq.0) call exchar(extract,cndcha,3)
      if (ierr.ne.0) go to 9000
      go to 1
*
  140 continue
*
*********************************************************
*     read convection data       
*********************************************************
*
      if(idcnv.eq.0) then
         ndata=1
         laconv=1
      endif
      if(idcnv.eq.1) then
         ndata=4
         call dimpr(pri,ndata,nconv,8,laconv,1)
      endif
      if(idcnv.eq.2) then
         ndata=nconv
         nconv=2
         call dimpr(pri,nrtri,nconv,8,laconv,1)
      endif
*
      call readsc(iscree,infile,pri(laconv),
     & nconv,ndata,nrec,idcnv,extract,ierr)
      if(idcnv.eq.0) call exchar(extract,cnvcha,2)
      if (ierr.ne.0) go to 9000
      go to 1
*
  150 continue
*
*********************************************************
*     read absorption data 
*********************************************************
*
      if(idabs.eq.0) then
         ndata=1
         laabso=1
      endif
      if(idabs.eq.1) then
         ndata=3
         call dimpr(pri,ndata,nabso,8,laabso,1)
      endif
      if(idabs.eq.2) then
         ndata=nabso
         nabso=1
         call dimpr(pri,nrtri,nabso,8,laabso,1)
      endif
*
      call readsc(iscree,infile,pri(laabso),
     & nabso,ndata,nrec,idabs,extract,ierr)
      if(idabs.eq.0) call exchar(extract,abscha,1)
      if (ierr.ne.0) go to 9000
      go to 1
*
  160 continue
*
*********************************************************
*     read refinement data   
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      read (infile,*,err=8000) tol,maxl,refchr
      if(refchr.ne.'ENE'.and.refchr.ne.'MAX'.and.
     & refchr.ne.'RMS') goto 8010
      go to 1
*
*
  180 continue
*
*********************************************************
*     read nodes on segments    
*********************************************************
*
      write(6,*) (com(j),j=1,15)
      ns1=55
      open(ns1,file='temp1.scratch',access='sequential',
     & form='unformatted',status='unknown')
*
      call readns(iscree,infile,ns1,
     & nrec,numseg,maxpo,ierr)
      go to 1
*
  190 continue
*
*********************************************************
*     read boundary conditions    
*********************************************************
*
*
      write(6,*) (com(j),j=1,15)
      ns2=56
      open(ns2,file='temp2.scratch',access='sequential',
     & form='unformatted',status='unknown')
      call readby(iscree,infile,ns2,nrec,ierr)
      if(ierr.ne.0) goto 9000
      go to 1
*
 1000 continue
*
*********************************************************
*     end of file     
*********************************************************
*
      close (infile,status='keep',err=8020)
*
*     arrange data
*
      call dimpr(pri,2,numseg,8,lasegd,1)
      call dimpr(pri,1,numseg,4,laisgd,1)
*
      call segda(iscree,ns2,numseg,
     m pri(lasegd),pri(laisgd),ierr)
*      call dwmatg(pri(lasegd),2,numseg,0,'rd','segdat1')
      if(ierr.ne.0) goto 9000
*
      maxpo=maxpo+1
      nmax=max0(4*nno*4,numseg*maxpo)
*
      call dimpr(pri,2,nno,4,lab,1)
      call dimpr(pri,1,nmax,4,laa,1)
*****************************************
*     BELOW FOR NORMAL VECTORS
*****************************************
      call arrda(ns1,maxpo,numseg,pri(laa),pri(laisgd),nocon,
     & pri(lab))
      call zerop(pri(laa),nmax*8)
*
*      call dwmatg(pri(lab),2,nno,0,'i','nodseg')
*      call dwmatg(nocon,1,nno,0,'i','nocon')
*      write(6,*) 'before nodlis'
      call nodlis(nno,mact,pri(laa),node,nlist,3)
      call edgcr(mact,pri(laa),node,nelcon,pri(lab))
*
      call dimpr(pri,1,nmax,4,laa,-1)
      call dimpr(pri,2,nno,4,lab,-1)
*
      close (ns1,status='delete')
      close (ns2,status='delete')
*
      go to 9000
*
*********************************************************
*     error exits    
*********************************************************
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & ' Error: failed to read from input file (0), line no.',nrec
      go to 9000
 8010 continue
      ierr = 101
      write(6,*) ' Error: unrecognized command; record no.',nrec
      go to 9000
 8020 continue
      ierr = 3
      write(6,*) ' Error: failed to close input file'
      go to 9000
 8030 continue
      ierr = 4
      write(6,*) 
     & ' Error: attempt to open too many input files; record no.',nrec
      go to 9000
 8040 continue
      ierr = 6
      write(6,*) ' Error: failed to open auxiliary input file'
*
 8050 continue
      ierr = 116
      write(6,*) ' Error: mesh does not exist'
*
 9000 continue
      write(6,*) ' End input read.'
      write(6,*) ' Number of lines processed:',nrec
*
      return
  501 format (15a4)
      end
*
      subroutine readsc(
     i     iw,in,data,nrows,ndata,
     m     nrec,idfoo,foo,ierr)
*********************************************************
*     read data        
*********************************************************
*     
      implicit double precision (a-h,o-z)
      dimension data(nrows,*)
      character*80 foo
*     
*********************************************************
*     read point numbers and coordinates   
*********************************************************
*     
*      write(*,*) 'idfoo=',idfoo,' ndata=',ndata,' nrows=',nrows
      if(idfoo.eq.0)  read(in,100,err=8000) foo
*
      if(idfoo.eq.1) then
         do i = 1, nrows
            read(in,*,err=8000) (data(i,j),j=1,ndata)
             nrec = nrec + 1
         enddo
      endif
*
      if(idfoo.eq.2) then
         do i = 1, ndata
            read(in,*,err=8000) iel,(data(j,iel),j=1,nrows)
            nrec = nrec + 1
         enddo
      endif
      go to 9000
*     
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     &     ' Error: failed to read from input file (1), line no.',nrec
      go to 9000
*     
 9000 continue
      return
 100  format(80A)
*     
      end
      subroutine readme(
     i iw,in,coeg,nodes,nno,nele,
     m nrec,ierr)
*********************************************************
*     read mesh     
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension coeg(2,*), nodes(3,*)
*
*********************************************************
*     read coordinates and nodes on elements 
*********************************************************
*
      do 10 i = 1, nno
      read(in,*,err=8000) (coeg(j,i),j=1,2)
      nrec = nrec + 1
   10 continue
      do 20 i = 1, nele
      read(in,*,err=8000) (nodes(j,i),j=1,3)
      nrec = nrec + 1
   20 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & ' Error: failed to read from input file (2), line no.',nrec
      go to 9000
*
 9000 continue
      return
*
      end
*
*
*
      subroutine readns(
     i iw,in,ns,
     m nrec,numseg,maxpo,ierr)
*********************************************************
*     read data     
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension nv(10)
*
*********************************************************
*     read point numbers and coordinates 
*********************************************************
*
      read(in,*,err=8000) numseg
      nrec = nrec + 1
      maxpo=0
      do 60 i = 1, numseg
         read(in,*,err=8000) isname,npoin
         write(ns) isname,npoin
         maxpo=max0(maxpo,npoin)
         nrec = nrec + 1
         nlin=npoin/10
         nextra = npoin - nlin*10
         if(nlin.eq.0) goto 30
         do 20 j=1,nlin
            read(in,*,err=8000) (nv(k),k=1,10)
            write(ns) (nv(k),k=1,10)
            nrec = nrec + 1
20       continue
30       continue
         if(nextra.gt.0) then
            read(in,*,err=8000) (nv(j),j=1,nextra)
            write(ns) (nv(k),k=1,nextra)
            nrec = nrec + 1
         endif
60    continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & ' Error: failed to read from input file (3), line no.',nrec
      go to 9000
*
 9000 continue
      return
*
      end
*
*
*
      subroutine xxreadby(
     i iw,in,ns,
     m nrec,ierr)
*
*********************************************************
*     read data
*********************************************************
*
      implicit double precision (a-h,o-z)
      character nc(1)
*
*********************************************************
*     read point numbers and coordinates 
*********************************************************
*
      rewind(ns)
      read(in,*,err=8000) numsb
      nrec = nrec + 1
      write(ns) numsb
      do 60 i = 1, numsb
         read(in,*,err=8000) isname,nc(1)
         nrec = nrec + 1
         if(nc(1).eq.'n'.or.nc(1).eq.'N') noc=1
         if(nc(1).eq.'r'.or.nc(1).eq.'R') noc=2
         if(nc(1).eq.'d'.or.nc(1).eq.'D') noc=-1
         if(noc.eq.2) then
            read(in,*,err=8000) data1,data2
         else
            read(in,*,err=8000) data1
            data2=0.d0
         endif
         write(ns) isname,noc,data1,data2
         nrec = nrec + 1
   60 continue
      go to 9000
*
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & ' Error: failed to read from input file (4), line no.',nrec
 9000 continue
      return
*
      end
      subroutine readby(
     i iw,in,ns,
     m nrec,ierr)
*
*********************************************************
*     read data
*********************************************************
*
      implicit double precision (a-h,o-z)
      character nc(1)
      character*40 line
*
*********************************************************
*     read point numbers and coordinates 
*********************************************************
*
      rewind(ns)
      read(in,*,err=8000) numsb
      nrec = nrec + 1
      write(ns) numsb
      do 60 i = 1, numsb
         read(in,999)line
         backspace(in)
         read(in,*)isname
         if(index(line,'N') .ne. 0) nc(1) = 'N'
         if(index(line,'R') .ne. 0) nc(1) = 'R'
         if(index(line,'D') .ne. 0) nc(1) = 'D'
         if(index(line,'n') .ne. 0) nc(1) = 'N'
         if(index(line,'r') .ne. 0) nc(1) = 'R'
         if(index(line,'d') .ne. 0) nc(1) = 'D'

         nrec = nrec + 1
         if(nc(1).eq.'n'.or.nc(1).eq.'N') noc=1
         if(nc(1).eq.'r'.or.nc(1).eq.'R') noc=2
         if(nc(1).eq.'d'.or.nc(1).eq.'D') noc=-1
         if(noc.eq.2) then
            read(in,*,err=8000) data1,data2
         else
            read(in,*,err=8000) data1
            data2=0.d0
         endif
         write(ns) isname,noc,data1,data2
         nrec = nrec + 1
   60 continue
      go to 9000
*
 999  format(a)
 8000 continue
      ierr = 5
      nrec = nrec + 1
      write(6,*) 
     & ' Error: failed to read from input file (4), line no.',nrec
 9000 continue
      return
*
      end
*
*
*
*
      subroutine segda(
     i iw,ns,numseg,
     m segd,isegd,ierr)
*
*********************************************************
*     read data
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension segd(2,*),isegd(*)
*
*********************************************************
*     read point numbers and coordinates 
*********************************************************
*
      rewind(ns)
      nrec = nrec + 1
      read(ns) numsb
      do 60 i = 1, numsb
         read(ns) isname,noc,data1,data2
         if(isname.gt.numseg) goto 8000
         segd(1,isname)=data1
         segd(2,isname)=data2
         isegd(isname)=noc
   60 continue
      go to 9000
*
 8000 continue
      ierr = 5
      write(6,*) ' Error: segments not numbered consecutively.'
*
 9000 continue
      return
*
      end
*
      subroutine fixupp(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 arrda(ns,maxpo,numseg,inod,isgd,nocon,nods)
      dimension inod(numseg,*),isgd(*),nocon(*),nods(2,*),nv(10)
*
      rewind(ns) 
      do 60 i = 1, numseg
         read(ns) isname,npoin
         maxpo=max0(maxpo,npoin)
         nrec = nrec + 1
         nlin=npoin/10
         nextra = npoin - nlin*10
         ip = 0
         if(nlin.eq.0) goto 30
         do 20 j=1,nlin
            read(ns) (nv(k),k=1,10)
            do 10 k=1,10
               ip = ip + 1
               inod(i,ip)=nv(k)
               if(nods(1,nv(k)).eq.0) then
                  nods(1,nv(k)) = i
               else
                  nods(2,nv(k)) = i
               endif
10          continue
20       continue
30       continue
         if(nextra.gt.0) then
            read(ns) (nv(k),k=1,nextra)
            do 40 k=1,nextra
               ip = ip + 1
               inod(i,ip)=nv(k)
               if(nods(1,nv(k)).eq.0) then
                  nods(1,nv(k)) = i
               else
                  nods(2,nv(k)) = i
               endif
40          continue
         endif
      inod(i,maxpo)=ip
60    continue
*
      do 90 i=1,numseg
         ntyp=isgd(i)
         if(ntyp.eq.0) goto 90
         ip=inod(i,maxpo)
         if(ip.eq.0) goto 80
         do 70 j=1,ip
            nod=inod(i,j)
            if(nocon(nod).eq.1.or.nocon(nod).eq.0) then
               nocon(nod)=ntyp
               goto 70
            endif
            if(nocon(nod).eq.2) then
               if(ntyp.eq.-1) nocon(nod)=ntyp
               goto 70
            endif
70       continue
80       continue
90    continue
      return
      end
*
*
*
      subroutine edgcr(nele,nodel,nodes,nelcon,nodseg)
*
      implicit double precision (a-h,o-z)
      dimension nodel(4,*),nodes(3,*),nelcon(3,*),nodseg(2,*)
*
*********************************************************
*     create edge connections   
*********************************************************
*
      do 50 iel=1,nele
      iv1=nodes(1,iel)
      iv2=nodes(2,iel)
      iv3=nodes(3,iel)
      do 40 i=1,3
*
*     segments for iv2 and iv3
*
      iseg21=nodseg(1,iv2)
      iseg22=nodseg(2,iv2)
      iseg31=nodseg(1,iv3)
      iseg32=nodseg(2,iv3)
      if(iseg22.ne.0.and.iseg32.ne.0) then
         if(iseg21.eq.iseg31) isname=iseg21
         if(iseg22.eq.iseg31) isname=iseg22
         if(iseg22.eq.iseg32) isname=iseg22
         if(iseg21.eq.iseg32) isname=iseg21
         goto 5
      endif
      if(iseg22.ne.0) then
         isname=iseg31
         goto 5
      endif
      isname=iseg21
 5    continue
*
*********************************************************
*     first loop for iv2   
*********************************************************
*
      inod1=iv2
10    continue
      ik1=nodel(4,inod1)
      inr1=ik1
      if(ik1.lt.0) inr1=3
      do 30 ites1=1,inr1
      iel1=nodel(ites1,inod1)
      if(iel1.eq.iel) goto 30
*
*********************************************************
*     second loop for iv3  
*********************************************************
*
      inod2=iv3
20    continue
      ik2=nodel(4,inod2)
      inr2=ik2
      if(ik2.lt.0) inr2=3
      do 25 ites2=1,inr2
      iel2=nodel(ites2,inod2)
      if(iel1.eq.iel2) goto 35
25    continue
      if(ik2.lt.0) inod2=-ik2
      if(ik2.lt.0) goto 20
30    continue
      if(ik1.lt.0) inod1=-ik1
      if(ik1.lt.0) goto 10
      nelcon(i,iel)=-isname
      goto 36
35    continue
      nelcon(i,iel)=iel1
36    ii=iv1
      iv1=iv2
      iv2=iv3
      iv3=ii
40    continue
50    continue
      return
      end
      subroutine exchar(extract,foo,nsize)
      character extract(*),foo(80,*)
*
      i1=1
      do j=1,80
         if(extract(j).ne.';') then
            foo(j,i1)=extract(j)
         else
            i1=i1+1
            if(i1.gt.nsize) goto 9000
         endif
      enddo 
 9000 continue
      return
      end