+++ /dev/null
-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
-c i/o utilities for TISEAN f-sources
-c author T. Schreiber (1998) based on earlier versions
-c===========================================================================
- subroutine readfile(nmax,x,nexcl,icol,file,iverb)
-c read at most nmax points, return nmax
- dimension x(nmax)
- character*(*) file
-
- iv=iv_io(iverb)
- if(icol.eq.0) icol=igetcol(file)
- if(icol.gt.0.and.iv.ne.0)
- . write(istderr(),*) 'reading from column', icol
- call infile(file,iunit,iverb)
- lc=0
- do 10 n=1,nexcl
- lc=lc+1
- 10 read(iunit,*,end=999)
- do 20 n=1,nmax
- 1 lc=lc+1
- read(iunit,*,err=2,end=999) (dum,i=1,icol-1), x(n)
- goto 20
- 2 if(iv.ne.0) write(istderr(),*) "data in line ", lc, " ignored"
- goto 1
- 20 continue
- if(iv.ne.0) write(istderr(),*) '*** readfile: warning:'//
- . ' maybe not the whole file has been used'
- 999 nmax=n-1
- if(iunit.ne.istdin()) close(iunit)
- if(iv.ne.0) call readreport(nmax,file)
- if(icol.gt.0.and.file.ne."-") call putcol(file,icol)
- end
-
- function igetcol(file)
- character*(*) file
-
- igetcol=0
- do 10 i=len(file),1,-1
- 10 if(file(i:i).eq.",") goto 1
- 1 if(i.eq.0) return
- read(file(i+1:len(file)),'(i10)',err=999) igetcol
- file(i:len(file))=" "
- 999 continue
- end
-
- subroutine putcol(file,icol)
- character*(*) file
-
- if(icol.le.9) then
- write(file(index(file," "):index(file," ")+1),'(1h,,i1)') icol
- else
- write(file(index(file," "):index(file," ")+2),'(1h,,i2)') icol
- endif
- end
-
- subroutine writecfile(nmax,x,file,iverb,comm)
-c write comment and nmax points
- dimension x(nmax)
- character*(*) file,comm
-
- call outfile(file,iunit,iverb)
- if(comm.ne." ") write(iunit,'(a)') comm
- do 10 n=1,nmax
- 10 write(iunit,*) x(n)
- if(iunit.eq.istdout()) then
- write(iunit,*)
- write(iunit,*)
- else
- close(iunit)
- endif
- if(iv_io(iverb).eq.1) call writereport(nmax,file)
- end
-
- subroutine writefile(nmax,x,file,iverb)
-c write nmax points
- dimension x(nmax)
- character*(*) file
-
- call writecfile(nmax,x,file,iverb," ")
- end
-
- subroutine infile(file,iunit,iverb)
-c open file for read on iunit=ifile(), or iunit=istdin() if "-"
- character*(*) file
-
- if(file.eq."-") then
- iunit=istdin()
- if(iv_io(iverb).eq.1) write(istderr(),*) "reading from stdin"
- return
- endif
- iunit=ifilein()
- open(iunit,file=file,status="old",err=999)
- if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)')
- . "opened ",file(1:index(file," ")-1), " for input"
- return
- 999 write(istderr(),'(a,a)') "Cannot open input file ",
- . file(1:index(file," ")-1)
- stop
- end
-
- subroutine outfile(file,iunit,iverb)
-c open file for write on iunit=ifileout(), or iunit=istdout() if file=" "
- character*(*) file
-
- if(file.eq." ") then
- iunit=istdout()
- if(iv_io(iverb).eq.1) write(istderr(),*) "writing to stdout"
- return
- endif
- iunit=ifileout()
- open(iunit,file=file,status='unknown',err=999)
- if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)')
- . "opened ",file(1:index(file," ")-1), " for output"
- return
- 999 write(istderr(),'(a,a)') "Cannot open output file ",
- . file(1:index(file," ")-1)
- stop
- end
-
- subroutine suffix(base,suff)
-c append stuff after last nonblank character in base
- character*(*) base, suff
-
- base=base(1:index(base," ")-1)//suff
- end
-
- subroutine addsuff(target,base,suff)
-c append stuff after last nonblank character in base
- character*(*) target,base, suff
-
- target=base(1:index(base," ")-1)//suff
- end
-
- subroutine readreport(nmax,file)
-c report on numbers read
- character*(*) file
-
- if(file.eq."-") then
- write(istderr(),'(i10,a)') nmax, ' values read from stdin'
- else
- write(istderr(),'(i10,a,a)') nmax, ' values read from file: ',
- . file(1:index(file," ")-1)
- endif
- if(nmax.ne.0) return
- if(file.eq."-") then
- write(istderr(),'(a)') "No input given - aborting."
- else
- write(istderr(),'(a,a,a)') "Input file ",
- . file(1:index(file," ")-1), " empty - aborting."
- endif
- call usage()
- end
-
- subroutine writereport(nmax,file)
-c report on numbers written
- character*(*) file
-
- if(file.eq." ") then
- write(istderr(),'(i10,a)') nmax, ' values written to stdout'
- else
- write(istderr(),'(i10,a,a)') nmax, ' values written to file: ',
- . file(1:index(file," ")-1)
- endif
- end
-
git://source.jalview.org / jabaws.git / blobdiff