Mac binaries

[jabaws.git] / website / archive / binaries / mac / src / disembl / Tisean_3.0.1 / source_f / arguments.f

diff --git a/website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/arguments.f b/website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/arguments.f
new file mode 100644 (file)
index 0000000..82cf80a
--- /dev/null
+++ b/website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/arguments.f
@@ -0,0 +1,159 @@
+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