      subroutine fsqlattice(m_rlv,h,k,l,struct,sfhkl,absent)
      
C  Calculate the F^2 values and systematic absences for the reciprocal
C  lattice.
C
C  Calls LAZY-PULVERIX code.
C
C  hmax is the maximum (h00) value corresponding to maximum Q for
C  the calculation.

C  natoms_max is the maximum number of atom positions in the unit cell.      
C  natoms is the actual number

C  reflmax is the maximum number of reflections (currently set for
C  a cubic material.
C  nref is the actual number
      implicit none
      include 'arraysize.inc'
      include 'io_files.inc'
      
c...	common blocks
      logical noisy
      common /noisy/ noisy
      
      logical warning
      common /reciplattice/ warning

      integer natoms
      common /atoms/ natoms

c...	passed variables
      integer m_rlv
      logical struct
      integer h(m_rlv_max,m_rlv_max)
      integer k(m_rlv_max,m_rlv_max)
      integer l(m_rlv_max,m_rlv_max)
      logical absent(41,41)
      real sfhkl(41,41)
      
c...	local variables
      integer i,j, o
cDebug      integer ii
      integer nwarn
      real b(natoms_max)
      double precision xyz(natoms_max,3)
      logical absentij
      real sfhklij
      real sfq0
      integer hkl(3)      

C  invoke lazy program to read space group, LPI style system cards,
C  crystal system, Bravais lattice. The number, positions, and
C  scattering lengths of the atoms in the unit cell are returned
C  as variables.  If struct is false then the necessary data for
C  the calculation could not be found.
C  also opens structinfo.out file (unit=7)

C  only do this calculation once
      
C  there are problems with the second time through

C  calls to MULTF and EXTINC
      
      warning=.false.
C set (hkl) to (000) for initial sfq^2 calculation
      do i=1,3
        hkl(i)=0
      enddo
      
C      call pgqch(size)
c      Added noisy=true to lazy parmeneter list, T.R. Nov 26, 2001
      if (struct) call lazy(natoms,b,xyz,struct, noisy)

C for diagnostics
C      write(*,*) 'natoms ',natoms
C      do i=1,natoms
C        write(*,'(i4,3f7.3)') i,(xyz(i,ii),ii=1,3)
C      enddo

      call sfsqd(natoms,b,xyz,hkl,sfq0)
      write (unitstruct,*) '>> fsqlattice():'
      if (struct) then
        write(*,*) 'Q=0 structure factor squared is: ', sfq0
c02Jan        write(*,'(a,f8.2)') 'Q=0 structure factor squared is: ',sfq0
c        write(7,'(a,f8.2)') 'Q=0 structure factor squared is: ',sfq0
c02Jan        write (unitstruct,'(a,f8.2)') 'Q=0 structure factor', 
c01Jan     &		' squared is: ',sfq0
        write (unitstruct,*) 'Q=0 structure factor', 
     &		' squared is: ',sfq0
      else
        write(*,'(a)') 'Not reading in structural information.'
        write(unitlog,'(a)') 'Not reading in structural information.'
      endif

C  Calculate structure factor from struct.dat file

      call conditions

      nwarn=0
      do i=1,m_rlv
        do j=1,m_rlv
          hkl(1)=h(i,j)
          hkl(2)=k(i,j)
          hkl(3)=l(i,j)
cDebug          write(*,'(a,4i5)') 'calc sf^2',m_rlv*(i-1)+j,(hkl(ii),ii=1,3)
          if (struct) then
            call sfsqd(natoms,b,xyz,hkl,sfhklij)
C if I uncomment the next statement it works?
C            write(*,'(a)') 'xx '  ! ,sfhklij
            call pulverix(hkl,absentij)
            sfhkl(i,j)=sfhklij
            absent(i,j)=absentij
C   put in a little check/warning
C   unfortunately a simple number won't work since
C   for a large number of atoms and a large (hkl)
C   the error in the structure factor calculation will
C   increase as the number of summed terms increases.
C   I'll just compensate for atom number.
C            write(*,*) absent,(hkl(o),o=1,3),sfhkl
            if (absent(i,j).and.(sfhkl(i,j)/float(natoms).
     &          gt. tiny)) then
c01Dec     &          gt.1.0e-5)) then
               if (nwarn.le.10) then
	         write(unitstruct,43) (hkl(o),o=1,3),sfhkl(i,j)
	       endif
c               if (nwarn.le.10) write(7,43) (hkl(o),o=1,3),sfhkl(i,j)
               nwarn=nwarn+1
               warning=.true.
            endif
            if ((.not.absent(i,j)).and.(sfhkl(i,j)/float(natoms).
     &            lt. tiny)) then
c01Dec     &            lt.1.0e-5)) then
               if (nwarn.le.10) then
	         write(unitstruct,34) (hkl(o),o=1,3)
	       endif
c               if (nwarn.le.10) write(7,34) (hkl(o),o=1,3)
                nwarn=nwarn+1
               warning=.true.
            endif
          else
C no structural information
            sfhkl(i,j)=1.0
            sfq0=1.0
            absent(i,j)=.false.
          endif

 43       format(28hWARNING: Absent reflection (,3i3,
     &      20h) has non-zero Sf^2:,g9.3)
 34       format(29hWARNING: Allowed reflection (,3i3,
     &      16h) has zero Sf^2.)

        enddo
      enddo
      if (nwarn.gt.10) then
        write(unitstruct,*) '... plus warnings on ', nwarn-10,' others'
      endif
c      if (nwarn.gt.10) write(7,*) '... plus warnings on ',
c     &     nwarn-10,' others'
      return
      end



