Download maxro2.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer