1 : C PRIN35 SOURCE CHAT 05/01/13 02:27:21 5004 2 : c************************************************************************** 3 : SUBROUTINE PRIN35(B,BPR,QEN,Q6,Q6T) 4 : c************************************************************************** 5 : IMPLICIT INTEGER(I-N) 6 : real*8 b(4),bpr(3),qen(3,3),q6(6,6),q6t(6,6) 7 : integer i,j,k,l,nrot 8 : qen(1,1) = b(1) 9 : qen(2,2) = b(2) 10 : qen(3,3) = b(3) 11 : qen(2,1) = b(4) 12 : qen(1,2) = b(4) 13 : qen(3,1) = 0.d0 14 : qen(3,2) = 0.d0 15 : qen(1,3) = 0.d0 16 : qen(2,3) = 0.d0 16 : call eig35(qen,bpr,nrot) 17 : do i=1,3 18 : do j=1,3 19 : k=1+mod(i,3) 20 : l=1+mod(j,3) 21 : q6(i,j) = qen(i,j)**2 22 : q6t(i,j) = qen(j,i)**2 23 : q6(i+3,j) = qen(i,j)*qen(k,j) 24 : q6t(i+3,j) = qen(j,i)*qen(j,k) 25 : q6(j,i+3) = qen(j,i)*qen(j,k)*2.D0 26 : q6t(j,i+3) = qen(i,j)*qen(k,j) 27 : q6(j+3,i+3) = qen(j,i)*qen(l,k)+qen(j,k)*qen(l,i) 28 : q6t(j+3,i+3)=(qen(i,j)*qen(k,l)+qen(k,j)*qen(i,l))/2d0 29 : end do 30 : end do 31 : return 32 : end 33 : 34 :
© Cast3M 2003 - All rights reserved.
Disclaimer