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

support modulus calculation

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: 765
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 6a86bac1
# ---------------------------------------
# this is <Makefile>
# ----------------------------------------------------------------------------
# $Id: Makefile,v 1.3 2002-03-27 12:26:45 forbrig Exp $
#
# Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
#
# some tools to manipulate green files
#
# REVISIONS and CHANGES
# 27/03/2002 V1.0 Thomas Forbriger
#
# ============================================================================
#
# Makefile fuer tools/green
#
# ---------------------------------------
all:
flist: Makefile $(wildcard *.f *.inc)
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=-lm -lf2c -L${SERVERLIBDIR} -L${LOCLIBDIR}
#F2CLIB=-lm -lgo32f2c -L$(LOCLIBDIR)
......@@ -22,6 +43,5 @@ make.incdep: *.f
@rm $(<:.f=.c)
newprog $@
clean:
-/bin/rm *.o *.bak
# ----- END OF Makefile -----
c this is <grenorm.f>
c------------------------------------------------------------------------------
c
c $Id: grenorm.f,v 1.5 2001-08-27 11:03:23 forbrig Exp $
c $Id: grenorm.f,v 1.6 2002-03-27 12:26:45 forbrig Exp $
c
c 28/06/99 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -18,13 +18,14 @@ c in one part (not every part)
c V1.5 improved cosine moving average again
c 23/08/01 V1.6 allow amplitude normalize
c 27/08/01 V1.7 allow amplitude norm with taper file
c 27/03/02 V1.8 support calculation of modulus
c
c==============================================================================
c
program grenorm
c
character*79 version
parameter(version='GRENORM V1.7 GREens function will be NORMalized')
parameter(version='GRENORM V1.8 GREens function will be NORMalized')
c
c data
integer maxslo, maxfreq
......@@ -54,7 +55,7 @@ c
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=13)
parameter(maxopt=14)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -62,16 +63,16 @@ c debugging
logical debug, verbose
c options
logical opt_gauss, opt_weight, opt_clip, opt_none, opt_resp, opt_tap
logical opt_mova, opt_amp
logical opt_mova, opt_amp, opt_modulus
character*80 weight_file, resp_file, tap_file
real gauss_center, gauss_width, gauss_limit, maxamp_val, slo_limit
real clip_level
integer mova_len
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 2h-g, 2h-w, 2h-c, 2h-N, 2h-r, 2h-t, 2h-n, 2h-l,
& 2h-C,2h-m,2h-a/
data opthasarg/2*.FALSE.,2*.TRUE.,2*.FALSE.,6*.TRUE.,.false./
data optarg/2*1h-,8h5.,5.,0.,5*1h-,2h1.,2h0.,2h1.,2h10,1h-/
& 2h-C,2h-m,2h-a,2h-A/
data opthasarg/2*.FALSE.,2*.TRUE.,2*.FALSE.,6*.TRUE.,2*.false./
data optarg/2*1h-,8h5.,5.,0.,5*1h-,2h1.,2h0.,2h1.,2h10,2*1h-/
c
c------------------------------------------------------------------------------
c basic information
......@@ -83,7 +84,7 @@ c
print *,version
print *,'Usage: grenorm infile outfile [-v] [-d] [-c]'
print *,' [-g c,w,l | -w file | -N] [-r file] [-t file]'
print *,' [-n val] [-l slo] [-C val] [-m l] [-a]'
print *,' [-n val] [-l slo] [-C val] [-m l] [-a] [-A]'
print *,' or: grenorm -help'
if (argument(1:5).ne.'-help') stop 'ERROR: wrong number of arguments'
print *,' '
......@@ -109,11 +110,13 @@ c
print *,'-m l when normalizing frequencies: apply moveing'
print *,' of length ''l'' to scaling factors'
print *,'-a normalize to maximum amplitude not to integral'
print *,'-A take real absolute value (modulus) of'
print *,' coefficients and return them.'
print *,' '
print *,'Default method is to use a boxcar taper with a value of'
print *,'1. for each coefficient.'
print *,' '
print *,'$Id: grenorm.f,v 1.5 2001-08-27 11:03:23 forbrig Exp $'
print *,'$Id: grenorm.f,v 1.6 2002-03-27 12:26:45 forbrig Exp $'
stop
endif
c
......@@ -140,6 +143,7 @@ c
opt_mova=optset(12)
read(optarg(12), *) mova_len
opt_amp=optset(13)
opt_modulus=optset(14)
c we use s/m
slo_limit=slo_limit*1.e-3
c
......@@ -443,6 +447,21 @@ c
enddo
enddo
endif
c----------------------------------------------------------------------
c
c calculate modulus
c
if (opt_modulus) then
print *,'take modulus...'
do i=1,nom
do j=1,nslo
absval=abs(green(i,j))
green(i,j)=cmplx(absval,0.)
enddo
enddo
endif
c
c write green code (easy to use)
c
......
Supports Markdown
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