********************************************************************************
*                                                                              * 
*  2DHF version 1-2003                                                         *
*  Copyright (C) 1996  Jacek Kobus, Leif Laaksonen, Dage Sundholm              *
*                                                                              *
*  This software may be used and distributed according to the terms            *
*  of the GNU General Public License, see README and COPYING.                  *
*                                                                              *
********************************************************************************
c ### rheader ###
c
      subroutine rheader(norb_p)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      character*80 datetime_p
      character*1 dtarr1(80),dtarr2(80)
      equivalence(header_p,dtarr1(1))
      equivalence(datetime_p,dtarr2(1))

      include 'commons8.inc'

      mismatch=0
      idump=0

      read(iinp11,err=1000) header_p
      read(iinp11,err=1000) datetime_p

      imax1=0
      imax2=0
      call clrstring (imax1,dtarr1)
      call clrstring (imax2,dtarr2)

      write(iout6,1050)
c     write(iout6,1060) header_p,datetime_p 
      write(iout6,1060) (dtarr1(i),i=1,imax1)
      write(iout6,1061) (dtarr2(i),i=1,imax2)

      read(iinp11,err=1000) ngrids_p,nni_p,nmu_p

      if (iinterp.eq.0) then
         if (ngrids.ne.ngrids_p ) then
            write (iout6,*) 'mismatch in ngrids: '
            write (iout6,*) 'input=',ngrids,' file=',ngrids_p
            stop 'rheader'
         endif

         if (nni.ne.nni_p) then
            write (iout6,*) 'mismatch in nni: '
            write (iout6,*) 'input=',nni,' file=',nni_p
            stop 'rheader'
         endif	   

         do ig=1,ngrids   
            if (nmu(ig).ne.nmu_p(ig)) then
               write (iout6,*) 'mismatch in nmu for grid ',ig,':'
               write (iout6,*) 'input=',nmu(ig),' file=',nmu_p(ig)
               stop 'rheader'
            endif
         enddo	
      endif

      read(iinp11,err=1000) r_p,rgrid_p
      read(iinp11,err=1000) z1_p,z2_p	
      
      rd =abs(r_p-r)
      z1d=abs(z1_p-z1)
      z2d=abs(z2_p-z2)

c     test for various parameters
      
      if (rd.gt.1.d-06) then
         write(iout6,*) 'mismatch in bond length:'
         write(iout6,*) 'input=',r, 'disk=',r_p

      elseif (z1d.gt.1.d-06) then
         write(iout6,*) 'Warning! mismatch in Z1:'
         write(iout6,*) 'input=',z1, 'disk=',z1_p

      elseif (z2d.gt.1.d-06) then
         write(iout6,*) 'Warning! mismatch in Z2:'
         write(iout6,*) 'input=',z2, 'disk=',z2_p
      endif	   

      if (iinterp.eq.0) then
         do ig=1,ngrids   
            if (abs(rgrid(ig)-rgrid_p(ig)).gt.1.d-6 ) then
               write (iout6,*) 'mismatch in a subgrid ',ig,':'
               write (iout6,*) 'input=',rgrid(ig),' file=',rgrid_p(ig)
               stop 'rheader'
            endif
         enddo	
      endif

      read(iinp11,err=1000) norb_p,nel_p,nexch_p
      nexch=nexch_p
     
      if (nel.ne.nel_p) then
         write (iout6,*) '    Warning: mismatch in number of ',
     &        'electrons: input=',nel,' file=',nel_p
      endif

      if (norb.ne.norb_p ) then
         write (iout6,*) '    Warning: mismatch in number of ',
     &        'orbitals:  input=',norb,' file=',norb_p
         if (norb.gt.norb_p.and.imethod.eq.2) then 
c           write (iout6,*) '... continuing with crossed fingers ...',
c           &			     '; ini=4
            write (iout6,*) '... assuming a virtual orbital is ',
     &           'being generated ...'
         else
            stop 'rheader'
         endif
      endif

      return
      
 1000 continue
      write(iout6,1070)
      stop	
c
 1050 format(/1x,'... retrieving data from disk ...')	
 1060 format( 1x,'    file with heading: ',80a1)
 1061 format( 1x,'    created on: ',80a1)
 1070 format(//1x,'rheader: cannot read data from disk'//)     
      end