subroutine minim_mcmf
+#ifdef LBFGS
+ use minima
+ use inform
+ use output
+ use iounit
+ use scales
+#endif
implicit real*8 (a-h,o-z)
include 'DIMENSIONS'
+#ifndef LBFGS
parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
+#endif
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
include 'COMMON.MINIM'
include 'mpif.h'
+#ifdef LBFGS
+ double precision grdmin
+ external funcgrad
+ external optsave
+#else
+ double precision v(1:lv+1)
+ common /przechowalnia/ v
external func,gradient,fdum
+ dimension iv(liv)
+#endif
+ common /gacia/ nf
real ran1,ran2,ran3
include 'COMMON.SETUP'
include 'COMMON.GEO'
include 'COMMON.FFIELD'
dimension muster(mpi_status_size)
dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
- double precision d(maxvar),v(1:lv+1),garbage(maxvar)
+ double precision d(maxvar),garbage(maxvar)
dimension indx(6)
- dimension iv(liv)
dimension idum(1),rdum(1)
double precision przes(3),obrot(3,3)
logical non_conv
data rad /1.745329252d-2/
- common /przechowalnia/ v
ichuj=0
10 continue
* king,idreal,CG_COMM,muster,ierr)
c print *, 'worker ',me,' var read '
-
+#ifdef LBFGS
+ maxiter=maxmin
+ coordtype='RIGIDBODY'
+ grdmin=tolf
+ jout=iout
+ jprint=print_min_stat
+ iwrite=0
+ if (.not. allocated(scale)) allocate (scale(nvar))
+c
+c set scaling parameter for function and derivative values;
+c use square root of median eigenvalue of typical Hessian
+c
+ set_scale = .true.
+c nvar = 0
+ do i = 1, nvar
+c if (use(i)) then
+c do j = 1, 3
+c nvar = nvar + 1
+ scale(i) = 12.0d0
+c end do
+c end if
+ end do
+ eee=funcgrad(var,g)
+ if(eee.gt.1.0d18) then
+c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
+c print *,' energy before SUMSL =',eee
+c print *,' aborting local minimization'
+ nf=-1
+ go to 201
+ endif
+c write (iout,*) "Calling lbfgs"
+ call lbfgs (nvar,x,eee,grdmin,funcgrad,optsave)
+ nf=nf+1
+ deallocate(scale)
+#else
call deflt(2,iv,liv,lv,v)
* 12 means fresh start, dont call deflt
iv(1)=12
call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
c find which conformation was returned from sumsl
nf=iv(7)+1
+#endif
201 continue
c total # of ftn evaluations (for iwf=0, it includes all minimizations).
indx(4)=nf
+#ifdef LBFGS
+ indx(5)=0
+#else
indx(5)=iv(1)
eee=v(10)
+#endif
call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM,
* ierr)