Télécharger la plaquette Cast3M


fr en

Télécharger rtens4.eso

Retour à la liste

Numérotation des lignes : 

rtens4

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

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