source/maxlik/src_MD_T_maxlik-NEWCORR.safe/scan.f

   1       subroutine scan(nvar,x,f0,lprn)
   2       implicit none
   3       include "DIMENSIONS"
   4       include "DIMENSIONS.ZSCOPT"
   5       include "COMMON.WEIGHTS"
   6       include "COMMON.NAMES"
   7       include "COMMON.VMCPAR"
   8       include "COMMON.IOUNITS"
   9       include "COMMON.CLASSES"
  10       include "COMMON.OPTIM"
  11       include "COMMON.ENERGIES"
  12       include "COMMON.TIME1"
  13       integer i,ii,ibatch,j,iww,nweight,iter,nf,nvar,icycle
  14       integer uiparm(1)
  15       logical lprn
  16       double precision x(max_paropt)
  17       double precision viol,f0,f,tcpu,sstep
  18       character*32 nazwa
  19       integer ilen
  20       external ilen
  21       external fdum
  22 c Systematically scan the weights one by one
  23       PREVTIM=tcpu()
  24       write (iout,*) "Enter the SCAN procedure"
  25       write (iout,*) "Initial weights"
  26       write(iout,'(9x,15(2x,a6))')(wname(i),i=1,n_ene)
  27       write(iout,40)(ww(i),i=1,n_ene)
  28       write(iout,*)'-----------------------------------'
  29
  30       call targetfun(nvar,x,nf,f0,uiparm)
  31       write (iout,*) "Initial function value:",f0
  32
  33       ii=0
  34       do i=1,n_ene
  35         if (imask(i).eq.1) then
  36           ii=ii+1
  37           ww0(i)=x(ii)
  38         else
  39           ww0(i)=ww(i)
  40         endif
  41       enddo
  42
  43       write (iout,*) "maxstep_scan",maxstep_scan," step_scan",step_scan
  44       DO ICYCLE = 1,NSCANCYCLE
  45       write (iout,*) "========== Scan cycle",ICYCLE
  46       do iww=1,n_ene
  47         if (imask(iww).eq.0) goto 1222
  48         if (lprn) then
  49           nazwa='scan.'//wname(iww)(:ilen(wname(iww)))
  50           open(istat,file=nazwa)
  51         endif
  52         do i=1,n_ene
  53           ww(i)=ww0(i)
  54         enddo
  55         if (step_scan.lt.0.0d0) then
  56           sstep = (ww_up(iww)-ww_low(iww))/maxstep_scan
  57         else
  58           sstep = step_scan
  59         endif
  60         write(iout,*) "Variable",iww,"maxstep_scan",maxstep_scan,
  61      &   " sstep",sstep
  62         do iter=1,maxstep_scan
  63           ww(iww)=ww_low(iww)+iter*sstep
  64           if (ww(iww).lt.ww_low(iww).or.ww(iww).gt.ww_up(iww)) goto 1221
  65           ii=0
  66           do i=1,n_ene
  67             if (imask(i).eq.1) then
  68               ii=ii+1
  69               x(ii)=ww(i)
  70             endif
  71           enddo
  72 c          write (*,*) iww,iter,ww(iww)
  73           call targetfun(nvar,x,nf,f,uiparm)
  74           if (f.lt.f0) then
  75             write (iout,'(2a,f10.5,2(1pe15.5))')
  76      &       "Lower function value found:",wname(iww),ww(iww),f,f0
  77             f0=f
  78             do i=1,n_ene
  79               ww0(i)=ww(i)
  80             enddo
  81           endif
  82           if (lprn) then
  83             write (istat,'(f8.3,5x,$)') ww(iww)
  84             write (istat,'(1pe15.5)') f
  85           endif
  86  1221     continue
  87         enddo ! iter
  88         close(istat)
  89  1222   continue
  90       enddo ! iww
  91       ENDDO ! ICYCLE
  92       ii=0
  93       do i=1,n_ene
  94         if (imask(i).eq.1) then
  95           ii=ii+1
  96           x(ii)=ww0(i)
  97           ww(i)=ww0(i)
  98         endif
  99       enddo
 100       write (iout,*) "Best function value:",f0
 101       write (iout,*)
 102       call targetfun(nvar,x,nf,f,uiparm)
 103       if (lprn) call write_params(nvar,nf,x)
 104       return
 105 30    format(a2,i5,1x,14(f5.3,1x),a3,100f7.3)
 106 40    format(13(f7.4,1x))
 107       end