website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/rms.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   subtract mean, normalise to unit variance, or
  23 c   print mean, standard deviation, and range of series in file(s)
  24 c   author T. Schreiber (1998) based on earlier versions
  25 c===========================================================================
  26       parameter(nx=1000000)
  27       dimension x(nx)
  28       character*72 file, fout
  29       data lmean/0/, lvar/0/
  30       data iverb/1/
  31
  32       call whatido("compute mean/standard deviation, normalise",iverb)
  33       nmaxx=ican("l",nx)
  34       nexcl=ican("x",0)
  35       jcol=ican("c",0)
  36       if(lopt("a",1).eq.1) lmean=1
  37       if(lopt("v",1).eq.1) lvar=1
  38       isout=igetout(fout,iverb)
  39       if(iv_io(iverb).eq.1) write(istderr(),*)
  40      .   "mean / standard deviation / smallest / largest"
  41
  42       do 10 ifi=1,nstrings()
  43          call nthstring(ifi,file)
  44          nmax=nmaxx
  45          call readfile(nmax,x,nexcl,jcol,file,iverb)
  46          if(file.eq."-") file="stdin"
  47          call rms(nmax,x,sc,sd)
  48          call minmax(nmax,x,xmin,xmax)
  49          if(lvar.eq.1.or.lmean.eq.1) then
  50             if(iv_io(iverb).eq.1) write(istderr(),*)
  51      .         sc, sd, xmin, xmax, "   ", file(1:index(file," ")-1)
  52             if(lvar.eq.1) then
  53                if(isout.eq.1) call addsuff(fout,file,"_v")
  54                call normal1(nmax,x,sc,sd)
  55             else
  56                if(isout.eq.1) call addsuff(fout,file,"_a")
  57                call normal(nmax,x,sc,sd)
  58             endif
  59             call writefile(nmax,x,fout,iverb)
  60          else
  61             write(*,*)
  62      .         sc, sd, xmin, xmax, "   ", file(1:index(file," ")-1)
  63          endif
  64  10      continue
  65       end
  66
  67       subroutine usage()
  68 c usage message
  69
  70       call whatineed(
  71      .   "[-a -v -o outfile -l# -x# -c# -V# -h] file(s)")
  72       call popt("a","subtract average")
  73       call popt("v","subtract mean, normalise to unit variance")
  74       call popt("l","number of values to be read (all)")
  75       call popt("x","number of values to be skipped (0)")
  76       call popt("c","column to be read (1 or file,#)")
  77       call pout("file_a (if -a), file_v (if -v)")
  78       call pall()
  79       stop
  80       end
  81
  82