SUBROUTINE SYMUNCTION(Ncompj,p,c,apj)
IMPLICIT REAL*8(a--h,0--z)
REAL*8 mmatrix(100,100)
INTEGER factor,p
DIMENSION c(100), s(100)
*
* Compute the power-sym series: s = signma[ (1/Ci)
**lambda ]
*
n = p - j
do 1000 lambda = 1, n
sum = 0.d00
do 2000 i = 1, Ncomp
sum = sum + (1.d0/c(i))**lambda
2000 continue
s(lambda) = sum
1000 continue
Build the matrix MMATRIX
do 3000 k = 1, n
d0 4000 1 = 1, n
if(l .LE. k) mmatrix(k,l) = s(k-l+1)
if(l .EQ. k+l) mmatrix(k,l) = DFLOAT(k)
if(l .GT. k+l) mmatrix(k,l) = 0.d00
4000 continue
3000 continue
* Since a1(1/Ci} forms a [1x1], matrix, its determinant is
the
* element itself
if(p-j .EQ. 1) then
det = mmatrix(1,1)
go to 5000
end if
*
* Compute the determinant of MMATRIX
*
call DETERM(mmatrix,n,det)
*
* Compute the elementary symmetric function
*
5000 apj = det/factor(n)
return
end
****************************************************************************
*
*
* Function to compute the factorial
*
*
****************************************************************************
FUNCTION factor(n)
INTEGER factor,i,n
factor = 1
if(n .GT. 0) then
do 6000 i = 2,n
factor = factor*i
6000 continue
end if
end
****************************************************************************
****************************************************************************
*
* 11 October 2009
*
* M. Michael Musatov
* Symmetry Engineering
* www.meami.org (C) 2009.
* All Rights Reserved.
*
* SUBROUTINE SYMFUNCTION@
*
* This subroutine calculates the elementary symmetric function
*
* a(p-j)[1/Ci}
*
*
****************************************************************************
SUBROUTINE SYMUNCTION(Ncompj,p,c,apj)
IMPLICIT REAL*8(a--h,0--z)
REAL*8 mm@rix(100,100)
INTEGER factor,p
DIMENSION c(100), s(100)
*
* Compute the power-sym series: s = signma[ (1/Ci)
**lambda ]
*
n = p - j
do 1000 lambda = 1, n
sum = 0.d00
do 2000 i = 1, Ncomp
sum = sum + (1.d0/c(i))**lambda
2000 continue
s(lambda) = sum
1000 continue
Build the m@rix MM@RIX
do 3000 k = 1, n
d0 4000 1 = 1, n
if(l .LE. k) mm@rix(k,l) = s(k-l+1)
if(l .EQ. k+l) mm@rix(k,l) = DFLOAT(k)
if(l .GT. k+l) mm@rix(k,l) = 0.d00
4000 continue
3000 continue
* Since a1(1/Ci} forms a [1x1], m@rix, its determinant is the
* element itself
if(p-j .EQ. 1) then
det = mm@rix(1,1)
go to 5000
end if
*
* Compute the determinant of MM@RIX
*
call DETERM(mm@rix,n,det)
*
* Compute the elementary symmetric function
*
5000 apj = det/factor(n)
return
end
****************************************************************************
*
*
* Function to compute the factorial
*
*
****************************************************************************
FUNCTION factor(n)
INTEGER factor,i,n
factor = 1
if(n .GT. 0) then
do 6000 i = 2,n
factor = factor*i
6000 continue
end if
end
****************************************************************************
vipopa = [determinant] -{?}
Well, I'm a little confused. MM@trix is not a legal fortran name so I
can only imagine you have copied it wrongly from somewhere. Did you
scan it using optical character recognition (OCR)? You will have to
change this name. Also,
IMPLICIT REAL*8(a--h,0--z)
should be
IMPLICIT REAL*8(a-h,o-z)
Again, looks like an OCR mistake.
As for how to use it, I don't know the maths well enough to guess
whether it is doing what you intend. You should be able to set up a
main PROGRAM and call SYMUNCTION from that. Note that subroutine
DETERM is missing from the code you sent. That will need to be present
as well.