X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_Eshel%2FSRC-SURPLUS%2Fminim_mcmf.F;fp=source%2Funres%2Fsrc_Eshel%2FSRC-SURPLUS%2Fminim_mcmf.F;h=beb3d4c4679868528ea4bb5d4141461d78f2bc21;hb=d101c97dea752458d76055fdbae49c26fff03c1f;hp=0000000000000000000000000000000000000000;hpb=325eda160c9ad2982501e091ca40606a29043712;p=unres.git

diff --git a/source/unres/src_Eshel/SRC-SURPLUS/minim_mcmf.F b/source/unres/src_Eshel/SRC-SURPLUS/minim_mcmf.F
new file mode 100644
index 0000000..beb3d4c
--- /dev/null
+++ b/source/unres/src_Eshel/SRC-SURPLUS/minim_mcmf.F
@@ -0,0 +1,121 @@
+#ifdef MPI
+      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 ',n,ichuj
+      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)
+        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
+#endif