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    CB215821  26/08/24    21:18:21     12622          
  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 6611  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 6612 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.  6612          CONTINUE
  96.             ENDIF
  97. *
  98.             CALL TRSPOD (R,NDIM,NDIM,RT)
  99. *
  100. *           Sous-zones du MCHAML avant rotation
  101. *
  102.             MPTVAL=IVACOM
  103. *
  104. *           Tenseur avant changement de repere
  105. *
  106.             MELVAL=IVAL(1)
  107.             IGMN = MIN(IGAU,VELCHE(/1))
  108.             IBMN = MIN(IB,  VELCHE(/2))
  109.             A(1,1) =  VELCHE(IGMN,IBMN)
  110. *
  111.             MELVAL=IVAL(2)
  112.             IGMN = MIN(IGAU,VELCHE(/1))
  113.             IBMN = MIN(IB,  VELCHE(/2))
  114.             A(2,2) = VELCHE(IGMN,IBMN)
  115. *
  116.             MELVAL=IVAL(4)
  117.             IGMN = MIN(IGAU,VELCHE(/1))
  118.             IBMN = MIN(IB,  VELCHE(/2))
  119.             A(1,2) = VELCHE(IGMN,IBMN)
  120. *
  121.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0
  122.             A(2,1)=A(1,2)
  123. *
  124.             IF (IFOMEM.LT.1) GOTO 6610
  125. *
  126.             MELVAL=IVAL(3)
  127.             IGMN = MIN(IGAU,VELCHE(/1))
  128.             IBMN = MIN(IB,  VELCHE(/2))
  129.             A(3,3) = VELCHE(IGMN,IBMN)
  130. *
  131.             MELVAL=IVAL(5)
  132.             IGMN = MIN(IGAU,VELCHE(/1))
  133.             IBMN = MIN(IB,  VELCHE(/2))
  134.             A(3,1) = VELCHE(IGMN,IBMN)
  135. *
  136.             MELVAL=IVAL(6)
  137.             IGMN = MIN(IGAU,VELCHE(/1))
  138.             IBMN = MIN(IB,  VELCHE(/2))
  139.             A(3,2) = VELCHE(IGMN,IBMN)
  140. *
  141.             IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0
  142.             IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0
  143.             A(1,3)=A(3,1)
  144.             A(2,3)=A(3,2)
  145. *
  146.             MELVAL=IVAL(3)
  147.             IGMN = MIN(IGAU,VELCHE(/1))
  148.             IBMN = MIN(IB,  VELCHE(/2))
  149.             A(3,3) = VELCHE(IGMN,IBMN)
  150. *
  151.  6610       CONTINUE
  152. *
  153.             MELVAL=IVAL(3)
  154.             IGMN = MIN(IGAU,VELCHE(/1))
  155.             IBMN = MIN(IB,  VELCHE(/2))
  156.             AUX = VELCHE(IGMN,IBMN)
  157. *
  158.             IF(KMOT.EQ.1) THEN
  159. *                                           t
  160. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  161. *
  162.               CALL MULMAT(TRAV,A,R,NDIM,NDIM,NDIM)
  163.               CALL MULMAT(A,RT,TRAV,NDIM,NDIM,NDIM)
  164. *
  165.             ELSE
  166. *                                                 t
  167. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  168. *
  169.               CALL MULMAT(TRAV,A,RT,NDIM,NDIM,NDIM)
  170.               CALL MULMAT(A,R,TRAV,NDIM,NDIM,NDIM)
  171.             ENDIF
  172. *
  173. *           Tenseur apres changement de repere
  174. *           Sous-zones du MCHAML resultat
  175. *
  176.             MPTVAL=IVARES
  177. *
  178.             MELVAL=IVAL(1)
  179.             VELCHE(IGAU,IB) = A(1,1)
  180. *
  181.             MELVAL=IVAL(2)
  182.             VELCHE(IGAU,IB) = A(2,2)
  183. *
  184.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0
  185. *
  186.             MELVAL=IVAL(4)
  187.             VELCHE(IGAU,IB) = A(1,2)
  188. *
  189.             IF (IFOMEM.LT.1) THEN
  190. *
  191.                MELVAL=IVAL(3)
  192.                VELCHE(IGAU,IB)= AUX
  193. *
  194.             ELSE
  195. *
  196.                MELVAL=IVAL(3)
  197.                VELCHE(IGAU,IB)=A(3,3)
  198. *
  199.                IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0
  200.                IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0
  201. *
  202.                MELVAL=IVAL(5)
  203.                VELCHE(IGAU,IB)= A(3,1)
  204. *
  205.                MELVAL=IVAL(6)
  206.                VELCHE(IGAU,IB)=A(3,2)
  207. *
  208.             ENDIF
  209. *
  210.  1010 CONTINUE
  211.  6611 CONTINUE
  212.       SEGSUP MWRK3
  213.  
  214.       RETURN
  215.       END
  216.  
  217.  
  218.  
  219.  

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