Download prin35.eso

Back to the list

   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