Télécharger la plaquette Cast3M


fr en

Télécharger maxro2.eso

Retour à la liste

Numérotation des lignes : 

maxro2

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales