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    OF166741  25/02/21    21:18:50     12166          
  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. -INC TMPTVAL
  52.  
  53.       SEGMENT,MMAT1
  54.          REAL*8 VALMAT(NMATR)
  55.          REAL*8 XE(3,NBNN),XE1(3,NBNN)
  56.          REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN),FORME(NBNN)
  57.          REAL*8 CEL1(NBNN,NBNN),CEL2(NBNN,NBNN)
  58.          REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2)
  59.       ENDSEGMENT
  60.  
  61. * MAILLAGE ELEMENTAIRE
  62.       MELEME = IPMAIL
  63. C*    SEGACT,MELEME
  64.       NBNN  = NUM(/1)
  65.       NBELEM = NUM(/2)
  66. *
  67. * INFORMATION SUR L'ELEMENT
  68.       MINTE = IPINTE
  69. C*    SEGACT,MINTE
  70.       NBPGAU = POIGAU(/1)
  71. *
  72.       XMATRI = IPMATR
  73. c*    SEGACT,XMATRI*MOD
  74. *
  75. *  SEGMENTS MELVAL correspondant aux composantes de la conductivite et
  76. *  de l'epaisseur des elements (epaisseur toujours placee a la fin !)
  77.       MPTVAL = IVAMAT
  78. c*    SEGACT,MPTVAL
  79. * Verification de la constance de l'epaisseur :
  80. *     IPMELV = IVAL(NVAMAT)
  81. *     CALL QUELCH(IPMELV,ICONS)
  82. *     IF (ICONS.NE.0) THEN
  83. *       CALL ERREUR(566)
  84. *       RETURN
  85. *     ENDIF
  86. *
  87.       NMATR = NVAMAT
  88.       NDIM = IDIM-1
  89.       SEGINI,MMAT1
  90.       NFIN = NDIM+1
  91. *
  92. *     BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  93. *
  94.       DO 10 iel = 1, NBELEM
  95. *
  96. *        MISE A ZERO DES TABLEAUX CEL1 ET CEL2
  97. *
  98.          CALL ZERO(CEL1,NBNN,NBNN)
  99.          CALL ZERO(CEL2,NBNN,NBNN)
  100. *
  101. *        ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
  102. *        DANS LE REPERE GLOBAL
  103. *
  104.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  105. *
  106. *       CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  107. *       ELEMENT COQUE
  108. *
  109.         DO 60 I=1,3
  110.           COSD1(I) = XE(I,2)-XE(I,1)
  111.           COSD2(I) = XE(I,3)-XE(I,1)
  112.   60    CONTINUE
  113. *
  114.         COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2)
  115.         COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3)
  116.         COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1)
  117. *
  118.         COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+
  119.      &               COSD1(3)*COSD1(3))
  120.         COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+
  121.      &              COSD3(3)*COSD3(3))
  122. *
  123.         DO 70 I=1,3
  124.           COSD1(I)=COSD1(I)/COSD1L
  125.           COSD3(I)=COSD3(I)/COSD3L
  126.    70   CONTINUE
  127. *
  128.         COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2)
  129.         COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3)
  130.         COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1)
  131. *
  132.         DO 80 NOE=1,NBNN
  133.           r_z1 = XZERO
  134.           r_z2 = XZERO
  135.           DO I = 1, 3
  136.             r_z1 = r_z1 + XE(I,NOE)*COSD1(I)
  137.             r_z2 = r_z2 + XE(I,NOE)*COSD2(I)
  138.           ENDDO
  139.           XE1(1,NOE) = r_z1
  140.           XE1(2,NOE) = r_z2
  141.  80     CONTINUE
  142. *
  143. *        BOUCLE SUR LES POINTS DE GAUSS
  144. *
  145.         IFOIS=0
  146.         IFOI2=0
  147.         EPAI = XZERO
  148.  
  149.         DO 20 IGAU=1,NBPGAU
  150. *
  151. *        CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET
  152. *        DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS
  153. *
  154.           DO 90 NP=1,NBNN
  155.             DO 90  I=1,NFIN
  156.               SHP(I,NP)=SHPTOT(I,NP,IGAU)
  157.   90      CONTINUE
  158. *
  159. *        DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
  160. *        ET LE JACOBIEN
  161.           CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
  162.           IF (DJAC.LT.XZERO) IFOIS=IFOIS+1
  163.           IF (ABS(DJAC).LT.XPETIT) IFOI2=IFOI2 +1
  164.  
  165.           DO 100 NP=1,NBNN
  166.             FORME(NP)=SHP(1,NP)
  167.             DO 100 I= 1,NDIM
  168.               GRAD(I,NP)=SHP(I+1,NP)
  169.   100    CONTINUE
  170. *
  171. *        ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
  172. *        POINT DE GAUSS CONSIDERE
  173. *
  174.           DJAC=ABS(DJAC)*POIGAU(IGAU)
  175. *
  176. *        ON CHERCHE LES VALEURS DE COMPOSANTES DE LA CONDUCTIVITE
  177. *        ET L'EPAISSEUR DE LA COQUE
  178.           DO i = 1, NMATR
  179. c*          IF (IVAL(i).NE.0) THEN
  180.               MELVAL = IVAL(i)
  181.               IBMN = MIN(IEL,VELCHE(/2))
  182.               IGMN = MIN(IGAU,VELCHE(/1))
  183.               VALMAT(i) = VELCHE(IGMN,IBMN)
  184. c*          ELSE
  185. c*            VALMAT(i) = XZERO
  186. c*          ENDIF
  187.           ENDDO
  188. *
  189.           EP = VALMAT(NMATR)
  190. *   L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A
  191. *    UNE EPAISSEUR NULLE
  192.           IF (EP.LE.XPETIT) THEN
  193.             INTERR(1) = IEL
  194.             INTERR(2) = IGAU
  195.             MOTERR(1:4) = NOMTP(NEF)
  196.             CALL ERREUR(355)
  197.             GOTO 999
  198.           ENDIF
  199.           EPAI = EPAI + EP
  200. *
  201. *        MATERIAU ISOTROPE
  202. *
  203.           IF (IMATE.EQ.1) THEN
  204. *
  205.             XK3 = VALMAT(1) * DJAC
  206. *
  207. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(GRAD)*GRAD
  208. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  209. *
  210.             CALL NTNST(GRAD,XK3,NBNN,NDIM,CEL1)
  211. *
  212.           ELSE IF (IMATE.EQ.2) THEN
  213. *
  214.             XK1 = VALMAT(1)
  215.             XK2 = VALMAT(2)
  216.             XK3 = VALMAT(3) * DJAC
  217. *
  218.             COSA = VALMAT(5)
  219.             SINA = VALMAT(6)
  220. *
  221. *       CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE
  222. *       PLAN PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT
  223. *
  224.             COS2 = COSA*COSA
  225.             SIN2 = SINA*SINA
  226.             YK(1,1) = COS2*XK1 + SIN2*XK2
  227.             YK(1,2) = SINA*COSA*(XK1-XK2)
  228.             YK(2,1) = YK(1,2)
  229.             YK(2,2) = SIN2*XK1 + COS2*XK2
  230. *
  231. *        ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD
  232. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  233. *
  234.             CALL BDBST(GRAD,DJAC,YK,NBNN,NDIM,CEL1)
  235. *
  236.           ENDIF
  237. *
  238. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(FORME)*FORME POUR LE
  239. *        DE GAUSS CONSIDERE A LA MATRICE CEL2
  240. *
  241.           CALL NTNST(FORME,XK3,NBNN,1,CEL2)
  242. *
  243.   20    CONTINUE
  244. *
  245. *     LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
  246.         IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  247.           INTERR(1) = iel
  248.           CALL ERREUR(195)
  249.           GOTO 999
  250.         ELSE IF (IFOI2.EQ.NBPGAU) THEN
  251. *     CAS OU LE JACOBIEN EST TRES PETIT
  252.           INTERR(1) = iel
  253.           CALL ERREUR (259)
  254.           GOTO 999
  255.         ENDIF
  256. *
  257. *       REMPLISSAGE DE XMATRI
  258. *       EN SUPPOSANT UNE EPAISSEUR MOYENNE CONSTANTE !
  259. *
  260.         EPAI = EPAI / NBPGAU
  261.         CALL MCONDT(CEL1,CEL2,NBNN,EPAI,RE(1,1,iel))
  262. *
  263.  10   CONTINUE
  264. *
  265. *     DESACTIVATION DES SEGMENTS
  266.  999  CONTINUE
  267.       SEGSUP,MMAT1
  268.  
  269.       RETURN
  270.       END
  271.  
  272.  
  273.  

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