Télécharger la plaquette Cast3M


fr en

Télécharger tcoq3c.eso

Retour à la liste

Numérotation des lignes : 

tcoq3c

  1. C TCOQ3C    SOURCE    BP208322  15/06/22    21:23:17     8543
  2.  
  3. ************************************************************************
  4. *
  5. *                             T C O Q 3 C
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *     TRAITEMENT DU CAS DES ELEMENTS-FINIS  COQUE TRIANGLE
  11. *     A INTEGRATION-SEMI ANALYTIQUE (INTEGRATION ANALYTIQUE DANS L'
  12. *     EPAISSEUR )POUR UN MAILLAGE ELEMENTAIRE
  13. *
  14. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  15. * -----------
  16. *
  17. *     NEF     (E)  NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP)
  18. *     IPMAIL  (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS
  19. *                  L'OBJET MODELE
  20. *     IPCHEM  (E)  POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE
  21. *     IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE
  22. *
  23. * AUTEUR, DATE DE CREATION:
  24. * -------------------------
  25. *
  26. *     P. DOWLATYARI  JUILLET 1990
  27. *
  28. * LANGAGE:
  29. * --------
  30. *
  31. *     ESOPE + FORTRAN77
  32. ************************************************************************
  33.  
  34.       SUBROUTINE TCOQ3C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT,
  35.      &                   IPMATR,NLIGR)
  36.  
  37.       IMPLICIT INTEGER(I-N)
  38.       IMPLICIT REAL*8(A-H,O-Z)
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC CCREEL
  43. -INC CCHAMP
  44.  
  45. -INC SMCHAML
  46. -INC SMCOORD
  47. -INC SMELEME
  48. -INC SMINTE
  49. -INC SMRIGID
  50. *
  51.       SEGMENT,MMAT1
  52.          REAL*8 VALMAT(NMATR)
  53.          REAL*8 XE(3,NBNN),XE1(3,NBNN)
  54.          REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN),FORME(NBNN)
  55.          REAL*8 CEL1(NBNN,NBNN),CEL2(NBNN,NBNN)
  56.          REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2)
  57.       ENDSEGMENT
  58. *
  59.       SEGMENT MPTVAL
  60.         INTEGER IPOS(NS)    ,NSOF(NS)
  61.         INTEGER      IVAL(NCOSOU)
  62.         CHARACTER*16 TYVAL(NCOSOU)
  63.       ENDSEGMENT
  64.  
  65. * MAILLAGE ELEMENTAIRE
  66.       MELEME = IPMAIL
  67. C*    SEGACT,MELEME
  68.       NBNN  = NUM(/1)
  69.       NBELEM = NUM(/2)
  70. *
  71. * INFORMATION SUR L'ELEMENT
  72.       MINTE = IPINTE
  73. C*    SEGACT,MINTE
  74.       NBPGAU = POIGAU(/1)
  75. *
  76.       XMATRI = IPMATR
  77. c*    SEGACT,XMATRI*MOD
  78. *
  79. *  SEGMENTS MELVAL correspondant aux composantes de la conductivite et
  80. *  de l'epaisseur des elements (epaisseur toujours placee a la fin !)
  81.       MPTVAL = IVAMAT
  82. c*    SEGACT,MPTVAL
  83. * Verification de la constance de l'epaisseur :
  84. *     IPMELV = IVAL(NVAMAT)
  85. *     CALL QUELCH(IPMELV,ICONS)
  86. *     IF (ICONS.NE.0) THEN
  87. *       CALL ERREUR(566)
  88. *       RETURN
  89. *     ENDIF
  90. *
  91.       NMATR = NVAMAT
  92.       NDIM = IDIM-1
  93.       SEGINI,MMAT1
  94.       NFIN = NDIM+1
  95. *
  96. *     BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  97. *
  98.       DO 10 iel = 1, NBELEM
  99. *
  100. *        MISE A ZERO DES TABLEAUX CEL1 ET CEL2
  101. *
  102.          CALL ZERO(CEL1,NBNN,NBNN)
  103.          CALL ZERO(CEL2,NBNN,NBNN)
  104. *
  105. *        ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
  106. *        DANS LE REPERE GLOBAL
  107. *
  108.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  109. *
  110. *       CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  111. *       ELEMENT COQUE
  112. *
  113.         DO 60 I=1,3
  114.           COSD1(I) = XE(I,2)-XE(I,1)
  115.           COSD2(I) = XE(I,3)-XE(I,1)
  116.   60    CONTINUE
  117. *
  118.         COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2)
  119.         COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3)
  120.         COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1)
  121. *
  122.         COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+
  123.      &               COSD1(3)*COSD1(3))
  124.         COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+
  125.      &              COSD3(3)*COSD3(3))
  126. *
  127.         DO 70 I=1,3
  128.           COSD1(I)=COSD1(I)/COSD1L
  129.           COSD3(I)=COSD3(I)/COSD3L
  130.    70   CONTINUE
  131. *
  132.         COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2)
  133.         COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3)
  134.         COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1)
  135. *
  136.         DO 80 NOE=1,NBNN
  137.           r_z1 = XZERO
  138.           r_z2 = XZERO
  139.           DO I = 1, 3
  140.             r_z1 = r_z1 + XE(I,NOE)*COSD1(I)
  141.             r_z2 = r_z2 + XE(I,NOE)*COSD2(I)
  142.           ENDDO
  143.           XE1(1,NOE) = r_z1
  144.           XE1(2,NOE) = r_z2
  145.  80     CONTINUE
  146. *
  147. *        BOUCLE SUR LES POINTS DE GAUSS
  148. *
  149.         IFOIS=0
  150.         IFOI2=0
  151.         EPAI = XZERO
  152.  
  153.         DO 20 IGAU=1,NBPGAU
  154. *
  155. *        CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET
  156. *        DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS
  157. *
  158.           DO 90 NP=1,NBNN
  159.             DO 90  I=1,NFIN
  160.               SHP(I,NP)=SHPTOT(I,NP,IGAU)
  161.   90      CONTINUE
  162. *
  163. *        DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
  164. *        ET LE JACOBIEN
  165.           CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
  166.           IF (DJAC.LT.XZERO) IFOIS=IFOIS+1
  167.           IF (ABS(DJAC).LT.XPETIT) IFOI2=IFOI2 +1
  168.  
  169.           DO 100 NP=1,NBNN
  170.             FORME(NP)=SHP(1,NP)
  171.             DO 100 I= 1,NDIM
  172.               GRAD(I,NP)=SHP(I+1,NP)
  173.   100    CONTINUE
  174. *
  175. *        ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
  176. *        POINT DE GAUSS CONSIDERE
  177. *
  178.           DJAC=ABS(DJAC)*POIGAU(IGAU)
  179. *
  180. *        ON CHERCHE LES VALEURS DE COMPOSANTES DE LA CONDUCTIVITE
  181. *        ET L'EPAISSEUR DE LA COQUE
  182.           DO i = 1, NMATR
  183. c*          IF (IVAL(i).NE.0) THEN
  184.               MELVAL = IVAL(i)
  185.               IBMN = MIN(IEL,VELCHE(/2))
  186.               IGMN = MIN(IGAU,VELCHE(/1))
  187.               VALMAT(i) = VELCHE(IGMN,IBMN)
  188. c*          ELSE
  189. c*            VALMAT(i) = XZERO
  190. c*          ENDIF
  191.           ENDDO
  192. *
  193.           EP = VALMAT(NMATR)
  194. *   L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A
  195. *    UNE EPAISSEUR NULLE
  196.           IF (EP.LE.XPETIT) THEN
  197.             INTERR(1) = IEL
  198.             INTERR(2) = IGAU
  199.             MOTERR(1:4) = NOMTP(NEF)
  200.             CALL ERREUR(355)
  201.             GOTO 999
  202.           ENDIF
  203.           EPAI = EPAI + EP
  204. *
  205. *        MATERIAU ISOTROPE
  206. *
  207.           IF (IMATE.EQ.1) THEN
  208. *
  209.             XK3 = VALMAT(1) * DJAC
  210. *
  211. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(GRAD)*GRAD
  212. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  213. *
  214.             CALL NTNST(GRAD,XK3,NBNN,NDIM,CEL1)
  215. *
  216.           ELSE IF (IMATE.EQ.2) THEN
  217. *
  218.             XK1 = VALMAT(1)
  219.             XK2 = VALMAT(2)
  220.             XK3 = VALMAT(3) * DJAC
  221. *
  222.             COSA = VALMAT(5)
  223.             SINA = VALMAT(6)
  224. *
  225. *       CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE
  226. *       PLAN PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT
  227. *
  228.             COS2 = COSA*COSA
  229.             SIN2 = SINA*SINA
  230.             YK(1,1) = COS2*XK1 + SIN2*XK2
  231.             YK(1,2) = SINA*COSA*(XK1-XK2)
  232.             YK(2,1) = YK(1,2)
  233.             YK(2,2) = SIN2*XK1 + COS2*XK2
  234. *
  235. *        ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD
  236. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  237. *
  238.             CALL BDBST(GRAD,DJAC,YK,NBNN,NDIM,CEL1)
  239. *
  240.           ENDIF
  241. *
  242. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(FORME)*FORME POUR LE
  243. *        DE GAUSS CONSIDERE A LA MATRICE CEL2
  244. *
  245.           CALL NTNST(FORME,XK3,NBNN,1,CEL2)
  246. *
  247.   20    CONTINUE
  248. *
  249. *     LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
  250.         IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  251.           INTERR(1) = iel
  252.           CALL ERREUR(195)
  253.           GOTO 999
  254.         ELSE IF (IFOI2.EQ.NBPGAU) THEN
  255. *     CAS OU LE JACOBIEN EST TRES PETIT
  256.           INTERR(1) = iel
  257.           CALL ERREUR (259)
  258.           GOTO 999
  259.         ENDIF
  260. *
  261. *       REMPLISSAGE DE XMATRI
  262. *       EN SUPPOSANT UNE EPAISSEUR MOYENNE CONSTANTE !
  263. *
  264.         EPAI = EPAI / NBPGAU
  265.         CALL MCONDT(CEL1,CEL2,NBNN,EPAI,RE(1,1,iel))
  266. *
  267.  10   CONTINUE
  268. *
  269. *     DESACTIVATION DES SEGMENTS
  270.  999  CONTINUE
  271.       SEGSUP,MMAT1
  272.  
  273.       RETURN
  274.       END
  275.  
  276.  
  277.  
  278.  

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