subroutine scan(nvar,x,f0,lprn)
      implicit none
      include "DIMENSIONS"
      include "DIMENSIONS.ZSCOPT"
      include "COMMON.WEIGHTS"
      include "COMMON.NAMES"
      include "COMMON.VMCPAR"
      include "COMMON.IOUNITS"
      include "COMMON.CLASSES"
      include "COMMON.OPTIM"
      include "COMMON.ENERGIES"
      include "COMMON.TIME1"
      integer i,ii,ibatch,j,iww,nweight,iter,nf,nvar,icycle
      integer uiparm(1)
      logical lprn
      double precision x(max_paropt)
      double precision viol,f0,f,tcpu,sstep
      character*32 nazwa
      integer ilen
      external ilen
      external fdum
c Systematically scan the weights one by one
      PREVTIM=tcpu()
      write (iout,*) "Enter the SCAN procedure"
      write (iout,*) "Initial weights"
      write(iout,'(9x,15(2x,a6))')(wname(i),i=1,n_ene)
      write(iout,40)(ww(i),i=1,n_ene)
      write(iout,*)'-----------------------------------'

      call targetfun(nvar,x,nf,f0,uiparm)
      write (iout,*) "Initial function value:",f0

      ii=0
      do i=1,n_ene 
        if (imask(i).eq.1) then
          ii=ii+1
          ww0(i)=x(ii)
        else
          ww0(i)=ww(i)
        endif
      enddo

      write (iout,*) "maxstep_scan",maxstep_scan," step_scan",step_scan
      DO ICYCLE = 1,NSCANCYCLE
      write (iout,*) "========== Scan cycle",ICYCLE
      do iww=1,n_ene
        if (imask(iww).eq.0) goto 1222
        if (lprn) then
          nazwa='scan.'//wname(iww)(:ilen(wname(iww)))
          open(istat,file=nazwa)
        endif
        do i=1,n_ene
          ww(i)=ww0(i)
        enddo
        if (step_scan.lt.0.0d0) then
          sstep = (ww_up(iww)-ww_low(iww))/maxstep_scan
        else
          sstep = step_scan
        endif
        write(iout,*) "Variable",iww,"maxstep_scan",maxstep_scan,
     &   " sstep",sstep
        do iter=1,maxstep_scan
          ww(iww)=ww_low(iww)+iter*sstep
          if (ww(iww).lt.ww_low(iww).or.ww(iww).gt.ww_up(iww)) goto 1221
          ii=0
          do i=1,n_ene 
            if (imask(i).eq.1) then
              ii=ii+1
              x(ii)=ww(i)
            endif
          enddo
c          write (*,*) iww,iter,ww(iww)
          call targetfun(nvar,x,nf,f,uiparm)
          if (f.lt.f0) then
            write (iout,'(2a,f10.5,2(1pe15.5))')
     &       "Lower function value found:",wname(iww),ww(iww),f,f0
            f0=f
            do i=1,n_ene
              ww0(i)=ww(i)
            enddo
          endif
          if (lprn) then
            write (istat,'(f8.3,5x,$)') ww(iww)
            write (istat,'(1pe15.5)') f
          endif
 1221     continue
        enddo ! iter
        close(istat)
 1222   continue
      enddo ! iww
      ENDDO ! ICYCLE
      ii=0
      do i=1,n_ene 
        if (imask(i).eq.1) then
          ii=ii+1
          x(ii)=ww0(i)
          ww(i)=ww0(i)
        endif
      enddo
      write (iout,*) "Best function value:",f0
      write (iout,*)
      call targetfun(nvar,x,nf,f,uiparm)
      if (lprn) call write_params(nvar,nf,x)
      return
30    format(a2,i5,1x,14(f5.3,1x),a3,100f7.3)
40    format(13(f7.4,1x))
      end