website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/randomize/cool/exp.f

   1 c===========================================================================
   2 c
   3 c   This file is part of TISEAN
   4 c
   5 c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
   6 c
   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.
  11 c
  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.
  16 c
  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
  20 c
  21 c===========================================================================
  22 c   part of the randomize-package for constraint surrogates
  23 c   exponential cooling scheme
  24 c   author T. Schreiber (1999)
  25 c
  26 c-------------------------------------------------------------------
  27 c get options specific for cooling scheme
  28 C
  29       subroutine opts_cool()
  30       common /coolcom/
  31      .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
  32
  33       tini=fcan("T",0.)
  34       afac=fcan("a",0.)
  35       mtot=ican("S",20000)
  36       msucc=ican("s",2000)
  37       mstop=ican("z",200)
  38       cgoal=fcan("C",0.)
  39       end
  40
  41 c-------------------------------------------------------------------
  42 c print version information on cooling scheme
  43 C
  44       subroutine what_cool()
  45       call ptext("Cooling scheme: exponential")
  46       end
  47
  48 c-------------------------------------------------------------------
  49 c print usage message specific for cooling scheme
  50 C
  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)")
  59       end
  60
  61 c-------------------------------------------------------------------
  62 c initialise all that is needed for cooling scheme
  63 C
  64       function cool_init()
  65       common /coolcom/
  66      .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
  67
  68       ntot=0
  69       nsucc=0
  70       itini=1
  71       if(tini.eq.0.) then
  72          tini=1e-4
  73          itini=0
  74       endif
  75       iafac=1
  76       if(afac.eq.0.) then
  77          afac=0.5
  78          iafac=0
  79       endif
  80       temp=tini
  81       cool_init=temp
  82       end
  83
  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
  88 c
  89       function cool(iaccept,iend,iv)
  90       common /coolcom/
  91      .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
  92       common nmax,cost,temp,cmin,rate
  93
  94       iend=0
  95       cool=temp
  96       nsucc=nsucc+iaccept
  97       ntot=ntot+1
  98       if(ntot.lt.mtot.and.nsucc.lt.msucc) return
  99       rate=real(nsucc)/real(ntot)
 100       iend=1
 101       if(cost.le.cgoal) return
 102       if(itini.eq.0.and.temp.eq.tini.and.ntot.gt.1.5*nsucc) then
 103          tini=10*temp
 104          if(iv.ne.0) write(istderr(),*)
 105      .      "increased initial temperature from ",
 106      .      temp, " to ", tini, " for melting"
 107          temp=tini
 108       else if(nsucc.le.mstop) then
 109          if(iafac.eq.1) return
 110          afac=sqrt(afac)
 111          mtot=mtot*sqrt(2.)
 112          temp=tini
 113          if(iv.ne.0) write(istderr(),*) "starting over: "
 114          if(iv.ne.0) write(istderr(),*) "   Cooling rate: ", afac,
 115      .      " S:", mtot, " s: ", msucc
 116       else
 117          temp=temp*afac
 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
 121       endif
 122       iend=0
 123       ntot=0
 124       nsucc=0
 125       cool=temp
 126       end
 127