1 c===========================================================================
3 c This file is part of TISEAN
5 c Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
7 c TISEAN is free software; you can redistribute it and/or modify
8 c it under the terms of the GNU General Public License as published by
9 c the Free Software Foundation; either version 2 of the License, or
10 c (at your option) any later version.
12 c TISEAN is distributed in the hope that it will be useful,
13 c but WITHOUT ANY WARRANTY; without even the implied warranty of
14 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 c GNU General Public License for more details.
17 c You should have received a copy of the GNU General Public License
18 c along with TISEAN; if not, write to the Free Software
19 c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
21 c===========================================================================
22 c part of the randomize-package for constraint surrogates
23 c exponential cooling scheme
24 c author T. Schreiber (1999)
26 c-------------------------------------------------------------------
27 c get options specific for cooling scheme
29 subroutine opts_cool()
31 . itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
41 c-------------------------------------------------------------------
42 c print version information on cooling scheme
44 subroutine what_cool()
45 call ptext("Cooling scheme: exponential")
48 c-------------------------------------------------------------------
49 c print usage message specific for cooling scheme
51 subroutine usage_cool()
52 call ptext("Cooling options: [-T# -a# -S# -s# -z# -C#]")
53 call popt("T","initial temperature (auto)")
54 call popt("a","cooling factor (auto)")
55 call popt("S","total steps before cooling (20000)")
56 call popt("s","successful steps before cooling (2000)")
57 call popt("z","minimal successful steps before cooling (200)")
58 call popt("C","goal value of cost function (0.0)")
61 c-------------------------------------------------------------------
62 c initialise all that is needed for cooling scheme
66 . itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
84 c-------------------------------------------------------------------
85 c determine new temperature depending on current cost function,
86 c acceptance status and history
87 c par can be used to pass information to the permutation scheme
89 function cool(iaccept,iend,iv)
91 . itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
92 common nmax,cost,temp,cmin,rate
98 if(ntot.lt.mtot.and.nsucc.lt.msucc) return
99 rate=real(nsucc)/real(ntot)
101 if(cost.le.cgoal) return
102 if(itini.eq.0.and.temp.eq.tini.and.ntot.gt.1.5*nsucc) then
104 if(iv.ne.0) write(istderr(),*)
105 . "increased initial temperature from ",
106 . temp, " to ", tini, " for melting"
108 else if(nsucc.le.mstop) then
109 if(iafac.eq.1) return
113 if(iv.ne.0) write(istderr(),*) "starting over: "
114 if(iv.ne.0) write(istderr(),*) " Cooling rate: ", afac,
115 . " S:", mtot, " s: ", msucc
118 if(iv.ne.0) write(istderr(),
119 . '(3hT: ,g15.6,4h S: ,i15,4h s: , i15,8h cost: ,g15.6)')
120 . temp, ntot, nsucc, cost