Télécharger la plaquette Cast3M


fr en

Télécharger rtens6.eso

Retour à la liste

Numérotation des lignes : 

rtens6

  1. C RTENS6    SOURCE    OF166741  25/02/21    21:18:29     12166          
  2.       SUBROUTINE RTENS6(IPCHE1,IFOMEM,IELEME,IVAVEC,IVACOM,
  3.      &                  IVARES,IDEFO,IINTE,MELE,NPINT,NVEC,KMOT)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *-----------------------------------------------------------------------*
  7. *     Operateur RTENS : cas de la formulation massive                   *
  8. *                                                                       *
  9. *     IPCHE1    (e)    pointeur sur un MCHAML de caracteristiques       *
  10. *                      = 0 si isotropie                                 *
  11. *     IFOMEM    (e)    = IFOUR de CCOPTIO                               *
  12. *     IELEME    (e)    pointeur sur le segment MELEME (actif)           *
  13. *     IVAVEC    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  14. *     IVACOM    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  15. *     IVARES    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  16. *     IDEFO     (e)    =1 : tenseur de deformations (contraintes sinon) *
  17. *     IINTE     (e)    pointeur sur le segment MINTE  (actif)           *
  18. *     MELE      (e)    numero de l'element-fini dans NOMTP              *
  19. *     NPINT     (e)    nombre de points d'integration (coques)          *
  20. *     NVEC      (e)    nombre de composantes du  MCHAML         IPCHE1
  21. *     KMOT      (e)    1 : transformation RT*A*R
  22. *                      2 : transformation R*A*RT
  23. *-----------------------------------------------------------------------*
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCHAMP
  28.  
  29. -INC SMCHAML
  30. -INC SMINTE
  31. -INC SMCOORD
  32. -INC SMELEME
  33.  
  34. -INC TMPTVAL
  35.  
  36.       SEGMENT MWRK3
  37.         REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM)
  38.         REAL*8 VALVEC(NV)
  39.       ENDSEGMENT
  40. *
  41.       DIMENSION VECWRK(3),V1(4),V2(4),W2(3),W3(3)
  42.       DIMENSION CENTR1(3),CENTR2(3),AXEI1(3),VECX(3),VECY(3)
  43.       DIMENSION UR(3),UTHETA(3),UPHI(3),UN(3),UT(3),XIGAU(3)
  44. *
  45.       MELEME = IELEME
  46.       NBNN   = NUM(/1)
  47.       NBELEM = NUM(/2)
  48.       MINTE  = IINTE
  49.       NBPGAU = POIGAU(/1)
  50. *
  51.       NDIM=IDIM
  52.       IF (IFOMEM.EQ.1) NDIM=IDIM+1
  53.       NV=NVEC
  54.       NV2=2
  55.       IF(NV.EQ.9) NV2=3
  56.       SEGINI MWRK3
  57. *
  58. *     Boucle sur les elements
  59. *
  60.       DO 1010  IB=1,NBELEM
  61. *
  62. *        Boucle sur les points de Gauss
  63. *
  64.          DO 1010 IGAU=1,NBPGAU
  65. *
  66.             MPTVAL=IVAVEC
  67.             DO 1011 IV=1,NVEC
  68.                IF (IVAL(IV).NE.0) THEN
  69.                   MELVAL=IVAL(IV)
  70. cbp                   IBMN=MIN(IB,VELCHE(/2))
  71. cbp                   VALVEC(IV)=VELCHE(1,IBMN)
  72.                   IGMN = MIN(IGAU,VELCHE(/1))
  73.                   IBMN = MIN(IB,  VELCHE(/2))
  74.                   VALVEC(IV) = VELCHE(IGMN,IBMN)
  75.                ELSE
  76.                   VALVEC(IV)=0.D0
  77.                ENDIF
  78.  1011       CONTINUE
  79. *
  80. *  remplissage de la matrice de rotation
  81. *
  82.             CALL ZERO(R,NDIM,NDIM)
  83.             IF (IDIM.EQ.2.AND.IFOMEM.NE.1) THEN
  84.                R(1,1)=VALVEC(1)
  85.                R(1,2)=VALVEC(2)
  86.                R(2,1)=VALVEC(NV2+1)
  87.                R(2,2)=VALVEC(NV2+2)
  88.             ELSE
  89.                DO 1012 I=1,NDIM
  90.                  IN=(I-1)*NDIM
  91.                  DO 1012 J=1,NDIM
  92.                    IJ=IN+J
  93.                    R(I,J)=VALVEC(IJ)
  94.  1012          CONTINUE
  95.             ENDIF
  96. *
  97.             CALL TRSPOD (R,NDIM,NDIM,RT)
  98. *
  99. *           Sous-zones du MCHAML avant rotation
  100. *
  101.             MPTVAL=IVACOM
  102. *
  103. *           Tenseur avant changement de repere
  104. *
  105.             MELVAL=IVAL(1)
  106.             IGMN = MIN(IGAU,VELCHE(/1))
  107.             IBMN = MIN(IB,  VELCHE(/2))
  108.             A(1,1) =  VELCHE(IGMN,IBMN)
  109. *
  110.             MELVAL=IVAL(2)
  111.             IGMN = MIN(IGAU,VELCHE(/1))
  112.             IBMN = MIN(IB,  VELCHE(/2))
  113.             A(2,2) = VELCHE(IGMN,IBMN)
  114. *
  115.             MELVAL=IVAL(4)
  116.             IGMN = MIN(IGAU,VELCHE(/1))
  117.             IBMN = MIN(IB,  VELCHE(/2))
  118.             A(1,2) = VELCHE(IGMN,IBMN)
  119. *
  120.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0
  121.             A(2,1)=A(1,2)
  122. *
  123.             IF (IFOMEM.LT.1) GOTO 6610
  124. *
  125.             MELVAL=IVAL(3)
  126.             IGMN = MIN(IGAU,VELCHE(/1))
  127.             IBMN = MIN(IB,  VELCHE(/2))
  128.             A(3,3) = VELCHE(IGMN,IBMN)
  129. *
  130.             MELVAL=IVAL(5)
  131.             IGMN = MIN(IGAU,VELCHE(/1))
  132.             IBMN = MIN(IB,  VELCHE(/2))
  133.             A(3,1) = VELCHE(IGMN,IBMN)
  134. *
  135.             MELVAL=IVAL(6)
  136.             IGMN = MIN(IGAU,VELCHE(/1))
  137.             IBMN = MIN(IB,  VELCHE(/2))
  138.             A(3,2) = VELCHE(IGMN,IBMN)
  139. *
  140.             IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0
  141.             IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0
  142.             A(1,3)=A(3,1)
  143.             A(2,3)=A(3,2)
  144. *
  145.             MELVAL=IVAL(3)
  146.             IGMN = MIN(IGAU,VELCHE(/1))
  147.             IBMN = MIN(IB,  VELCHE(/2))
  148.             A(3,3) = VELCHE(IGMN,IBMN)
  149. *
  150.  6610       CONTINUE
  151. *
  152.             MELVAL=IVAL(3)
  153.             IGMN = MIN(IGAU,VELCHE(/1))
  154.             IBMN = MIN(IB,  VELCHE(/2))
  155.             AUX = VELCHE(IGMN,IBMN)
  156. *
  157.             IF(KMOT.EQ.1) THEN
  158. *                                           t
  159. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  160. *
  161.               CALL MULMAT(TRAV,A,R,NDIM,NDIM,NDIM)
  162.               CALL MULMAT(A,RT,TRAV,NDIM,NDIM,NDIM)
  163. *
  164.             ELSE
  165. *                                                 t
  166. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  167. *
  168.               CALL MULMAT(TRAV,A,RT,NDIM,NDIM,NDIM)
  169.               CALL MULMAT(A,R,TRAV,NDIM,NDIM,NDIM)
  170.             ENDIF
  171. *
  172. *           Tenseur apres changement de repere
  173. *           Sous-zones du MCHAML resultat
  174. *
  175.             MPTVAL=IVARES
  176. *
  177.             MELVAL=IVAL(1)
  178.             VELCHE(IGAU,IB) = A(1,1)
  179. *
  180.             MELVAL=IVAL(2)
  181.             VELCHE(IGAU,IB) = A(2,2)
  182. *
  183.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0
  184. *
  185.             MELVAL=IVAL(4)
  186.             VELCHE(IGAU,IB) = A(1,2)
  187. *
  188.             IF (IFOMEM.LT.1) THEN
  189. *
  190.                MELVAL=IVAL(3)
  191.                VELCHE(IGAU,IB)= AUX
  192. *
  193.             ELSE
  194. *
  195.                MELVAL=IVAL(3)
  196.                VELCHE(IGAU,IB)=A(3,3)
  197. *
  198.                IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0
  199.                IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0
  200. *
  201.                MELVAL=IVAL(5)
  202.                VELCHE(IGAU,IB)= A(3,1)
  203. *
  204.                MELVAL=IVAL(6)
  205.                VELCHE(IGAU,IB)=A(3,2)
  206. *
  207.             ENDIF
  208. *
  209.  1010 CONTINUE
  210.       SEGSUP MWRK3
  211.  
  212.       RETURN
  213.       END
  214.  
  215.  
  216.  

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