view main/system-identification/devel/tisean/source_f/arguments.f @ 9894:82ff20b4d849 octave-forge

system-identitifaction: Adding devel TISEAN files
author jpicarbajal
date Wed, 28 Mar 2012 13:32:37 +0000
parents
children
line wrap: on
line source

c===========================================================================
c
c   This file is part of TISEAN
c 
c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
c 
c   TISEAN is free software; you can redistribute it and/or modify
c   it under the terms of the GNU General Public License as published by
c   the Free Software Foundation; either version 2 of the License, or
c   (at your option) any later version.
c
c   TISEAN is distributed in the hope that it will be useful,
c   but WITHOUT ANY WARRANTY; without even the implied warranty of
c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
c   GNU General Public License for more details.
c
c   You should have received a copy of the GNU General Public License
c   along with TISEAN; if not, write to the Free Software
c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
c
c===========================================================================
c   arguments.f
c   get command line arguments 
c   author T. Schreiber (1998)
c===========================================================================

      subroutine argdel(i)
      parameter(margs=1000)
      dimension largs(margs)
      common /args/ nargs, largs

      if(i.eq.0) then
         nargs=min(margs,iargc())
         do 10 n=1,nargs
 10         largs(n)=1
      else
         if(i.gt.iargc()) return
         if(largs(i).eq.0) return
         largs(i)=0
         nargs=nargs-1
      endif
      end

      function nstrings()
      parameter(margs=1000)
      dimension largs(margs)
      common /args/ nargs, largs

      nstrings=max(nargs,1)
      end

      subroutine nthstring(n,string)
      parameter(margs=1000)
      dimension largs(margs)
      common /args/ nargs, largs
      character*(*) string

      iv=0
      do 10 i=1,iargc()
         if(largs(i).eq.1) iv=iv+1
 10      if(iv.eq.n) goto 1
      string="-"
      return
 1    call getarg(i,string)
      end

      function imust(c)
c get mandatory integer argument, call usage statement if missing
      character c

      imust=iopt(c,1,ierr)
      if(ierr.ne.0) call usage()
      end

      function fmust(c)
c get mandatory real argument, call usage statement if missing
      character c

      fmust=fopt(c,1,ierr)
      if(ierr.ne.0) call usage()
      end

      subroutine smust(c,string)
c get mandatory string argument, call usage statement if missing
      character c
      character*(*) string

      call sopt(c,1,string,ierr)
      if(ierr.ne.0) call usage()
      end

      function ican(c,idef)
c get optional integer argument, provide default if missing
      character c

      ican=iopt(c,1,ierr)
      if(ierr.ne.0) ican=idef
      end
      
      function fcan(c,fdef)
c get optional real argument, provide default if missing
      character c

      fcan=fopt(c,1,ierr)
      if(ierr.ne.0) fcan=fdef
      end

      subroutine stcan(c,string,dstring)
c get optional string argument, provide default if missing
      character c
      character*(*) string, dstring

      call sopt(c,1,string,ierr)
      if(ierr.ne.0) string=dstring
      end

      function igetout(fout,iverb)
c gets alternate output file name, default " "
c return 1 if fout must be determined from input file name
      character*(*) fout

      igetout=0
      call stcan("o",fout," ")
      if(fout.ne." ".and.nstrings().gt.1.and.iv_io(iverb).ne.0) 
     .   write(istderr(),*) '*** single output file for multiple'//
     .   ' input files - results may be overwritten'
      if(fout.ne." ") return
      igetout=lopt("o",1)
      end

      subroutine imcan(c,mmax,mc,ilist)
c get optional integer argument with multiple comma separated values
      character c
      character*72 string
      dimension ilist(*)

      call stcan(c,string," ")
      string(index(string," "):index(string," "))=","
      do 10 m=1,mmax
         if(index(string,",").le.1) goto 1
         read(string(1:index(string,",")-1),*,err=1,end=1) ilist(m)
 10      string=string(index(string,",")+1:72)
 1    mc=m-1
      end

      subroutine fmcan(c,mmax,mc,flist)
c get optional real argument with multiple comma separated values
      character c
      character*72 string
      dimension flist(*)

      call stcan(c,string," ")
      string(index(string," "):index(string," "))=","
      do 10 m=1,mmax
         if(index(string,",").le.1) goto 1
         read(string(1:index(string,",")-1),*,err=1,end=1) flist(m)
 10      string=string(index(string,",")+1:72)
 1    mc=m-1
      end