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

works...

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: 1721
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 2c16a3b3
c this is <nlnmtab.f>
c ----------------------------------------------------------------------------
c ($Id: nlnmtab.f,v 1.1 2005-06-06 15:01:35 tforb Exp $)
c ($Id: nlnmtab.f,v 1.2 2005-06-06 15:29:47 tforb Exp $)
c
c Copyright (c) 2005 by Thomas Forbriger (BFO Schiltach)
c
......@@ -18,21 +18,26 @@ c
& 'NLNMTAB V1.0 write table of NLNM values')
character*(*) NLNMTAB_CVS_ID
parameter(NLNMTAB_CVS_ID=
& '$Id: nlnmtab.f,v 1.1 2005-06-06 15:01:35 tforb Exp $')
& '$Id: nlnmtab.f,v 1.2 2005-06-06 15:29:47 tforb Exp $')
c
c
logical useperiod, uselog
double precision f,p,f1,f2,df
integer k,n
character*80 outstring
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=2)
parameter(maxopt=7)
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-/
data optid/2h-d, 2h-v, 2h-p, 2h-s, 2h-e, 2h-n, 2h-l/
data opthasarg/3*.FALSE.,3*.TRUE.,.FALSE./
data optarg/3*1h-,5h1.e-4,3h10.,3h100,1h-/
c
c------------------------------------------------------------------------------
c basic information
......@@ -40,14 +45,19 @@ c
c
argument=' '
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().lt.1)) then
if ((argument(1:5).eq.'-help').or.(iargc().lt.0)) then
print *,version
print *,'Usage: nlnmtab arguments'
print *,'Usage: nlnmtab [-p] [-s s] [-e e] [-n n] [-l]'
print *,' or: nlnmtab -help'
if (argument(1:5).ne.'-help')
& stop 'ERROR: wrong number of arguments'
print *,' '
print *,'j'
print *,'-p specify signal period rather than frequency'
print *,'-s s start table at frequency/period ''s'' '
print *,'-e e end table at frequency/period ''e'' '
print *,'-n n subdivide frequency/period range into'
print *,' ''n'' intervals of equal size.'
print *,'-l use equal intervals on a logarithmic scale'
print *,' '
print *,NLNMTAB_CVS_ID
stop
......@@ -60,12 +70,103 @@ c
& optarg, optset, opthasarg)
debug=optset(1)
verbose=optset(2)
c
useperiod=optset(3)
read(optarg(4), *) f1
read(optarg(5), *) f2
read(optarg(6), *) n
uselog=optset(7)
c
c------------------------------------------------------------------------------
c go
c
print 50,'# New Low Noise Model ',
& '(Peterson 1993, USGS Open File Report 93-322)'
print 50,'# (parameters are given in Tab. 3 on page 36)'
if (useperiod) then
outstring='period (s)'
else
outstring='frequency (Hz)'
endif
print 50,'# first column: ',outstring(1:index(outstring, ')'))
print 50,'# second column: power spectral density in dB'
print 50,'# referred to 1 (m/s**2)**2/Hz'
c
if (uselog) then
f1=log10(f1)
f2=log10(f2)
endif
df=(f2-f1)/n
do k=0,n
f=f1+k*df
if (uselog) then
f=10.d0**f
endif
if (useperiod) then
p=f
else
p=1./f
endif
print 51,f,fnlnm(p)
enddo
c
stop
50 format(a,a)
51 format(g10.4,2x,f10.3)
end
c
c----------------------------------------------------------------------
c evaluate NLNM
c
double precision function fnlnm(p)
c
double precision p
c
c data table and function copied from noisecon.f by Erhard Wielandt
c
c the function returns the power spectral density in dB
c referred to 1 (m/s**2)**2/Hz
c
double precision per(21),a(21),b(21)
integer k
c
c New Low Noise Model (Peterson 1993, USGS Open File Report 93-322)
c (parameters are given in Tab. 3 on page 36)
c
data per(1),a(1),b(1) / 0.1,-162.36,5.64 /
data per(2),a(2),b(2) / 0.17,-166.7,0 /
data per(3),a(3),b(3) / 0.4,-170,-8.3 /
data per(4),a(4),b(4) / 0.8,-166.4,28.9 /
data per(5),a(5),b(5) / 1.24,-168.6,52.48 /
data per(6),a(6),b(6) / 2.4,-159.98,29.81 /
data per(7),a(7),b(7) / 4.3,-141.1,0 /
data per(8),a(8),b(8) / 5,-71.36,-99.77 /
data per(9),a(9),b(9) / 6,-97.26,-66.49 /
data per(10),a(10),b(10) / 10,-132.18,-31.57 /
data per(11),a(11),b(11) / 12,-205.27,36.16 /
data per(12),a(12),b(12) / 15.6,-37.65,-104.33 /
data per(13),a(13),b(13) / 21.9,-114.37,-47.1 /
data per(14),a(14),b(14) / 31.6,-160.58,-16.28 /
data per(15),a(15),b(15) / 45,-187.5,0 /
data per(16),a(16),b(16) / 70,-216.47,15.7 /
data per(17),a(17),b(17) / 101,-185,0 /
data per(18),a(18),b(18) / 154,-168.34,-7.61 /
data per(19),a(19),b(19) / 328,-217.43,11.9 /
data per(20),a(20),b(20) / 600,-258.28,26.6 /
data per(21),a(21),b(21) / 10000,-346.88,48.75 /
IF (p.lt.0.1) THEN
c write(6,*) ' NLNM undefined, OLNM used'
fnlnm=-168.
ELSE IF (p.le.100000.) then
do k=1,20
IF (p.lt.per(k+1)) goto 20
enddo
20 fnlnm=a(k)+b(k)*LOG10(p)
ELSE
write(6,*) ' NLNM undefined'
fnlnm=0.
ENDIF
END
c
c
c ----- END OF nlnmtab.f -----
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