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