source/unres/src-HCD-5D/minim_mcmf.F

   1       subroutine minim_mcmf
   2 #ifdef LBFGS
   3       use minima
   4       use inform
   5       use output
   6       use iounit
   7       use scales
   8 #endif
   9       implicit real*8 (a-h,o-z)
  10       include 'DIMENSIONS'
  11 #ifndef LBFGS
  12       parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
  13 #endif
  14       include 'COMMON.VAR'
  15       include 'COMMON.IOUNITS'
  16       include 'COMMON.MINIM'
  17       include 'mpif.h'
  18 #ifdef LBFGS
  19       double precision grdmin
  20       external funcgrad
  21       external optsave
  22 #else
  23       double precision v(1:lv+1)
  24       common /przechowalnia/ v
  25       external func,gradient,fdum
  26       dimension iv(liv)
  27 #endif
  28       common /gacia/ nf
  29       real ran1,ran2,ran3
  30       include 'COMMON.SETUP'
  31       include 'COMMON.GEO'
  32       include 'COMMON.CHAIN'
  33       include 'COMMON.FFIELD'
  34       dimension muster(mpi_status_size)
  35       dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
  36       double precision d(maxvar),garbage(maxvar)
  37       dimension indx(6)
  38       dimension idum(1),rdum(1)
  39       double precision przes(3),obrot(3,3)
  40       logical non_conv
  41       data rad /1.745329252d-2/
  42
  43       ichuj=0
  44    10 continue
  45       ichuj = ichuj + 1
  46       call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM,
  47      *              muster,ierr)
  48       if (indx(1).eq.0) return
  49 c      print *, 'worker ',me,' received order ',n,ichuj
  50       call mpi_recv(var,nvar,mpi_double_precision,
  51      *              king,idreal,CG_COMM,muster,ierr)
  52       call mpi_recv(ene0,1,mpi_double_precision,
  53      *              king,idreal,CG_COMM,muster,ierr)
  54 c      print *, 'worker ',me,' var read '
  55
  56 #ifdef LBFGS
  57       maxiter=maxmin
  58       coordtype='RIGIDBODY'
  59       grdmin=tolf
  60       jout=iout
  61       jprint=print_min_stat
  62       iwrite=0
  63       if (.not. allocated(scale))  allocate (scale(nvar))
  64 c
  65 c     set scaling parameter for function and derivative values;
  66 c     use square root of median eigenvalue of typical Hessian
  67 c
  68       set_scale = .true.
  69 c      nvar = 0
  70       do i = 1, nvar
  71 c         if (use(i)) then
  72 c            do j = 1, 3
  73 c               nvar = nvar + 1
  74                scale(i) = 12.0d0
  75 c            end do
  76 c         end if
  77       end do
  78       eee=funcgrad(var,g)
  79       if(eee.gt.1.0d18) then
  80 c       print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
  81 c       print *,' energy before SUMSL =',eee
  82 c       print *,' aborting local minimization'
  83        nf=-1
  84        go to 201
  85       endif
  86 c      write (iout,*) "Calling lbfgs"
  87       call lbfgs (nvar,x,eee,grdmin,funcgrad,optsave)
  88       nf=nf+1
  89       deallocate(scale)
  90 #else
  91       call deflt(2,iv,liv,lv,v)
  92 * 12 means fresh start, dont call deflt
  93       iv(1)=12
  94 * max num of fun calls
  95       if (maxfun.eq.0) maxfun=500
  96       iv(17)=maxfun
  97 * max num of iterations
  98       if (maxmin.eq.0) maxmin=1000
  99       iv(18)=maxmin
 100 * controls output
 101       iv(19)=2
 102 * selects output unit
 103 c      iv(21)=iout
 104       iv(21)=0
 105 * 1 means to print out result
 106       iv(22)=0
 107 * 1 means to print out summary stats
 108       iv(23)=0
 109 * 1 means to print initial x and d
 110       iv(24)=0
 111 * min val for v(radfac) default is 0.1
 112       v(24)=0.1D0
 113 * max val for v(radfac) default is 4.0
 114       v(25)=2.0D0
 115 * check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
 116 * the sumsl default is 0.1
 117       v(26)=0.1D0
 118 * false conv if (act fnctn decrease) .lt. v(34)
 119 * the sumsl default is 100*machep
 120       v(34)=v(34)/100.0D0
 121 * absolute convergence
 122       if (tolf.eq.0.0D0) tolf=1.0D-4
 123       v(31)=tolf
 124 * relative convergence
 125       if (rtolf.eq.0.0D0) rtolf=1.0D-4
 126       v(32)=rtolf
 127 * controls initial step size
 128        v(35)=1.0D-1
 129 * large vals of d correspond to small components of step
 130       do i=1,nphi
 131         d(i)=1.0D-1
 132       enddo
 133       do i=nphi+1,nvar
 134         d(i)=1.0D-1
 135       enddo
 136 c  minimize energy
 137
 138       call func(nvar,var,nf,eee,idum,rdum,fdum)
 139       if(eee.gt.1.0d18) then
 140 c       print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
 141 c       print *,' energy before SUMSL =',eee
 142 c       print *,' aborting local minimization'
 143        iv(1)=-1
 144        v(10)=eee
 145        nf=1
 146        go to 201
 147       endif
 148
 149       call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
 150 c  find which conformation was returned from sumsl
 151         nf=iv(7)+1
 152 #endif
 153   201  continue
 154 c total # of ftn evaluations (for iwf=0, it includes all minimizations).
 155         indx(4)=nf
 156 #ifdef LBFGS
 157         indx(5)=0
 158 #else
 159         indx(5)=iv(1)
 160         eee=v(10)
 161 #endif
 162
 163         call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM,
 164      *                 ierr)
 165 c       print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10)
 166         call mpi_send(var,nvar,mpi_double_precision,
 167      *               king,idreal,CG_COMM,ierr)
 168         call mpi_send(eee,1,mpi_double_precision,king,idreal,
 169      *                 CG_COMM,ierr)
 170         call mpi_send(ene0,1,mpi_double_precision,king,idreal,
 171      *                 CG_COMM,ierr)
 172         go to 10
 173
 174       return
 175       end