subroutine mesher(pri,isize,ierr)
*
*********************************************************
*     2d mesh generation			
*********************************************************
*
      implicit double precision (a-h,o-z)
      dimension pri(*)
      common /files/ infile,iofile,iscree
*
*********************************************************
*     initiate and open scratch files		
*********************************************************
*
      call dimpri(pri,isize,idum,idum,idum,2)
      call openf(ierr)
      if (ierr.ne.0) go to 7000
*
*********************************************************
*     read input and set up data sets		
*********************************************************
*
      call inputdat(pri,ierr)
      if (ierr.ne.0) go to 7000
*
*     generate mesh
*
      call generate(pri,isize,ierr)
      if (ierr.ne.0) go to 7000
*
 7000 continue
      close(unit=infile)
      close(unit=iofile)
      return
      end
      subroutine openf(ierr)
      common /files/ infile,iofile,iscree
*
*********************************************************
*     open input file; n:o 10, the screen; n:o 6
*********************************************************
*
      iscree=6
      infile=10
      open(unit=infile,file='area.scratch',status='old',err=8001)
      rewind infile
*
*********************************************************
*     open output file; n:o 16			
*********************************************************
*
      iofile = 16
      open(unit=iofile,file='output.scratch',status='unknown',err=8002)
      rewind iofile
*
      ierr = 0
      go to 9000
*
 8001 continue
      write(6,*) ' Failed to open input file'
      ierr = 1
      go to 9000
 8002 continue
      write(6,*) ' Failed to open output file'
      ierr = 2
*
 9000 continue
      return
      end
*
*
*
      subroutine dimpri(pri,
     &  n,m,
     &  nbyte,
     &  la,
     &  mode)
*
*********************************************************
*        get space for array in pri		
*						
*        n     number of rows			
*        m     number of columns		
*						
*        nbyte number of bytes in each element	
*						
*        la    start position in pri		
*						
*        mode  =  1 allocate space in pri	
*                 0 print out used space in pri	
*                -1 release arrays in pri	
*                -2 release all arrays in pri	
*                 2 initiate database		
*********************************************************
*
      implicit double precision (a-h,o-z)
         dimension pri(*)
         common /dbasco/ ifree,ilast
*
*********************************************************
*        calculate number of bytes for this array
*********************************************************
*
      iimode = mode + 3
      go to ( 40,10,50,10,70),iimode
   10 continue
      mb=n*m*nbyte
      if ( mod(mb,8) .ne. 0 ) mb=mb+8-mod(mb,8)
      mb=mb/8
      if ( mode .ne. 1 ) go to 20
      la=ifree
      ifree=ifree+mb
      if ( ifree-1 .gt. ilast ) go to 60
      call zero(pri(la),mb*8)
      go to 30
   20 continue
      ifree=ifree-mb
   30 continue
*
      go to 80
*
   40 continue
      ifree=1
      go to 80
*
   50 continue
      iff=ifree-1
      write (6,60000) iff
      write (6,60010) ilast
      go to 80
*
*********************************************************
*     error					
*********************************************************
*
   60 continue
      write(6,*) 'Primary memory array too small'
      ierr = 11
      return
   70 continue
      ifree=1
      ilast=n
*
   80 continue
*
      return
60000 format('  Last used adress in pri is ',i6)
60010 format('  Allocated length is        ',i6)
      end
*
*
*
      subroutine zero(vec,ntal)
      dimension vec(*)
*
*********************************************************
*     fill vec with zeros			
*     ntal: number of bytes			
*********************************************************
*
      n=ntal/4
      do 10 i=1,n
10    vec(i)=0.
      return
      end
*
*
*
      subroutine mvc(rout,rin,ntal)
      dimension rout(*),rin(*)
*
*********************************************************
*     copy rin to rout				
*     ntal: number of bytes			
*********************************************************
*
      n=ntal/4
      do 10 i=1,n
10    rout(i)=rin(i)
      return
      end