Download deviat.eso

Back to the list

   1 : C DEVIAT    SOURCE    BR232186  12/08/01    21:15:22     7456           
   2 : C DEVIAT    SOURCE    BR      06/01/10    21:15:29     5284           
   3 :       SUBROUTINE DEVIAT(A,B)
   4 : C====================================================================== 
   5 : C Routine permettant de calculer le deviateur de A 
   6 : C
   7 : C     OBJET                                                                     
   8 : C     -----                                                                     
   9 : C     CALCUL DE B = DEVIAT(A) = A - (1.0D0/3.0D0) * TRACE(A) * UNIT                            
  10 : C                                                                               
  11 : C     ENTREES                                                                   
  12 : C     -------                                                                   
  13 : C     A(3,3) = MATRICE SYMETRIQUE          
  14 : C
  15 : C     SORTIES                                                                   
  16 : C     -------                                                                   
  17 : C     B      = DEVIAT(A) 
  18 : C                                                                               
  19 : C===============================================================                
  20 :       IMPLICIT INTEGER(I-N)
  21 :       IMPLICIT REAL*8 (A-H,O-Z)
  22 :       
  23 :       REAL*8 A(3,3),UNIT(3,3),B(3,3)
  24 :       
  25 :       TRA = A(1,1)+A(2,2)+A(3,3)
  26 :       
  27 :       DO I=1,3
  28 :          DO J=1,3
  29 :          
  30 :             UNIT(I,J) = 0.0D0
  31 :             
  32 :             IF (I.EQ.J) THEN
  33 :                UNIT(I,J) = 1.0D0
  34 :             ENDIF
  35 :             
  36 :          ENDDO
  37 :       ENDDO
  38 : 
  39 :       DO I=1,3
  40 :          DO J=1,3
  41 :          
  42 :             B(I,J) = 0.0D0
  43 :             B(I,J) = A(I,J) - (1.0D0/3.0D0)*TRA*UNIT(I,J)
  44 :          
  45 :          ENDDO
  46 :       ENDDO
  47 : 
  48 : 
  49 :       RETURN
  50 :       END
  51 : 
  52 :  
  53 :  
  54 :  
  55 :  
  56 :  

© Cast3M 2003 - All rights reserved.
Disclaimer