subroutine minim_mcmf implicit real*8 (a-h,o-z) include 'DIMENSIONS' parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) include 'COMMON.VAR' include 'COMMON.IOUNITS' include 'COMMON.MINIM' include 'mpif.h' external func,gradient,fdum real ran1,ran2,ran3 include 'COMMON.SETUP' include 'COMMON.GEO' include 'COMMON.CHAIN' 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) 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 ichuj = ichuj + 1 call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM, * muster,ierr) if (indx(1).eq.0) return c print *, 'worker ',me,' received order ',indx(2) call mpi_recv(var,nvar,mpi_double_precision, * king,idreal,CG_COMM,muster,ierr) call mpi_recv(ene0,1,mpi_double_precision, * king,idreal,CG_COMM,muster,ierr) c print *, 'worker ',me,' var read ' call deflt(2,iv,liv,lv,v) * 12 means fresh start, dont call deflt iv(1)=12 * max num of fun calls if (maxfun.eq.0) maxfun=500 iv(17)=maxfun * max num of iterations if (maxmin.eq.0) maxmin=1000 iv(18)=maxmin * controls output iv(19)=2 * selects output unit c iv(21)=iout iv(21)=0 * 1 means to print out result iv(22)=0 * 1 means to print out summary stats iv(23)=0 * 1 means to print initial x and d iv(24)=0 * min val for v(radfac) default is 0.1 v(24)=0.1D0 * max val for v(radfac) default is 4.0 v(25)=2.0D0 * check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) * the sumsl default is 0.1 v(26)=0.1D0 * false conv if (act fnctn decrease) .lt. v(34) * the sumsl default is 100*machep v(34)=v(34)/100.0D0 * absolute convergence if (tolf.eq.0.0D0) tolf=1.0D-4 v(31)=tolf * relative convergence if (rtolf.eq.0.0D0) rtolf=1.0D-4 v(32)=rtolf * controls initial step size v(35)=1.0D-1 * large vals of d correspond to small components of step do i=1,nphi d(i)=1.0D-1 enddo do i=nphi+1,nvar d(i)=1.0D-1 enddo c minimize energy call func(nvar,var,nf,eee,idum,rdum,fdum) if(eee.gt.1.0d18) then c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' c print *,' energy before SUMSL =',eee c print *,' aborting local minimization' iv(1)=-1 v(10)=eee nf=1 go to 201 endif 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 201 continue c total # of ftn evaluations (for iwf=0, it includes all minimizations). indx(4)=nf indx(5)=iv(1) eee=v(10) call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM, * ierr) c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10) c print *,indx(2),indx(5) call mpi_send(var,nvar,mpi_double_precision, * king,idreal,CG_COMM,ierr) call mpi_send(eee,1,mpi_double_precision,king,idreal, * CG_COMM,ierr) call mpi_send(ene0,1,mpi_double_precision,king,idreal, * CG_COMM,ierr) go to 10 return end