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    BP208322  15/06/22    21:22:42     8543
  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. -INC SMCHAML
  29. -INC SMINTE
  30. -INC SMCOORD
  31. -INC SMELEME
  32. *
  33.       SEGMENT MWRK3
  34.         REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM)
  35.         REAL*8 VALVEC(NV)
  36.       ENDSEGMENT
  37. *
  38. *     Les MPTVAL recueillent les donnees pour le MCHAML resultat
  39. *     IVAL contient les pointeurs des MELVAL du nouveau MCHAML
  40. *
  41.       SEGMENT MPTVAL
  42.         INTEGER IPOS(NS) , NSOF(NS)
  43.         INTEGER IVAL(NCOSOU)
  44.         CHARACTER*16 TYVAL(NCOSOU)
  45.       ENDSEGMENT
  46. *
  47.       DIMENSION VECWRK(3),V1(4),V2(4),W2(3),W3(3)
  48.       DIMENSION CENTR1(3),CENTR2(3),AXEI1(3),VECX(3),VECY(3)
  49.       DIMENSION UR(3),UTHETA(3),UPHI(3),UN(3),UT(3),XIGAU(3)
  50. *
  51.       MELEME = IELEME
  52.       NBNN   = NUM(/1)
  53.       NBELEM = NUM(/2)
  54.       MINTE  = IINTE
  55.       NBPGAU = POIGAU(/1)
  56. *
  57.       NDIM=IDIM
  58.       IF (IFOMEM.EQ.1) NDIM=IDIM+1
  59.       NV=NVEC
  60.       NV2=2
  61.       IF(NV.EQ.9) NV2=3
  62.       SEGINI MWRK3
  63. *
  64. *     Boucle sur les elements
  65. *
  66.       DO 1010  IB=1,NBELEM
  67. *
  68. *        Boucle sur les points de Gauss
  69. *
  70.          DO 1010 IGAU=1,NBPGAU
  71. *
  72.             MPTVAL=IVAVEC
  73.             DO 1011 IV=1,NVEC
  74.                IF (IVAL(IV).NE.0) THEN
  75.                   MELVAL=IVAL(IV)
  76. cbp                   IBMN=MIN(IB,VELCHE(/2))
  77. cbp                   VALVEC(IV)=VELCHE(1,IBMN)
  78.                   IGMN = MIN(IGAU,VELCHE(/1))
  79.                   IBMN = MIN(IB,  VELCHE(/2))
  80.                   VALVEC(IV) = VELCHE(IGMN,IBMN)
  81.                ELSE
  82.                   VALVEC(IV)=0.D0
  83.                ENDIF
  84.  1011       CONTINUE
  85. *
  86. *  remplissage de la matrice de rotation
  87. *
  88.             CALL ZERO(R,NDIM,NDIM)
  89.             IF (IDIM.EQ.2.AND.IFOMEM.NE.1) THEN
  90.                R(1,1)=VALVEC(1)
  91.                R(1,2)=VALVEC(2)
  92.                R(2,1)=VALVEC(NV2+1)
  93.                R(2,2)=VALVEC(NV2+2)
  94.             ELSE
  95.                DO 1012 I=1,NDIM
  96.                  IN=(I-1)*NDIM
  97.                  DO 1012 J=1,NDIM
  98.                    IJ=IN+J
  99.                    R(I,J)=VALVEC(IJ)
  100.  1012          CONTINUE
  101.             ENDIF
  102. *
  103.             CALL TRSPOD (R,NDIM,NDIM,RT)
  104. *
  105. *           Sous-zones du MCHAML avant rotation
  106. *
  107.             MPTVAL=IVACOM
  108. *
  109. *           Tenseur avant changement de repere
  110. *
  111.             MELVAL=IVAL(1)
  112.             IGMN = MIN(IGAU,VELCHE(/1))
  113.             IBMN = MIN(IB,  VELCHE(/2))
  114.             A(1,1) =  VELCHE(IGMN,IBMN)
  115. *
  116.             MELVAL=IVAL(2)
  117.             IGMN = MIN(IGAU,VELCHE(/1))
  118.             IBMN = MIN(IB,  VELCHE(/2))
  119.             A(2,2) = VELCHE(IGMN,IBMN)
  120. *
  121.             MELVAL=IVAL(4)
  122.             IGMN = MIN(IGAU,VELCHE(/1))
  123.             IBMN = MIN(IB,  VELCHE(/2))
  124.             A(1,2) = VELCHE(IGMN,IBMN)
  125. *
  126.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0
  127.             A(2,1)=A(1,2)
  128. *
  129.             IF (IFOMEM.LT.1) GOTO 6610
  130. *
  131.             MELVAL=IVAL(3)
  132.             IGMN = MIN(IGAU,VELCHE(/1))
  133.             IBMN = MIN(IB,  VELCHE(/2))
  134.             A(3,3) = VELCHE(IGMN,IBMN)
  135. *
  136.             MELVAL=IVAL(5)
  137.             IGMN = MIN(IGAU,VELCHE(/1))
  138.             IBMN = MIN(IB,  VELCHE(/2))
  139.             A(3,1) = VELCHE(IGMN,IBMN)
  140. *
  141.             MELVAL=IVAL(6)
  142.             IGMN = MIN(IGAU,VELCHE(/1))
  143.             IBMN = MIN(IB,  VELCHE(/2))
  144.             A(3,2) = VELCHE(IGMN,IBMN)
  145. *
  146.             IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0
  147.             IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0
  148.             A(1,3)=A(3,1)
  149.             A(2,3)=A(3,2)
  150. *
  151.             MELVAL=IVAL(3)
  152.             IGMN = MIN(IGAU,VELCHE(/1))
  153.             IBMN = MIN(IB,  VELCHE(/2))
  154.             A(3,3) = VELCHE(IGMN,IBMN)
  155. *
  156.  6610       CONTINUE
  157. *
  158.             MELVAL=IVAL(3)
  159.             IGMN = MIN(IGAU,VELCHE(/1))
  160.             IBMN = MIN(IB,  VELCHE(/2))
  161.             AUX = VELCHE(IGMN,IBMN)
  162. *
  163.             IF(KMOT.EQ.1) THEN
  164. *                                           t
  165. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  166. *
  167.               CALL MULMAT(TRAV,A,R,NDIM,NDIM,NDIM)
  168.               CALL MULMAT(A,RT,TRAV,NDIM,NDIM,NDIM)
  169. *
  170.             ELSE
  171. *                                                 t
  172. *           >>>  Rotation du tenseur : A = R  A  R  <<<
  173. *
  174.               CALL MULMAT(TRAV,A,RT,NDIM,NDIM,NDIM)
  175.               CALL MULMAT(A,R,TRAV,NDIM,NDIM,NDIM)
  176.             ENDIF
  177. *
  178. *           Tenseur apres changement de repere
  179. *           Sous-zones du MCHAML resultat
  180. *
  181.             MPTVAL=IVARES
  182. *
  183.             MELVAL=IVAL(1)
  184.             VELCHE(IGAU,IB) = A(1,1)
  185. *
  186.             MELVAL=IVAL(2)
  187.             VELCHE(IGAU,IB) = A(2,2)
  188. *
  189.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0
  190. *
  191.             MELVAL=IVAL(4)
  192.             VELCHE(IGAU,IB) = A(1,2)
  193. *
  194.             IF (IFOMEM.LT.1) THEN
  195. *
  196.                MELVAL=IVAL(3)
  197.                VELCHE(IGAU,IB)= AUX
  198. *
  199.             ELSE
  200. *
  201.                MELVAL=IVAL(3)
  202.                VELCHE(IGAU,IB)=A(3,3)
  203. *
  204.                IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0
  205.                IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0
  206. *
  207.                MELVAL=IVAL(5)
  208.                VELCHE(IGAU,IB)= A(3,1)
  209. *
  210.                MELVAL=IVAL(6)
  211.                VELCHE(IGAU,IB)=A(3,2)
  212. *
  213.             ENDIF
  214. *
  215.  1010 CONTINUE
  216.       SEGSUP MWRK3
  217. *
  218.       RETURN
  219.       END
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  

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