1 c===========================================================================
3 c This file is part of TISEAN
5 c Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
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.
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.
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
21 c===========================================================================
23 c i/o utilities for TISEAN f-sources
24 c author T. Schreiber (1998) based on earlier versions
25 c===========================================================================
26 subroutine readfile(nmax,x,nexcl,icol,file,iverb)
27 c read at most nmax points, return nmax
32 if(icol.eq.0) icol=igetcol(file)
33 if(icol.gt.0.and.iv.ne.0)
34 . write(istderr(),*) 'reading from column', icol
35 call infile(file,iunit,iverb)
39 10 read(iunit,*,end=999)
42 read(iunit,*,err=2,end=999) (dum,i=1,icol-1), x(n)
44 2 if(iv.ne.0) write(istderr(),*) "data in line ", lc, " ignored"
47 if(iv.ne.0) write(istderr(),*) '*** readfile: warning:'//
48 . ' maybe not the whole file has been used'
50 if(iunit.ne.istdin()) close(iunit)
51 if(iv.ne.0) call readreport(nmax,file)
52 if(icol.gt.0.and.file.ne."-") call putcol(file,icol)
55 function igetcol(file)
59 do 10 i=len(file),1,-1
60 10 if(file(i:i).eq.",") goto 1
62 read(file(i+1:len(file)),'(i10)',err=999) igetcol
67 subroutine putcol(file,icol)
71 write(file(index(file," "):index(file," ")+1),'(1h,,i1)') icol
73 write(file(index(file," "):index(file," ")+2),'(1h,,i2)') icol
77 subroutine writecfile(nmax,x,file,iverb,comm)
78 c write comment and nmax points
80 character*(*) file,comm
82 call outfile(file,iunit,iverb)
83 if(comm.ne." ") write(iunit,'(a)') comm
85 10 write(iunit,*) x(n)
86 if(iunit.eq.istdout()) then
92 if(iv_io(iverb).eq.1) call writereport(nmax,file)
95 subroutine writefile(nmax,x,file,iverb)
100 call writecfile(nmax,x,file,iverb," ")
103 subroutine infile(file,iunit,iverb)
104 c open file for read on iunit=ifile(), or iunit=istdin() if "-"
109 if(iv_io(iverb).eq.1) write(istderr(),*) "reading from stdin"
113 open(iunit,file=file,status="old",err=999)
114 if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)')
115 . "opened ",file(1:index(file," ")-1), " for input"
117 999 write(istderr(),'(a,a)') "Cannot open input file ",
118 . file(1:index(file," ")-1)
122 subroutine outfile(file,iunit,iverb)
123 c open file for write on iunit=ifileout(), or iunit=istdout() if file=" "
128 if(iv_io(iverb).eq.1) write(istderr(),*) "writing to stdout"
132 open(iunit,file=file,status='unknown',err=999)
133 if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)')
134 . "opened ",file(1:index(file," ")-1), " for output"
136 999 write(istderr(),'(a,a)') "Cannot open output file ",
137 . file(1:index(file," ")-1)
141 subroutine suffix(base,suff)
142 c append stuff after last nonblank character in base
143 character*(*) base, suff
145 base=base(1:index(base," ")-1)//suff
148 subroutine addsuff(target,base,suff)
149 c append stuff after last nonblank character in base
150 character*(*) target,base, suff
152 target=base(1:index(base," ")-1)//suff
155 subroutine readreport(nmax,file)
156 c report on numbers read
160 write(istderr(),'(i10,a)') nmax, ' values read from stdin'
162 write(istderr(),'(i10,a,a)') nmax, ' values read from file: ',
163 . file(1:index(file," ")-1)
167 write(istderr(),'(a)') "No input given - aborting."
169 write(istderr(),'(a,a,a)') "Input file ",
170 . file(1:index(file," ")-1), " empty - aborting."
175 subroutine writereport(nmax,file)
176 c report on numbers written
180 write(istderr(),'(i10,a)') nmax, ' values written to stdout'
182 write(istderr(),'(i10,a,a)') nmax, ' values written to file: ',
183 . file(1:index(file," ")-1)