Download maxro3.eso

Back to the list

   1 : C MAXRO3    SOURCE    CHAT      05/01/13    01:37:53     5004           
   2 :       SUBROUTINE MAXRO3(ICAS,IDEFO,S,A,R,RT,TRA,NDIM,IDIM,IFOUR)
   3 : *
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 : *
   7 :       DIMENSION R(NDIM,*),RT(NDIM,*),A(NDIM,*),TRA(NDIM,*)
   8 :       DIMENSION S(*)
   9 : *
  10 : 
  11 : *  ICAS = 1  :   RT A R
  12 : *  ICAS = 2  :   R A RT
  13 : 
  14 :  
  15 :  
  16 :  
  17 :             A(1,1) =  S(1)
  18 :             A(2,2) =  S(2)
  19 :             A(1,2) =  S(4)
  20 :             IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0                                  
  21 :             A(2,1)=A(1,2)                                                       
  22 : *                                                                               
  23 :             IF (IFOUR.LT.1) GOTO 666
  24 : *                                                                               
  25 :             A(3,3) = S(3)
  26 :             A(3,1) = S(5)
  27 :             A(3,2) = S(6)
  28 : *                              
  29 :             IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0                                  
  30 :             IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0                                  
  31 :             A(1,3)=A(3,1)                                                       
  32 :             A(2,3)=A(3,2)                                                       
  33 :             A(3,3) = S(3)
  34 : *                                                                               
  35 :  666        CONTINUE
  36 : *                                                                               
  37 : 
  38 :             IF(ICAS.EQ.1) THEN
  39 : 
  40 : *                                           t
  41 : *              >>>  Rotation du tenseur : A = R  A  R  <<<
  42 : *
  42 :                CALL MULMAT(TRA,A,R,NDIM,NDIM,NDIM)
  42 :                CALL MULMAT(A,RT,TRA,NDIM,NDIM,NDIM)
  43 : 
  44 : 
  45 :             ELSE IF(ICAS.EQ.2) THEN
  46 : 
  47 : *                                                t
  48 : *              >>>  Rotation du tenseur : A =  R A R   <<<
  49 : *
  49 :                CALL MULMAT(TRA,A,RT,NDIM,NDIM,NDIM)
  49 :                CALL MULMAT(A,R,TRA,NDIM,NDIM,NDIM)
  50 : 
  51 :             ENDIF
  52 : 
  53 :             S(1) = A(1,1)
  54 :             S(2) = A(2,2)
  55 : *                                                                               
  56 :             IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0                                        
  57 :             S(4) = A(1,2)
  58 : *                                                                               
  59 :             IF (IFOUR.GE.1) THEN
  60 : *                                                                               
  61 :                S(3) = A(3,3)
  62 : *                                                                               
  63 :                IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0                               
  64 :                IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0  
  65 :                S(5) = A(3,1)
  66 :                S(6) = A(3,2)
  67 : *                                                                               
  68 :             ENDIF                                                               
  69 : *                                                                               
  70 : *
  71 :       RETURN
  72 :       END
  73 :  
  74 :  

© Cast3M 2003 - All rights reserved.
Disclaimer