added source code
[unres.git] / source / unres / src_MD-M / minim_mcmf.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 ',n,ichuj
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         call mpi_send(var,nvar,mpi_double_precision,
111      *               king,idreal,CG_COMM,ierr)
112         call mpi_send(eee,1,mpi_double_precision,king,idreal,
113      *                 CG_COMM,ierr)
114         call mpi_send(ene0,1,mpi_double_precision,king,idreal,
115      *                 CG_COMM,ierr)
116         go to 10
117
118       return
119       end