website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/randomize/perm/event.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 TISEAN randomize package for constraint surrogates
  23 C   permutation scheme for event times
  24 c   one event time is changed such that the two adjacent intervals are swapped
  25 c   author T. Schreiber (1999)
  26 c
  27 c-------------------------------------------------------------------
  28 c get permutation specific options
  29 c
  30       subroutine opts_permute()
  31       end
  32
  33 c-------------------------------------------------------------------
  34 c print version information on permutation scheme
  35 c
  36       subroutine what_permute()
  37       call ptext("Permutation scheme: event time preserving intervals")
  38       end
  39
  40 c-------------------------------------------------------------------
  41 c print permutation specific usage message
  42 c
  43       subroutine usage_permute()
  44       end
  45
  46 c-------------------------------------------------------------------
  47 c initialise all that is needed for permutation scheme
  48 c
  49       subroutine permute_init()
  50       parameter(nx=100000)
  51       dimension x(nx)
  52       common nmax,cost,temp,cmin,rate,x
  53
  54       do 10 n=1,nmax*log(nmax*1.)
  55          call permute(n1,n2)
  56  10      call exch(n1,n2)
  57       end
  58
  59 c-------------------------------------------------------------------
  60 c find two indices n1, n2 to be exchanged, maybe using a parameter
  61 c par provided by the cooling schedule
  62 c
  63 c here, n2 is not used at all; event 1 and nmax are never changed
  64 c
  65       subroutine permute(n1,n2)
  66       common nmax
  67       external rand
  68
  69       n1=min(int(rand(0.0)*nmax)+2,nmax-1)
  70       end
  71
  72 c-------------------------------------------------------------------
  73 c given two indices n1, n2, actually perform the exchange
  74 c
  75       subroutine exch(n1,n2)
  76       parameter(nx=100000)
  77       dimension x(nx)
  78       common nmax,cost,temp,cmin,rate,x
  79
  80       x(n1)=x(n1-1)+x(n1+1)-x(n1)
  81       end