Download cmaxr2.eso

Back to the list

   1 : C CMAXR2    SOURCE    KICH      09/09/11    21:16:18     6505           
   2 :       SUBROUTINE CMAXR2(wrk52,wrk53,wrk54,ICAS,WR12,NCHAIN)
   3 : C MAXRO2    SOURCE    AM        00/12/13    21:38:11     4045           
   4 : *      SUBROUTINE MAXRO2(ICAS,WTRAV,WRK1,WRK5,WR12,NCHAIN)
   5 : *
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8(A-H,O-Z)
   8 : *
   9 : -INC CCOPTIO
  10 : -INC SMEVOLL
  11 : -INC SMLREEL
  12 : -INC CCHAMP
  13 : -INC DECHE
  14 : *
  15 :       SEGMENT WR12
  16 :         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  17 :         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  18 :         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  19 :         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  20 :         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  21 :         REAL*8  SM8(NSTRS)
  22 :       ENDSEGMENT
  23 : *
  24 :       SEGMENT WTRA2
  25 :         REAL*8 A(NDIM,NDIM)
  26 :         REAL*8 RR(NDIM,NDIM),RT(NDIM,NDIM),RTRA(NDIM,NDIM)
  27 :       ENDSEGMENT
  28 : *
  29 :       IDIM=XGLOB(/1)
  30 :       NDIM=IDIM
  31 :       IF(IFOUR.EQ.1) NDIM=IDIM+1
  32 : 
  33 :       NSTRS=SIG0(/1)
  34 : 
  35 :       SEGINI WTRA2
  36 : 
  37 : *  ICAS = 1  :   RT A R
  38 : *  ICAS = 2  :   R A RT
  39 : 
  40 :         DO I=1,IDIM
  41 :           DO J=1,IDIM
  42 :             RR(I,J)=XGLOB(I,J)
  43 :           ENDDO
  44 :         ENDDO
  45 :         IF(IDIM.EQ.2.AND.IFOUR.EQ.1) RR(3,3)=1.D0
  45 :         CALL TRSPOD(RR,NDIM,NDIM,RT)
  46 : *
  47 : *    ROTATION DES TENSEURS
  48 : *
  49 :        IDEFO=0
  49 :        CALL MAXRO3(ICAS,IDEFO,SM0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  49 :        CALL MAXRO3(ICAS,IDEFO,SM1,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  49 :        CALL MAXRO3(ICAS,IDEFO,SM2,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  49 :        CALL MAXRO3(ICAS,IDEFO,SM3,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  49 :        CALL MAXRO3(ICAS,IDEFO,SM4,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  50 :        IF(NCHAIN.GE.6) THEN
  50 :          CALL MAXRO3(ICAS,IDEFO,SM5,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  51 :        ENDIF
  52 :        IF(NCHAIN.GE.7) THEN
  52 :          CALL MAXRO3(ICAS,IDEFO,SM6,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  53 :         ENDIF
  54 :        IF(NCHAIN.GE.8) THEN
  54 :          CALL MAXRO3(ICAS,IDEFO,SM7,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  55 :        ENDIF
  56 :        IF(NCHAIN.GE.9) THEN
  56 :          CALL MAXRO3(ICAS,IDEFO,SM8,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  57 :        ENDIF
  58 : 
  59 : 
  60 :         IF(ICAS.EQ.1) THEN
  61 : 
  61 :         CALL MAXRO3(ICAS,IDEFO,SIG0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  62 :         IDEFO=1
  62 :         CALL MAXRO3(ICAS,IDEFO,DEPST,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  62 :         CALL MAXRO3(ICAS,IDEFO,EPIN0,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  63 : *
  64 : 
  65 :       ELSE IF(ICAS.EQ.2) THEN
  66 : 
  66 :         CALL MAXRO3(ICAS,IDEFO,SIGF,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  67 :         IDEFO=1
  67 :         CALL MAXRO3(ICAS,IDEFO,DEFP ,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  67 :         CALL MAXRO3(ICAS,IDEFO,EPINF,A,RR,RT,RTRA,NDIM,IDIM,IFOUR)
  68 : 
  69 :       ENDIF
  70 : 
  71 :       SEGSUP WTRA2
  72 : 
  73 :       RETURN
  74 :       END
  75 : 
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  

© Cast3M 2003 - All rights reserved.
Disclaimer