You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

321 lines
14 KiB

subroutine determinant(N,Nphy,Y,det)
implicit none
include 'lib/TensorReduction/Include/types.f'
integer::N,Nphy
real(dp):: Y(Nphy,NPhy), det
real(dp)::
. y11,y12,y13,y14,y15,y16,
. y21,y22,y23,y24,y25,y26,
. y31,y32,y33,y34,y35,y36,
. y41,y42,y43,y44,y45,y46,
. y51,y52,y53,y54,y55,y56,
. y61,y62,y63,y64,y65,y66,
. x11,x12,x13,x14,x15,x16
C Takes the determinant of up to a 6*6 matrix
if (N .eq. 1) then
det=y(1,1)
elseif (N .eq. 2) then
y11=y(1,1)
y12=y(1,2)
y21=y(2,1)
y22=y(2,2)
det=y11*y22-y12*y21
elseif (N .eq. 3) then
y11=y(1,1)
y12=y(1,2)
y13=y(1,3)
y21=y(2,1)
y22=y(2,2)
y23=y(2,3)
y31=y(3,1)
y32=y(3,2)
y33=y(3,3)
det = y11*(y22*y33-y23*y32)
. -y12*(y21*y33-y23*y31)
. +y13*(y21*y32-y22*y31)
elseif (N .eq. 4) then
y11=y(1,1)
y12=y(1,2)
y13=y(1,3)
y14=y(1,4)
y21=y(2,1)
y22=y(2,2)
y23=y(2,3)
y24=y(2,4)
y31=y(3,1)
y32=y(3,2)
y33=y(3,3)
y34=y(3,4)
y41=y(4,1)
y42=y(4,2)
y43=y(4,3)
y44=y(4,4)
det = y11*(y22*(y33*y44-y34*y43)-y23*(y32*y44-y34*y42)+y24*(y32*y
1 43-y33*y42))-y12*(y21*(y33*y44-y34*y43)-y23*(y31*y44-y34*y41)+y
2 24*(y31*y43-y33*y41))+y13*(y21*(y32*y44-y34*y42)-y22*(y31*y44-y
3 34*y41)+y24*(y31*y42-y32*y41))-y14*(y21*(y32*y43-y33*y42)-y22*(
4 y31*y43-y33*y41)+y23*(y31*y42-y32*y41))
elseif (N .eq. 5) then
y11=y(1,1)
y12=y(1,2)
y13=y(1,3)
y14=y(1,4)
y15=y(1,5)
y21=y(2,1)
y22=y(2,2)
y23=y(2,3)
y24=y(2,4)
y25=y(2,5)
y31=y(3,1)
y32=y(3,2)
y33=y(3,3)
y34=y(3,4)
y35=y(3,5)
y41=y(4,1)
y42=y(4,2)
y43=y(4,3)
y44=y(4,4)
y45=y(4,5)
y51=y(5,1)
y52=y(5,2)
y53=y(5,3)
y54=y(5,4)
y55=y(5,5)
det = y11*(y22*(y33*(y44*y55-y45*y54)-y34*(y43*y55-y45*y53)+y35*(
1 y43*y54-y44*y53))-y23*(y32*(y44*y55-y45*y54)-y34*(y42*y55-y45*y
2 52)+y35*(y42*y54-y44*y52))+y24*(y32*(y43*y55-y45*y53)-y33*(y42*
3 y55-y45*y52)+y35*(y42*y53-y43*y52))-y25*(y32*(y43*y54-y44*y53)-
4 y33*(y42*y54-y44*y52)+y34*(y42*y53-y43*y52)))-y12*(y21*(y33*(y4
5 4*y55-y45*y54)-y34*(y43*y55-y45*y53)+y35*(y43*y54-y44*y53))-y23
6 *(y31*(y44*y55-y45*y54)-y34*(y41*y55-y45*y51)+y35*(y41*y54-y44*
7 y51))+y24*(y31*(y43*y55-y45*y53)-y33*(y41*y55-y45*y51)+y35*(y41
8 *y53-y43*y51))-y25*(y31*(y43*y54-y44*y53)-y33*(y41*y54-y44*y51)
9 +y34*(y41*y53-y43*y51)))+y13*(y21*(y32*(y44*y55-y45*y54)-y34*(y
: 42*y55-y45*y52)+y35*(y42*y54-y44*y52))-y22*(y31*(y44*y55-y45*y5
; 4)-y34*(y41*y55-y45*y51)+y35*(y41*y54-y44*y51))+y24*(y31*(y42*y
< 55-y45*y52)-y32*(y41*y55-y45*y51)+y35*(y41*y52-y42*y51))-y25*(y
= 31*(y42*y54-y44*y52)-y32*(y41*y54-y44*y51)+y34*(y41*y52-y42*y51
> )))-y14*(y21*(y32*(y43*y55-y45*y53)-y33*(y42*y55-y45*y52)+y35*(
? y42*y53-y43*y52))-y22*(y31*(y43*y55-y45*y53)-y33*(y41*y55-y45*y
@ 51)+y35*(y41*y53-y43*y51))+y23*(y31*(y42*y55-y45*y52)-y32*(y41*
1 y55-y45*y51)+y35*(y41*y52-y42*y51))-y25*(y31*(y42*y53-y43*y52)-
2 y32*(y41*y53-y43*y51)+y33*(y41*y52-y42*y51)))+y15*(y21*(y32*(y4
3 3*y54-y44*y53)-y33*(y42*y54-y44*y52)+y34*(y42*y53-y43*y52))-y22
4 *(y31*(y43*y54-y44*y53)-y33*(y41*y54-y44*y51)+y34*(y41*y53-y43*
5 y51))+y23*(y31*(y42*y54-y44*y52)-y32*(y41*y54-y44*y51)+y34*(y41
6 *y52-y42*y51))-y24*(y31*(y42*y53-y43*y52)-y32*(y41*y53-y43*y51)
7 +y33*(y41*y52-y42*y51)))
elseif (N .eq. 6) then
y11=y(1,1)
y12=y(1,2)
y13=y(1,3)
y14=y(1,4)
y15=y(1,5)
y16=y(1,6)
y21=y(2,1)
y22=y(2,2)
y23=y(2,3)
y24=y(2,4)
y25=y(2,5)
y26=y(2,6)
y31=y(3,1)
y32=y(3,2)
y33=y(3,3)
y34=y(3,4)
y35=y(3,5)
y36=y(3,6)
y41=y(4,1)
y42=y(4,2)
y43=y(4,3)
y44=y(4,4)
y45=y(4,5)
y46=y(4,6)
y51=y(5,1)
y52=y(5,2)
y53=y(5,3)
y54=y(5,4)
y55=y(5,5)
y56=y(5,6)
y61=y(6,1)
y62=y(6,2)
y63=y(6,3)
y64=y(6,4)
y65=y(6,5)
y66=y(6,6)
x11 = y11*(y22*(y33*(y44*(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+y
1 46*(y54*y65-y55*y64))-y34*(y43*(y55*y66-y56*y65)-y45*(y53*y66-y
2 56*y63)+y46*(y53*y65-y55*y63))+y35*(y43*(y54*y66-y56*y64)-y44*(
3 y53*y66-y56*y63)+y46*(y53*y64-y54*y63))-y36*(y43*(y54*y65-y55*y
4 64)-y44*(y53*y65-y55*y63)+y45*(y53*y64-y54*y63)))-y23*(y32*(y44
5 *(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+y46*(y54*y65-y55*y64))
6 -y34*(y42*(y55*y66-y56*y65)-y45*(y52*y66-y56*y62)+y46*(y52*y65-
7 y55*y62))+y35*(y42*(y54*y66-y56*y64)-y44*(y52*y66-y56*y62)+y46*
8 (y52*y64-y54*y62))-y36*(y42*(y54*y65-y55*y64)-y44*(y52*y65-y55*
9 y62)+y45*(y52*y64-y54*y62)))+y24*(y32*(y43*(y55*y66-y56*y65)-y4
: 5*(y53*y66-y56*y63)+y46*(y53*y65-y55*y63))-y33*(y42*(y55*y66-y5
; 6*y65)-y45*(y52*y66-y56*y62)+y46*(y52*y65-y55*y62))+y35*(y42*(y
< 53*y66-y56*y63)-y43*(y52*y66-y56*y62)+y46*(y52*y63-y53*y62))-y3
= 6*(y42*(y53*y65-y55*y63)-y43*(y52*y65-y55*y62)+y45*(y52*y63-y53
> *y62)))-y25*(y32*(y43*(y54*y66-y56*y64)-y44*(y53*y66-y56*y63)+y
? 46*(y53*y64-y54*y63))-y33*(y42*(y54*y66-y56*y64)-y44*(y52*y66-y
@ 56*y62)+y46*(y52*y64-y54*y62))+y34*(y42*(y53*y66-y56*y63)-y43*(
1 y52*y66-y56*y62)+y46*(y52*y63-y53*y62))-y36*(y42*(y53*y64-y54*y
2 63)-y43*(y52*y64-y54*y62)+y44*(y52*y63-y53*y62)))+y26*(y32*(y43
3 *(y54*y65-y55*y64)-y44*(y53*y65-y55*y63)+y45*(y53*y64-y54*y63))
4 -y33*(y42*(y54*y65-y55*y64)-y44*(y52*y65-y55*y62)+y45*(y52*y64-
5 y54*y62))+y34*(y42*(y53*y65-y55*y63)-y43*(y52*y65-y55*y62)+y45*
6 (y52*y63-y53*y62))-y35*(y42*(y53*y64-y54*y63)-y43*(y52*y64-y54*
7 y62)+y44*(y52*y63-y53*y62))))
x12 = -y12*(y21*(y33*(y44*(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+
1 y46*(y54*y65-y55*y64))-y34*(y43*(y55*y66-y56*y65)-y45*(y53*y66-
2 y56*y63)+y46*(y53*y65-y55*y63))+y35*(y43*(y54*y66-y56*y64)-y44*
3 (y53*y66-y56*y63)+y46*(y53*y64-y54*y63))-y36*(y43*(y54*y65-y55*
4 y64)-y44*(y53*y65-y55*y63)+y45*(y53*y64-y54*y63)))-y23*(y31*(y4
5 4*(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+y46*(y54*y65-y55*y64)
6 )-y34*(y41*(y55*y66-y56*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65
7 -y55*y61))+y35*(y41*(y54*y66-y56*y64)-y44*(y51*y66-y56*y61)+y46
8 *(y51*y64-y54*y61))-y36*(y41*(y54*y65-y55*y64)-y44*(y51*y65-y55
9 *y61)+y45*(y51*y64-y54*y61)))+y24*(y31*(y43*(y55*y66-y56*y65)-y
: 45*(y53*y66-y56*y63)+y46*(y53*y65-y55*y63))-y33*(y41*(y55*y66-y
; 56*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65-y55*y61))+y35*(y41*(
< y53*y66-y56*y63)-y43*(y51*y66-y56*y61)+y46*(y51*y63-y53*y61))-y
= 36*(y41*(y53*y65-y55*y63)-y43*(y51*y65-y55*y61)+y45*(y51*y63-y5
> 3*y61)))-y25*(y31*(y43*(y54*y66-y56*y64)-y44*(y53*y66-y56*y63)+
? y46*(y53*y64-y54*y63))-y33*(y41*(y54*y66-y56*y64)-y44*(y51*y66-
@ y56*y61)+y46*(y51*y64-y54*y61))+y34*(y41*(y53*y66-y56*y63)-y43*
1 (y51*y66-y56*y61)+y46*(y51*y63-y53*y61))-y36*(y41*(y53*y64-y54*
2 y63)-y43*(y51*y64-y54*y61)+y44*(y51*y63-y53*y61)))+y26*(y31*(y4
3 3*(y54*y65-y55*y64)-y44*(y53*y65-y55*y63)+y45*(y53*y64-y54*y63)
4 )-y33*(y41*(y54*y65-y55*y64)-y44*(y51*y65-y55*y61)+y45*(y51*y64
5 -y54*y61))+y34*(y41*(y53*y65-y55*y63)-y43*(y51*y65-y55*y61)+y45
6 *(y51*y63-y53*y61))-y35*(y41*(y53*y64-y54*y63)-y43*(y51*y64-y54
7 *y61)+y44*(y51*y63-y53*y61))))
x13 = y13*(y21*(y32*(y44*(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+y
1 46*(y54*y65-y55*y64))-y34*(y42*(y55*y66-y56*y65)-y45*(y52*y66-y
2 56*y62)+y46*(y52*y65-y55*y62))+y35*(y42*(y54*y66-y56*y64)-y44*(
3 y52*y66-y56*y62)+y46*(y52*y64-y54*y62))-y36*(y42*(y54*y65-y55*y
4 64)-y44*(y52*y65-y55*y62)+y45*(y52*y64-y54*y62)))-y22*(y31*(y44
5 *(y55*y66-y56*y65)-y45*(y54*y66-y56*y64)+y46*(y54*y65-y55*y64))
6 -y34*(y41*(y55*y66-y56*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65-
7 y55*y61))+y35*(y41*(y54*y66-y56*y64)-y44*(y51*y66-y56*y61)+y46*
8 (y51*y64-y54*y61))-y36*(y41*(y54*y65-y55*y64)-y44*(y51*y65-y55*
9 y61)+y45*(y51*y64-y54*y61)))+y24*(y31*(y42*(y55*y66-y56*y65)-y4
: 5*(y52*y66-y56*y62)+y46*(y52*y65-y55*y62))-y32*(y41*(y55*y66-y5
; 6*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65-y55*y61))+y35*(y41*(y
< 52*y66-y56*y62)-y42*(y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y3
= 6*(y41*(y52*y65-y55*y62)-y42*(y51*y65-y55*y61)+y45*(y51*y62-y52
> *y61)))-y25*(y31*(y42*(y54*y66-y56*y64)-y44*(y52*y66-y56*y62)+y
? 46*(y52*y64-y54*y62))-y32*(y41*(y54*y66-y56*y64)-y44*(y51*y66-y
@ 56*y61)+y46*(y51*y64-y54*y61))+y34*(y41*(y52*y66-y56*y62)-y42*(
1 y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y36*(y41*(y52*y64-y54*y
2 62)-y42*(y51*y64-y54*y61)+y44*(y51*y62-y52*y61)))+y26*(y31*(y42
3 *(y54*y65-y55*y64)-y44*(y52*y65-y55*y62)+y45*(y52*y64-y54*y62))
4 -y32*(y41*(y54*y65-y55*y64)-y44*(y51*y65-y55*y61)+y45*(y51*y64-
5 y54*y61))+y34*(y41*(y52*y65-y55*y62)-y42*(y51*y65-y55*y61)+y45*
6 (y51*y62-y52*y61))-y35*(y41*(y52*y64-y54*y62)-y42*(y51*y64-y54*
7 y61)+y44*(y51*y62-y52*y61))))
x14 = -y14*(y21*(y32*(y43*(y55*y66-y56*y65)-y45*(y53*y66-y56*y63)+
1 y46*(y53*y65-y55*y63))-y33*(y42*(y55*y66-y56*y65)-y45*(y52*y66-
2 y56*y62)+y46*(y52*y65-y55*y62))+y35*(y42*(y53*y66-y56*y63)-y43*
3 (y52*y66-y56*y62)+y46*(y52*y63-y53*y62))-y36*(y42*(y53*y65-y55*
4 y63)-y43*(y52*y65-y55*y62)+y45*(y52*y63-y53*y62)))-y22*(y31*(y4
5 3*(y55*y66-y56*y65)-y45*(y53*y66-y56*y63)+y46*(y53*y65-y55*y63)
6 )-y33*(y41*(y55*y66-y56*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65
7 -y55*y61))+y35*(y41*(y53*y66-y56*y63)-y43*(y51*y66-y56*y61)+y46
8 *(y51*y63-y53*y61))-y36*(y41*(y53*y65-y55*y63)-y43*(y51*y65-y55
9 *y61)+y45*(y51*y63-y53*y61)))+y23*(y31*(y42*(y55*y66-y56*y65)-y
: 45*(y52*y66-y56*y62)+y46*(y52*y65-y55*y62))-y32*(y41*(y55*y66-y
; 56*y65)-y45*(y51*y66-y56*y61)+y46*(y51*y65-y55*y61))+y35*(y41*(
< y52*y66-y56*y62)-y42*(y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y
= 36*(y41*(y52*y65-y55*y62)-y42*(y51*y65-y55*y61)+y45*(y51*y62-y5
> 2*y61)))-y25*(y31*(y42*(y53*y66-y56*y63)-y43*(y52*y66-y56*y62)+
? y46*(y52*y63-y53*y62))-y32*(y41*(y53*y66-y56*y63)-y43*(y51*y66-
@ y56*y61)+y46*(y51*y63-y53*y61))+y33*(y41*(y52*y66-y56*y62)-y42*
1 (y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y36*(y41*(y52*y63-y53*
2 y62)-y42*(y51*y63-y53*y61)+y43*(y51*y62-y52*y61)))+y26*(y31*(y4
3 2*(y53*y65-y55*y63)-y43*(y52*y65-y55*y62)+y45*(y52*y63-y53*y62)
4 )-y32*(y41*(y53*y65-y55*y63)-y43*(y51*y65-y55*y61)+y45*(y51*y63
5 -y53*y61))+y33*(y41*(y52*y65-y55*y62)-y42*(y51*y65-y55*y61)+y45
6 *(y51*y62-y52*y61))-y35*(y41*(y52*y63-y53*y62)-y42*(y51*y63-y53
7 *y61)+y43*(y51*y62-y52*y61))))
x15 = y15*(y21*(y32*(y43*(y54*y66-y56*y64)-y44*(y53*y66-y56*y63)+y
1 46*(y53*y64-y54*y63))-y33*(y42*(y54*y66-y56*y64)-y44*(y52*y66-y
2 56*y62)+y46*(y52*y64-y54*y62))+y34*(y42*(y53*y66-y56*y63)-y43*(
3 y52*y66-y56*y62)+y46*(y52*y63-y53*y62))-y36*(y42*(y53*y64-y54*y
4 63)-y43*(y52*y64-y54*y62)+y44*(y52*y63-y53*y62)))-y22*(y31*(y43
5 *(y54*y66-y56*y64)-y44*(y53*y66-y56*y63)+y46*(y53*y64-y54*y63))
6 -y33*(y41*(y54*y66-y56*y64)-y44*(y51*y66-y56*y61)+y46*(y51*y64-
7 y54*y61))+y34*(y41*(y53*y66-y56*y63)-y43*(y51*y66-y56*y61)+y46*
8 (y51*y63-y53*y61))-y36*(y41*(y53*y64-y54*y63)-y43*(y51*y64-y54*
9 y61)+y44*(y51*y63-y53*y61)))+y23*(y31*(y42*(y54*y66-y56*y64)-y4
: 4*(y52*y66-y56*y62)+y46*(y52*y64-y54*y62))-y32*(y41*(y54*y66-y5
; 6*y64)-y44*(y51*y66-y56*y61)+y46*(y51*y64-y54*y61))+y34*(y41*(y
< 52*y66-y56*y62)-y42*(y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y3
= 6*(y41*(y52*y64-y54*y62)-y42*(y51*y64-y54*y61)+y44*(y51*y62-y52
> *y61)))-y24*(y31*(y42*(y53*y66-y56*y63)-y43*(y52*y66-y56*y62)+y
? 46*(y52*y63-y53*y62))-y32*(y41*(y53*y66-y56*y63)-y43*(y51*y66-y
@ 56*y61)+y46*(y51*y63-y53*y61))+y33*(y41*(y52*y66-y56*y62)-y42*(
1 y51*y66-y56*y61)+y46*(y51*y62-y52*y61))-y36*(y41*(y52*y63-y53*y
2 62)-y42*(y51*y63-y53*y61)+y43*(y51*y62-y52*y61)))+y26*(y31*(y42
3 *(y53*y64-y54*y63)-y43*(y52*y64-y54*y62)+y44*(y52*y63-y53*y62))
4 -y32*(y41*(y53*y64-y54*y63)-y43*(y51*y64-y54*y61)+y44*(y51*y63-
5 y53*y61))+y33*(y41*(y52*y64-y54*y62)-y42*(y51*y64-y54*y61)+y44*
6 (y51*y62-y52*y61))-y34*(y41*(y52*y63-y53*y62)-y42*(y51*y63-y53*
7 y61)+y43*(y51*y62-y52*y61))))
x16 = -y16*(y21*(y32*(y43*(y54*y65-y55*y64)-y44*(y53*y65-y55*y63)+
1 y45*(y53*y64-y54*y63))-y33*(y42*(y54*y65-y55*y64)-y44*(y52*y65-
2 y55*y62)+y45*(y52*y64-y54*y62))+y34*(y42*(y53*y65-y55*y63)-y43*
3 (y52*y65-y55*y62)+y45*(y52*y63-y53*y62))-y35*(y42*(y53*y64-y54*
4 y63)-y43*(y52*y64-y54*y62)+y44*(y52*y63-y53*y62)))-y22*(y31*(y4
5 3*(y54*y65-y55*y64)-y44*(y53*y65-y55*y63)+y45*(y53*y64-y54*y63)
6 )-y33*(y41*(y54*y65-y55*y64)-y44*(y51*y65-y55*y61)+y45*(y51*y64
7 -y54*y61))+y34*(y41*(y53*y65-y55*y63)-y43*(y51*y65-y55*y61)+y45
8 *(y51*y63-y53*y61))-y35*(y41*(y53*y64-y54*y63)-y43*(y51*y64-y54
9 *y61)+y44*(y51*y63-y53*y61)))+y23*(y31*(y42*(y54*y65-y55*y64)-y
: 44*(y52*y65-y55*y62)+y45*(y52*y64-y54*y62))-y32*(y41*(y54*y65-y
; 55*y64)-y44*(y51*y65-y55*y61)+y45*(y51*y64-y54*y61))+y34*(y41*(
< y52*y65-y55*y62)-y42*(y51*y65-y55*y61)+y45*(y51*y62-y52*y61))-y
= 35*(y41*(y52*y64-y54*y62)-y42*(y51*y64-y54*y61)+y44*(y51*y62-y5
> 2*y61)))-y24*(y31*(y42*(y53*y65-y55*y63)-y43*(y52*y65-y55*y62)+
? y45*(y52*y63-y53*y62))-y32*(y41*(y53*y65-y55*y63)-y43*(y51*y65-
@ y55*y61)+y45*(y51*y63-y53*y61))+y33*(y41*(y52*y65-y55*y62)-y42*
1 (y51*y65-y55*y61)+y45*(y51*y62-y52*y61))-y35*(y41*(y52*y63-y53*
2 y62)-y42*(y51*y63-y53*y61)+y43*(y51*y62-y52*y61)))+y25*(y31*(y4
3 2*(y53*y64-y54*y63)-y43*(y52*y64-y54*y62)+y44*(y52*y63-y53*y62)
4 )-y32*(y41*(y53*y64-y54*y63)-y43*(y51*y64-y54*y61)+y44*(y51*y63
5 -y53*y61))+y33*(y41*(y52*y64-y54*y62)-y42*(y51*y64-y54*y61)+y44
6 *(y51*y62-y52*y61))-y34*(y41*(y52*y63-y53*y62)-y42*(y51*y63-y53
7 *y61)+y43*(y51*y62-y52*y61))))
det=x11+x12+x13+x14+x15+x16
return
else
write(6,*) 'Unimplemented value of N in determinant, N=',N
stop
endif
return
end