source/unres/src_CSA/minim_mult.F

   1       subroutine minim_mcmf
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
   5       include 'COMMON.VAR'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.MINIM'
   8       include 'mpif.h'
   9       external func,gradient,fdum
  10       real ran1,ran2,ran3
  11       include 'COMMON.SETUP'
  12       include 'COMMON.GEO'
  13       include 'COMMON.CHAIN'
  14       include 'COMMON.FFIELD'
  15       dimension muster(mpi_status_size)
  16       dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
  17       double precision d(maxvar),v(1:lv+1),garbage(maxvar)
  18       dimension indx(6)
  19       dimension iv(liv)
  20       dimension idum(1),rdum(1)
  21       double precision przes(3),obrot(3,3)
  22       logical non_conv
  23       data rad /1.745329252d-2/
  24       common /przechowalnia/ v
  25
  26       ichuj=0
  27    10 continue
  28       ichuj = ichuj + 1
  29       call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM,
  30      *              muster,ierr)
  31       if (indx(1).eq.0) return
  32 c      print *, 'worker ',me,' received order ',indx(2)
  33       call mpi_recv(var,nvar,mpi_double_precision,
  34      *              king,idreal,CG_COMM,muster,ierr)
  35       call mpi_recv(ene0,1,mpi_double_precision,
  36      *              king,idreal,CG_COMM,muster,ierr)
  37 c      print *, 'worker ',me,' var read '
  38
  39
  40       call deflt(2,iv,liv,lv,v)
  41 * 12 means fresh start, dont call deflt
  42       iv(1)=12
  43 * max num of fun calls
  44       if (maxfun.eq.0) maxfun=500
  45       iv(17)=maxfun
  46 * max num of iterations
  47       if (maxmin.eq.0) maxmin=1000
  48       iv(18)=maxmin
  49 * controls output
  50       iv(19)=2
  51 * selects output unit
  52 c      iv(21)=iout
  53       iv(21)=0
  54 * 1 means to print out result
  55       iv(22)=0
  56 * 1 means to print out summary stats
  57       iv(23)=0
  58 * 1 means to print initial x and d
  59       iv(24)=0
  60 * min val for v(radfac) default is 0.1
  61       v(24)=0.1D0
  62 * max val for v(radfac) default is 4.0
  63       v(25)=2.0D0
  64 * check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
  65 * the sumsl default is 0.1
  66       v(26)=0.1D0
  67 * false conv if (act fnctn decrease) .lt. v(34)
  68 * the sumsl default is 100*machep
  69       v(34)=v(34)/100.0D0
  70 * absolute convergence
  71       if (tolf.eq.0.0D0) tolf=1.0D-4
  72       v(31)=tolf
  73 * relative convergence
  74       if (rtolf.eq.0.0D0) rtolf=1.0D-4
  75       v(32)=rtolf
  76 * controls initial step size
  77        v(35)=1.0D-1
  78 * large vals of d correspond to small components of step
  79       do i=1,nphi
  80         d(i)=1.0D-1
  81       enddo
  82       do i=nphi+1,nvar
  83         d(i)=1.0D-1
  84       enddo
  85 c  minimize energy
  86
  87       call func(nvar,var,nf,eee,idum,rdum,fdum)
  88       if(eee.gt.1.0d18) then
  89 c       print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
  90 c       print *,' energy before SUMSL =',eee
  91 c       print *,' aborting local minimization'
  92        iv(1)=-1
  93        v(10)=eee
  94        nf=1
  95        go to 201
  96       endif
  97
  98       call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
  99 c  find which conformation was returned from sumsl
 100         nf=iv(7)+1
 101   201  continue
 102 c total # of ftn evaluations (for iwf=0, it includes all minimizations).
 103         indx(4)=nf
 104         indx(5)=iv(1)
 105         eee=v(10)
 106
 107         call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM,
 108      *                 ierr)
 109 c       print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10)
 110 c       print *,indx(2),indx(5)
 111         call mpi_send(var,nvar,mpi_double_precision,
 112      *               king,idreal,CG_COMM,ierr)
 113         call mpi_send(eee,1,mpi_double_precision,king,idreal,
 114      *                 CG_COMM,ierr)
 115         call mpi_send(ene0,1,mpi_double_precision,king,idreal,
 116      *                 CG_COMM,ierr)
 117         go to 10
 118
 119       return
 120       end