Télécharger la plaquette Cast3M


fr en

Télécharger rtens3.eso

Retour à la liste

Numérotation des lignes : 

rtens3

  1. C RTENS3    SOURCE    BP208322  15/06/22    21:22:40     8543
  2.       SUBROUTINE RTENS3(IPCHE1,IFOMEM,IMOT,IPTV2,IELEME,IVAVEC,IVACOM,
  3.      &           IVARES,IVAEP,IDEFO,IINTE,IINTE1,MELE,NPINT,NVEC,
  4.      &           V1,V2,W2,W3,CENTR1,CENTR2,AXEI1,ICAS,IER1)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *-----------------------------------------------------------------------*
  8. *     Operateur RTENS : cas de la formulation coque epaisse             *
  9. *                       (COQ6, COQ8)                                    *
  10. *                                                                       *
  11. *     IPCHE1    (e)    pointeur sur un MCHAML de caracteristiques       *
  12. *                      = 0 si isotropie                                 *
  13. *     IFOMEM    (e)    = IFOUR de CCOPTIO                               *
  14. *     IMOT      (e)    indique le type de repere desire (cf RTENS)      *
  15. *     IPTV2     (e)    pointeur sur le 2nd point repere                 *
  16. *     IELEME    (e)    pointeur sur le segment MELEME (actif)           *
  17. *     IVAVEC    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  18. *     IVACOM    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  19. *     IVARES    (e/s)  pointeur sur un segment MPTVAL (actif)           *
  20. *     IVAEP     (e)    pointeur sur un segment MPTVAL (actif)           *
  21. *     IDEFO     (e)    =1 : tenseur de deformations (contraintes sinon) *
  22. *     IINTE     (e)    pointeur sur le segment MINTE  (actif)           *
  23. *     IINTE1    (e)    pointeur sur le segment MINTE1 (non actif)       *
  24. *     MELE      (e)    numero de l'element-fini dans NOMTP              *
  25. *     NPINT     (e)    nombre de points d'integration (coques)          *
  26. *     NVEC      (e)    nombre de composantes du futur MCHAML            *
  27. *     V1        (e)    coordonnees et norme du 1er vecteur              *
  28. *     V2        (e)    coordonnees et norme du 2nd vecteur              *
  29. *     W2        (e)    coordonnees d'un 1er vecteur de travail          *
  30. *     W3        (e)    coordonnees d'un 2nd vecteur de travail          *
  31. *     CENTR1    (e)    coordonnees du 1er point repere                  *
  32. *     CENTR2    (e)    coordonnees du 2nd point repere                  *
  33. *     AXEI1     (e)    coordonnees du vecteur de l'axe de symetrie      *
  34. *     ICAS      (e)    distingue les differentes syntaxes d'appel       *
  35. *     IER1      (s)    code d'erreur pour desactivation                 *
  36. *     D.R.-M. le 21/3/94                                                *
  37. *-----------------------------------------------------------------------*
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42. -INC SMCHAML
  43. -INC SMINTE
  44. -INC SMCOORD
  45. -INC SMELEME
  46. *
  47. *     MWRK1,2,3 initialises dans RTENS3
  48. *
  49.       SEGMENT MWRK1
  50.         REAL*8 XEL(3,NBNN),XEL2(3,NBNN)
  51.       ENDSEGMENT
  52. *
  53.       SEGMENT MWRK2
  54.         REAL*8 TXR(3,3,NBNN),TH(NBNN)
  55.       ENDSEGMENT
  56. *
  57.       SEGMENT MWRK3
  58.         REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM)
  59.       ENDSEGMENT
  60. *
  61. *     Les MPTVAL recueillent les donnees pour le MCHAML resultat
  62. *     IVAL contient les pointeurs des MELVAL du nouveau MCHAML
  63. *
  64.       SEGMENT MPTVAL
  65.         INTEGER IPOS(NS) , NSOF(NS)
  66.         INTEGER IVAL(NCOSOU)
  67.         CHARACTER*16 TYVAL(NCOSOU)
  68.       ENDSEGMENT
  69. *
  70.       DIMENSION BPSS(3,3),T(9),V1(4),V2(4),W2(3),W3(3)
  71.       DIMENSION CENTR1(3),CENTR2(3),AXEI1(3)
  72. *
  73.       IER1=0
  74.       MELEME = IELEME
  75.       NBNN = NUM(/1)
  76.       NBELEM = NUM(/2)
  77.       NDIM = 3
  78.       MINTE = IINTE
  79.       NBPGAU = POIGAU(/1)
  80.       SEGINI MWRK1,MWRK2,MWRK3
  81.       MINTE1 = IINTE1
  82.       SEGACT MINTE1
  83. *
  84. *     Boucle sur les elements
  85. *
  86.       DO 1050  IB=1,NBELEM
  87. *
  88.          IF (ICAS.NE.1) THEN
  89. *
  90. *           Epaisseur de l'element courant
  91. *
  92.             DO 1060 IG = 1,NBNN
  93.                MPTVAL = IVAEP
  94.                MELVAL=IVAL(1)
  95.                IGMN=MIN(IG,VELCHE(/1))
  96.                IBMN=MIN(IB,VELCHE(/2))
  97.                TH(IG)=VELCHE(IGMN,IBMN)
  98.  1060       CONTINUE
  99. *
  100.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL)
  101.             CALL CQ8LOC(XEL,NBNN,MINTE1.SHPTOT,TXR,IRR)
  102.          ENDIF
  103. *
  104. *        Boucle sur les points de Gauss
  105. *
  106.          DO 1050 IGAU=1,NBPGAU
  107. *
  108.             IF (ICAS.EQ.1) THEN
  109. *
  110. *              On veut le tenseur dans le repere d'orthotropie
  111. *
  112.                MPTVAL=IVAVEC
  113. *
  114.                MELVAL=IVAL(1)
  115.                IBMN=MIN(IB,VELCHE(/2))
  116.                IGMN=MIN(IGAU,VELCHE(/1))
  117.                R(1,1)=VELCHE(IGMN,IBMN)
  118. *
  119.                MELVAL=IVAL(2)
  120.                IGMN=MIN(IGAU,VELCHE(/1))
  121.                IBMN=MIN(IB,VELCHE(/2))
  122.                R(2,1)=VELCHE(IGMN,IBMN)
  123.                RN=R(1,1)*R(1,1)+R(2,1)*R(2,1)
  124. *
  125.                IF (RN.EQ.0.D0) THEN
  126.                   CALL ERREUR(344)
  127.                   IER1 = 1
  128.                   GOTO 1050
  129.                ENDIF
  130. *
  131.                R(1,2)=-R(2,1)
  132.                R(2,2)= R(1,1)
  133.                R(3,3)= 1.D0
  134. *
  135.                CALL TRSPOD(R,NDIM,NDIM,RT)
  136.             ELSE
  137.                E = DZEGAU(IGAU)
  138.                CALL CQ8LC1(IGAU,NBNN,E,XEL,TH,SHPTOT,TXR,T,IRR)
  139. *
  140. *              Construction de la matrice de rotation qui fait
  141. *              passer d'un repere global au repere local au point
  142. *              d'integration
  143. *
  144.                K=0
  145.                DO 1053 I=1,3
  146.                   DO 1054 J=1,3
  147.                      K=K+1
  148.                      BPSS(I,J)=T(K)
  149. 1054              CONTINUE
  150. 1053           CONTINUE
  151.             ENDIF
  152. *
  153.             IF (ICAS.EQ.2) THEN
  154. *
  155. *              On veut le tenseur dans un repere defini
  156. *              par 1 ou 2 vecteurs
  157. *
  158.                VL11=BPSS(1,1)*V1(1)+BPSS(1,2)*V1(2)+BPSS(1,3)*V1(3)
  159.                VL12=BPSS(2,1)*V1(1)+BPSS(2,2)*V1(2)+BPSS(2,3)*V1(3)
  160.                VL1N=SQRT(VL11**2+VL12**2)
  161. *
  162.                IF (VL1N.EQ.0.D0) THEN
  163.                   CALL ERREUR(344)
  164.                   IER1 = 1
  165.                   GOTO 1050
  166.                ENDIF
  167. *
  168.                IF (IPTV2.NE.0) THEN
  169.                   VL21=BPSS(1,1)*V2(1)+BPSS(1,2)*V2(2)+BPSS(1,3)*V2(3)
  170.                   VL22=BPSS(2,1)*V2(1)+BPSS(2,2)*V2(2)+BPSS(2,3)*V2(3)
  171.                   VL2N=SQRT(VL21**2+VL22**2)
  172.                   IF (VL2N.EQ.0.D0) THEN
  173.                      CALL ERREUR(344)
  174.                      IER1 = 1
  175.                      GOTO 1050
  176.                   ENDIF
  177. *
  178.                   WL33=(VL11*VL22-VL12*VL21)/(VL1N*VL2N)
  179.                   WL21=(-WL33*VL12)/VL1N
  180.                   WL22=( WL33*VL11)/VL1N
  181.                ENDIF
  182. *
  183. *              Matrice de rotation faisant passer du repere local
  184. *              au point de Gauss au nouveau repere local defini
  185. *              a partir de la projection des vecteurs V1 et V2
  186. *              sur la coque
  187. *
  188.                IF (IPTV2.EQ.0) THEN
  189.                   R(1,1)= VL11/VL1N
  190.                   R(2,1)= VL12/VL1N
  191.                   R(1,2)=-VL12/VL1N
  192.                   R(2,2)= VL11/VL1N
  193.                   R(3,3)= 1.D0
  194.                ELSE
  195.                   R(1,1)=VL11/VL1N
  196.                   R(2,1)=VL12/VL1N
  197.                   R(1,2)=WL21
  198.                   R(2,2)=WL22
  199.                   R(3,3)=WL33
  200.                ENDIF
  201.                CALL TRSPOD(R,NDIM,NDIM,RT)
  202.             ENDIF
  203. *
  204.             IF (ICAS.EQ.3) THEN
  205. *
  206. *              Matrice de passage entre le repere local de la coque
  207. *              et la projection sur celle-ci du repere global choisi
  208. *
  209.                CALL RTENS5(IMOT,3,IGAU,NDIM,V1,CENTR1,CENTR2,BPSS,
  210.      &                     SHPTOT,XEL,NBNN,NBPGAU,R,SIGFLX,IER1)
  211.                IF (IER1.NE.0) THEN
  212.                   IF (IER1.EQ.1) CALL ERREUR(344)
  213.                   IF (IER1.EQ.2) CALL ERREUR(642)
  214.                   GOTO 1050
  215.                ENDIF
  216.                CALL TRSPOD(R,NDIM,NDIM,RT)
  217.             ENDIF
  218. *
  219. *           Rotation du tenseur pour les grandeurs de membrane
  220. *
  221.             CALL ZERO(A,3,3)
  222. *
  223.             MPTVAL=IVACOM
  224. *
  225.             MELVAL=IVAL(1)
  226.             IGMN=MIN(IGAU,VELCHE(/1))
  227.             IBMN=MIN(IB  ,VELCHE(/2))
  228.             A(1,1) =  VELCHE(IGMN,IBMN)
  229. *
  230.             MELVAL=IVAL(2)
  231.             IGMN=MIN(IGAU,VELCHE(/1))
  232.             IBMN=MIN(IB  ,VELCHE(/2))
  233.             A(2,2) = VELCHE(IGMN,IBMN)
  234. *
  235.             MELVAL=IVAL(3)
  236.             IGMN=MIN(IGAU,VELCHE(/1))
  237.             IBMN=MIN(IB  ,VELCHE(/2))
  238.             A(1,2) = VELCHE(IGMN,IBMN)
  239. *
  240.             MELVAL=IVAL(4)
  241.             IGMN=MIN(IGAU,VELCHE(/1))
  242.             IBMN=MIN(IB  ,VELCHE(/2))
  243.             A(1,3) = VELCHE(IGMN,IBMN)
  244. *
  245.             MELVAL=IVAL(5)
  246.             IGMN=MIN(IGAU,VELCHE(/1))
  247.             IBMN=MIN(IB  ,VELCHE(/2))
  248.             A(2,3) = VELCHE(IGMN,IBMN)
  249. *
  250.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0
  251.             IF (IDEFO.EQ.1) A(1,3)=A(1,3)/2.D0
  252.             IF (IDEFO.EQ.1) A(2,3)=A(2,3)/2.D0
  253.             A(2,1)=A(1,2)
  254.             A(3,1)=A(1,3)
  255.             A(3,2)=A(2,3)
  256. *                                           t
  257. *           >>> Changement de repere : A = R  A  R  <<<
  258. *
  259.             CALL MULMAT(TRAV,A,R,3,3,3)
  260.             CALL MULMAT(A,RT,TRAV,3,3,3)
  261. *
  262.             MPTVAL=IVARES
  263. *
  264.             MELVAL=IVAL(1)
  265.             VELCHE(IGAU,IB)=A(1,1)
  266. *
  267.             MELVAL=IVAL(2)
  268.             VELCHE(IGAU,IB)=A(2,2)
  269. *
  270.             IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0
  271.             IF (IDEFO.EQ.1) A(1,3)=A(1,3)*2.D0
  272.             IF (IDEFO.EQ.1) A(2,3)=A(2,3)*2.D0
  273. *
  274.             MELVAL=IVAL(3)
  275.             VELCHE(IGAU,IB) = A(1,2)
  276. *
  277.             MELVAL=IVAL(4)
  278.             VELCHE(IGAU,IB)=A(1,3)
  279. *
  280.             MELVAL=IVAL(5)
  281.             VELCHE(IGAU,IB)=A(2,3)
  282. *
  283. *     Fin des deux boucles
  284. *
  285.  1050 CONTINUE
  286. *
  287.       SEGDES MINTE,MINTE1
  288.       SEGSUP MWRK1,MWRK2,MWRK3
  289.       RETURN
  290.       END
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  

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