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    PV090527  26/04/30    21:16:37     12529          
  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    NP=1,NBNN
  155.             DO     I=1,NFIN
  156.               SHP(I,NP)=SHPTOT(I,NP,IGAU)
  157.             enddo 
  158.           enddo     
  159. *
  160. *        DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
  161. *        ET LE JACOBIEN
  162.           CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
  163.           IF (DJAC.LT.XZERO) IFOIS=IFOIS+1
  164.           IF (ABS(DJAC).LT.XPETIT) IFOI2=IFOI2 +1
  165.  
  166.           DO     NP=1,NBNN
  167.             FORME(NP)=SHP(1,NP)
  168.             DO     I= 1,NDIM
  169.               GRAD(I,NP)=SHP(I+1,NP)
  170.             enddo
  171.           enddo    
  172. *
  173. *        ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
  174. *        POINT DE GAUSS CONSIDERE
  175. *
  176.           DJAC=ABS(DJAC)*POIGAU(IGAU)
  177. *
  178. *        ON CHERCHE LES VALEURS DE COMPOSANTES DE LA CONDUCTIVITE
  179. *        ET L'EPAISSEUR DE LA COQUE
  180.           DO i = 1, NMATR
  181. c*          IF (IVAL(i).NE.0) THEN
  182.               MELVAL = IVAL(i)
  183.               IBMN = MIN(IEL,VELCHE(/2))
  184.               IGMN = MIN(IGAU,VELCHE(/1))
  185.               VALMAT(i) = VELCHE(IGMN,IBMN)
  186. c*          ELSE
  187. c*            VALMAT(i) = XZERO
  188. c*          ENDIF
  189.           ENDDO
  190. *
  191.           EP = VALMAT(NMATR)
  192. *   L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A
  193. *    UNE EPAISSEUR NULLE
  194.           IF (EP.LE.XPETIT) THEN
  195.             INTERR(1) = IEL
  196.             INTERR(2) = IGAU
  197.             MOTERR(1:4) = NOMTP(NEF)
  198.             CALL ERREUR(355)
  199.             GOTO 999
  200.           ENDIF
  201.           EPAI = EPAI + EP
  202. *
  203. *        MATERIAU ISOTROPE
  204. *
  205.           IF (IMATE.EQ.1) THEN
  206. *
  207.             XK3 = VALMAT(1) * DJAC
  208. *
  209. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(GRAD)*GRAD
  210. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  211. *
  212.             CALL NTNST(GRAD,XK3,NBNN,NDIM,CEL1)
  213. *
  214.           ELSE IF (IMATE.EQ.2) THEN
  215. *
  216.             XK1 = VALMAT(1)
  217.             XK2 = VALMAT(2)
  218.             XK3 = VALMAT(3) * DJAC
  219. *
  220.             COSA = VALMAT(5)
  221.             SINA = VALMAT(6)
  222. *
  223. *       CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE
  224. *       PLAN PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT
  225. *
  226.             COS2 = COSA*COSA
  227.             SIN2 = SINA*SINA
  228.             YK(1,1) = COS2*XK1 + SIN2*XK2
  229.             YK(1,2) = SINA*COSA*(XK1-XK2)
  230.             YK(2,1) = YK(1,2)
  231.             YK(2,2) = SIN2*XK1 + COS2*XK2
  232. *
  233. *        ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD
  234. *        POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1
  235. *
  236.             CALL BDBST(GRAD,DJAC,YK,NBNN,NDIM,CEL1)
  237. *
  238.           ENDIF
  239. *
  240. *        ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(FORME)*FORME POUR LE
  241. *        DE GAUSS CONSIDERE A LA MATRICE CEL2
  242. *
  243.           CALL NTNST(FORME,XK3,NBNN,1,CEL2)
  244. *
  245.   20    CONTINUE
  246. *
  247. *     LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
  248.         IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN
  249.           INTERR(1) = iel
  250.           CALL ERREUR(195)
  251.           GOTO 999
  252.         ELSE IF (IFOI2.EQ.NBPGAU) THEN
  253. *     CAS OU LE JACOBIEN EST TRES PETIT
  254.           INTERR(1) = iel
  255.           CALL ERREUR (259)
  256.           GOTO 999
  257.         ENDIF
  258. *
  259. *       REMPLISSAGE DE XMATRI
  260. *       EN SUPPOSANT UNE EPAISSEUR MOYENNE CONSTANTE !
  261. *
  262.         EPAI = EPAI / NBPGAU
  263.         CALL MCONDT(CEL1,CEL2,NBNN,EPAI,RE(1,1,iel))
  264. *
  265.  10   CONTINUE
  266. *
  267. *     DESACTIVATION DES SEGMENTS
  268.  999  CONTINUE
  269.       SEGSUP,MMAT1
  270.  
  271.       RETURN
  272.       END
  273.  
  274.  
  275.  
  276.  
  277.  

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