Commit fc987213 authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

new SRCE manipulation

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 737
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent e3cd8276
# ---------------------------------------
# this is <Makefile>
# ----------------------------------------------------------------------------
# $Id: Makefile,v 1.4 2002-03-14 10:46:38 forbrig Exp $
#
# Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
#
# SFF header manipulation
#
# REVISIONS and CHANGES
# 14/03/2002 V1.0 Thomas Forbriger
#
# ============================================================================
#
# $Id: Makefile,v 1.3 2000-10-12 17:44:56 forbrig Exp $
#
# Makefile fuer tools /src/ts/hd
#
# ---------------------------------------
all:
flist: Makefile $(wildcard *.f)
echo $^ | tr ' ' '\n' | sort > $@
.PHONY: edit
edit: flist; vim $<
.PHONY: clean
clean: ;
-find . -name \*.bak | xargs --no-run-if-empty /bin/rm -v
-/bin/rm -vf flist *.o
F2CLIB=-lf2c -lm -L${SERVERLIBDIR}
PGPLOTLIB=-lf2cpgplot52 -lX11 -L/usr/X11/lib
......@@ -19,13 +38,12 @@ F2CFLAGS=-f -u
gcc $(CFLAGS) $(<:.f=.c) -c -I${SERVERINCLUDEDIR} -I${LOCINCLUDEDIR}
@rm $(<:.f=.c)
clean:
-/bin/rm *.o *.bak
coma epi chaco: %: %.o
coma epi chaco sesoc: %: %.o
$(CC) -o $@ $< $(LIBTF) $(LIBSFF) $(F2CLIB)
newprog $@
offli sesot merse: %: %.o
$(CC) -o $@ $< $(LIBTF) -lsffu -ltime_trad $(LIBSFF) $(F2CLIB)
newprog $@
# ----- END OF Makefile -----
c this is <sesoc.f>
c ----------------------------------------------------------------------------
c ($Id: sesoc.f,v 1.1 2002-03-14 10:46:38 forbrig Exp $)
c
c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
c
c SEt SOurce Coordinate
c
c REVISIONS and CHANGES
c 14/03/2002 V1.0 Thomas Forbriger
c
c ============================================================================
program sesoc
c
character*79 version
parameter(version='SESOC V1.0 SEt SOurce Coordinate')
c
character*80 infile,outfile,coordstring
character*200 line
character*1 CS
real CX,CY,CZ
integer luin, luout, tfstr_trimlen
parameter(luin=10,luout=11)
logical infree
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=2)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-d, 2h-v/
data opthasarg/2*.FALSE./
data optarg/2*1h-/
c
c------------------------------------------------------------------------------
c basic information
c
c
argument=' '
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().ne.3)) then
print *,version
print *,'Usage: sesot C,x,y,z infile outfile'
print *,' or: sesot -help'
if (argument(1:5).ne.'-help') stop 'ERROR: wrong number of arguments'
print *,' '
print *,'SEt SOurce Coordinate'
print *,' '
print *,'This program sets the source location in an SFF data file'
print *,' '
print *,'C,x,y,z coordinate according to SFF specification'
print *,'infile input dataset'
print *,'outfile output dataset'
stop
endif
c
c------------------------------------------------------------------------------
c read command line arguments
c
call tf_cmdline(1, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
debug=optset(1)
verbose=optset(2)
c
call getarg(1, coordstring)
call getarg(2, infile)
call getarg(3, outfile)
c
c------------------------------------------------------------------------------
c go
read (coordstring, '(a1,3(f10))') CS,cx,cy,cz
c
open(luin, file=infile, status='old', err=99)
open(luout, file=outfile, status='new', err=98)
c
2 continue
read(luin, '(a200)', err=95, end=1) line
if (infree) then
if (line(1:5).eq.'FREE ') infree=.false.
else
if (line(1:5).eq.'SRCE ') then
print *,' '
line(27:27)=CS
write(line(29:43), '(f15.6)') CX
write(line(44:58), '(f15.6)') CY
write(line(59:73), '(f15.6)') CZ
print *,'new SRCE line is'
print *,line(1:91)
elseif (line(1:5).eq.'FREE ') then
infree=.true.
endif
endif
write(luout, '(a)', err=94) line(1:tfstr_trimlen(line))
goto 2
c
1 close(luout, err=97)
close(luin, err=96)
c
stop
99 stop 'ERROR: opening input file'
98 stop 'ERROR: opening output file'
97 stop 'ERROR: closing output file'
96 stop 'ERROR: closing input file'
95 stop 'ERROR: reading input file'
94 stop 'ERROR: writing input file'
end
c
c ----- END OF sesoc.f -----
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment