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
****************************************************************************