Télécharger la plaquette Cast3M


fr en

Télécharger rtens2.eso

Retour à la liste

Numérotation des lignes : 

rtens2

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

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