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
      integer uiparm(1)
      logical lprn
      double precision x(max_paropt)
      double precision viol,f0,f,tcpu
      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

      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
        print *,"maxstep_scan",maxstep_scan," step_scan",step_scan
        do iter=1,maxstep_scan
          ww(iww)=iter*step_scan
          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

      ii=0
      do i=1,n_ene 
        if (imask(i).eq.1) then
          ii=ii+1
          x(ii)=ww0(i)
        endif
      enddo
      write (iout,*) "Best function value:",f0
      write (iout,*)
      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