X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fminim_mcmf.F;h=16623b6296f8504c5839ac31604bff806dd95b04;hb=c711143ad3fffb04d27b55aa823f399b8343c4c5;hp=836d258e2e0e01674475f4628aeee54e0acd3285;hpb=76ef494efde78d2d85d0e72d936c13166961256c;p=unres.git

diff --git a/source/unres/src-HCD-5D/minim_mcmf.F b/source/unres/src-HCD-5D/minim_mcmf.F
index 836d258..16623b6 100644
--- a/source/unres/src-HCD-5D/minim_mcmf.F
+++ b/source/unres/src-HCD-5D/minim_mcmf.F
@@ -1,12 +1,31 @@
       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'
@@ -14,14 +33,12 @@
       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
@@ -36,7 +53,41 @@ c      print *, 'worker ',me,' received order ',n,ichuj
      *              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                                                          
@@ -98,11 +149,16 @@ c       print *,' aborting local minimization'
       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)