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

linear

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: 2167
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent a28a6a59
......@@ -8,6 +8,7 @@ c
c REVISIONS and CHANGES
c 02/01/98 V1.0 Thomas Forbriger
c 24/01/99 V1.1 added mit of section feature
c 08/08/06 V1.2 support gradient too
c
c==============================================================================
c
......@@ -15,10 +16,10 @@ c
c
character*79 version
parameter(version=
& 'POLEX V1.1 calculate polynomial exapnsion coefficients')
& 'POLEX V1.2 calculate polynomial expansion coefficients')
c
c calc
integer mord, mdim
integer mord, mdim, nord
parameter(mord=3,mdim=12)
real matrix(mdim,mdim), a(mdim),
& p(mord), rs(mdim), x(mord), z(mord), res(mord)
......@@ -31,22 +32,23 @@ c
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=1)
parameter(maxopt=2)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
logical linear
c debugging
logical debug
c here are the keys to our commandline options
data optid/2h-d/
data opthasarg/.FALSE./
data optarg/1h-/
data optid/2h-d,2h-l/
data opthasarg/2*.FALSE./
data optarg/2*1h-/
c
c------------------------------------------------------------------------------
c basic information
c
print *,version
print *,'Usage: polex '
print *,'Usage: polex [-l]'
print *,' or: polex -help'
c
c if (iargc().lt.1) stop 'ERROR: missing arguments'
......@@ -58,6 +60,9 @@ c if (iargc().lt.1) stop 'ERROR: missing arguments'
print *,' '
print *,'polynomial: y(x)=c(0)*x+c(1)*x+c(2)*x**2'
print *,' '
print *,'-l use gradient:'
print *,' y(x)=c(0)*x+c(1)*x'
print *,' '
print *,'x is calculated from coordinates as follows:'
print *,' zmid=0.5*(ztop+zbottom)'
print *,' x=z-zmid'
......@@ -80,10 +85,13 @@ c
call tf_cmdline(1, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
debug=optset(1)
linear=optset(2)
c
c------------------------------------------------------------------------------
c go
c
nord=mord
if (linear) nord=2
anothergame=.true.
do while (anothergame)
c
......@@ -92,42 +100,42 @@ c
zmid=0.5d0*(ztop+zbottom)
print *,'mid is ',zmid
c
print *,'enter z, p, d (',mord,' times):'
print *,'enter z, p, d (',nord,' times):'
print *,' '
do i=1,mord
do i=1,nord
read (5, *, err=99, end=98) z(i), p(i), deriv(i)
x(i)=z(i)-zmid
rs(i)=p(i)
enddo
c
do i=1,mord
do i=1,nord
if (deriv(i).eq.0) then
do j=1,mord
do j=1,nord
matrix(i, j)=x(i)**(j-1)
enddo
else
deriv(i)=1
do j=1,mord
do j=1,nord
matrix(i, j)=(j-1)*x(i)**(j-2)
enddo
endif
enddo
c
print *,' '
do i=1,mord
print 53,(matrix(i,j), j=1,mord)
do i=1,nord
print 53,(matrix(i,j), j=1,nord)
enddo
c
call tf_gauss(matrix, mord, rs, a)
call tf_gauss(matrix, nord, rs, a)
c
print 51, mord-1
do i=1,mord
print 51, nord-1
do i=1,nord
print 50, i-1,a(i)
enddo
c
do i=1,mord
do i=1,nord
res(i)=0.
do j=1,mord
do j=1,nord
if (deriv(i).eq.0) then
res(i)=res(i)+x(i)**(j-1)*a(j)
else
......@@ -136,7 +144,7 @@ c
enddo
enddo
c
do i=1,mord
do i=1,nord
print 52,deriv(i),x(i),res(i),p(i)
enddo
c
......
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