+++ /dev/null
-#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 ',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
-#else
- subroutine minim_mcmf
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- write (iout,*) "Unsupported option for serial version"
- return
- end
-#endif
-
projects / unres.git / blobdiff