Télécharger la plaquette Cast3M


fr en

Télécharger sicrot.eso

Retour à la liste

Numérotation des lignes : 

sicrot

  1. C SICROT    SOURCE    BP208322  17/03/01    21:18:14     9325           
  2.       SUBROUTINE SICROT (WRK0,WTRAV,IDEFO,VECINV,VECRES,iarr)
  3. *
  4. *
  5. *     cette subroutine effectue la rotation des tenseurs des
  6. *     contraintes (IDEFO=0) ou des deformation (IDEFO=1) dans
  7. *     le repere orthotrope du materiau. Elle est basee sur la
  8. *     subroutine RTENS
  9.       IMPLICIT INTEGER(I-N)
  10.  
  11.       SEGMENT WRK0
  12.         REAL*8 XMAT(NMATT)
  13.       ENDSEGMENT
  14.  
  15.  
  16.       SEGMENT WTRAV
  17.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  18.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  19.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  20.         REAL*8 XLOC(3,3),XGLOB(3,3)
  21.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  22.       ENDSEGMENT
  23.  
  24.  
  25.       REAL*8 VALVEC (6), VECINV(6), VECRES(6)
  26.       REAL*8 A(3,3), R(3,3), RT(3,3), RINV(3,3), MTEMP(3,3)
  27.  
  28.  
  29.  
  30.       CALL ZERO (VALVEC,6,1)
  31.       CALL ZERO (A,3,3)
  32.       CALL ZERO (R,3,3)
  33.       CALL ZERO (RINV,3,3)
  34.       CALL ZERO (RT,3,3)
  35.       CALL ZERO (MTEMP,3,3)
  36.  
  37.       iarr=0
  38.  
  39.  
  40.  
  41. *  Extraction des vecteurs des axe d'ortho.
  42.       VALVEC(1)=XMAT(10)
  43.       VALVEC(2)=XMAT(11)
  44.       VALVEC(3)=XMAT(12)
  45.       VALVEC(4)=XMAT(13)
  46.       VALVEC(5)=XMAT(14)
  47.       VALVEC(6)=XMAT(15)
  48.  
  49. *      WRITE (*,*) 'VALVEC'
  50. *      WRITE (*,*) (VALVEC(I),I=1,6)
  51.  
  52. *      WRITE (*,*)  'TXR'
  53. *      DO 5 I=1,3
  54. *         WRITE (*,*) (TXR(I,J), J=1,3)
  55. *5     CONTINUE
  56.  
  57.  
  58.  
  59.  
  60. * Calcul des cosinus directeurs des axes d'ortho.
  61.       CALL RGLOB (VALVEC,3,TXR,XLOC,XGLOB,2)
  62.  
  63. *      WRITE (*,*) 'XGLOB'
  64. *      DO 10 I=1,3
  65. *         DO 10 J=1,3
  66. *             WRITE (*,*) XGLOB(I,J)
  67. *10    CONTINUE
  68.  
  69.  
  70.  
  71. * On recopie et inverse la matrice XGLOB
  72.       DO 100 IC=1,3
  73.       DO 100 IL=1,3
  74.         R(IL,IC)=XGLOB(IL,IC)
  75. 100   CONTINUE
  76.  
  77.  
  78.  
  79.  
  80.  
  81. * Rotation du vecteur VECINV
  82.       A (1,1)= VECINV(1)
  83.       A (2,2)= VECINV(2)
  84.       A (3,3)= VECINV(3)
  85.       A (1,2)= VECINV(4)
  86.       A (1,3)= VECINV(5)
  87.       A (2,3)= VECINV(6)
  88.  
  89.       IF (IDEFO.EQ.1) THEN
  90.          A(1,2)= A(1,2)/2.0D0
  91.          A(1,3)= A(1,3)/2.0D0
  92.          A(2,3)= A(2,3)/2.0D0
  93.       ENDIF
  94.  
  95.       A (2,1)= A (1,2)
  96.       A (3,1)= A (1,3)
  97.       A (3,2)= A (2,3)
  98.  
  99.  
  100.       IF (IDEFO.EQ.1) THEN
  101.          CALL TRSPOD (R,3,3,RT)
  102.          CALL MULMAT (MTEMP,A,R,3,3,3)
  103.          CALL MULMAT (A,RT,MTEMP,3,3,3)
  104.       ELSE
  105. *         WRITE (*,*) 'R'
  106. *         DO 200 I=1,3
  107. *             WRITE (*,*) (R(I,J),J=1,3)
  108. *200      CONTINUE
  109.          CALL INVER3 (R,RINV)
  110. *         WRITE (*,*) 'R INVERSEE'
  111. *         DO 300 I=1,3
  112. *             WRITE (*,*) (RINV(I,J),J=1,3)
  113. *300      CONTINUE
  114.          CALL TRSPOD (RINV,3,3,RT)
  115.          CALL MULMAT (MTEMP,A,RINV,3,3,3)
  116.          CALL MULMAT (A,RT,MTEMP,3,3,3)
  117.       ENDIF
  118.  
  119.  
  120.  
  121.  
  122.       IF (IDEFO.EQ.1) THEN
  123.          A(1,2)= A(1,2)*2.0D0
  124.          A(1,3)= A(1,3)*2.0D0
  125.          A(2,3)= A(2,3)*2.0D0
  126.       ENDIF
  127.  
  128.       VECRES(1) =  A (1,1)
  129.       VECRES(2) =  A (2,2)
  130.       VECRES(3) =  A (3,3)
  131.       VECRES(4) =  A (1,2)
  132.       VECRES(5) =  A (1,3)
  133.       VECRES(6) =  A (2,3)
  134.  
  135.  
  136.  
  137.  
  138.       RETURN
  139.       END
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  

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