C TCOQ3C SOURCE PV090527 26/04/30 21:16:37 12529 ************************************************************************ * * T C O Q 3 C * ----------- * * FONCTION: * --------- * TRAITEMENT DU CAS DES ELEMENTS-FINIS COQUE TRIANGLE * A INTEGRATION-SEMI ANALYTIQUE (INTEGRATION ANALYTIQUE DANS L' * EPAISSEUR )POUR UN MAILLAGE ELEMENTAIRE * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP) * IPMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS * L'OBJET MODELE * IPCHEM (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE * IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE * * AUTEUR, DATE DE CREATION: * ------------------------- * * P. DOWLATYARI JUILLET 1990 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 ************************************************************************ SUBROUTINE TCOQ3C (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NVAMAT, & IPMATR,NLIGR) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC CCHAMP -INC SMCHAML -INC SMCOORD -INC SMELEME -INC SMINTE -INC SMRIGID -INC TMPTVAL SEGMENT,MMAT1 REAL*8 VALMAT(NMATR) REAL*8 XE(3,NBNN),XE1(3,NBNN) REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN),FORME(NBNN) REAL*8 CEL1(NBNN,NBNN),CEL2(NBNN,NBNN) REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2) ENDSEGMENT * MAILLAGE ELEMENTAIRE MELEME = IPMAIL C* SEGACT,MELEME NBNN = NUM(/1) NBELEM = NUM(/2) * * INFORMATION SUR L'ELEMENT MINTE = IPINTE C* SEGACT,MINTE NBPGAU = POIGAU(/1) * XMATRI = IPMATR c* SEGACT,XMATRI*MOD * * SEGMENTS MELVAL correspondant aux composantes de la conductivite et * de l'epaisseur des elements (epaisseur toujours placee a la fin !) MPTVAL = IVAMAT c* SEGACT,MPTVAL * Verification de la constance de l'epaisseur : * IPMELV = IVAL(NVAMAT) * CALL QUELCH(IPMELV,ICONS) * IF (ICONS.NE.0) THEN * CALL ERREUR(566) * RETURN * ENDIF * NMATR = NVAMAT NDIM = IDIM-1 SEGINI,MMAT1 NFIN = NDIM+1 * * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL * DO 10 iel = 1, NBELEM * * MISE A ZERO DES TABLEAUX CEL1 ET CEL2 * CALL ZERO(CEL1,NBNN,NBNN) CALL ZERO(CEL2,NBNN,NBNN) * * ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL, * DANS LE REPERE GLOBAL * CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) * * CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L' * ELEMENT COQUE * DO 60 I=1,3 COSD1(I) = XE(I,2)-XE(I,1) COSD2(I) = XE(I,3)-XE(I,1) 60 CONTINUE * COSD3(1)=COSD1(2)*COSD2(3)-COSD1(3)*COSD2(2) COSD3(2)=COSD1(3)*COSD2(1)-COSD1(1)*COSD2(3) COSD3(3)=COSD1(1)*COSD2(2)-COSD1(2)*COSD2(1) * COSD1L=SQRT(COSD1(1)*COSD1(1)+COSD1(2)*COSD1(2)+ & COSD1(3)*COSD1(3)) COSD3L=SQRT(COSD3(1)*COSD3(1)+COSD3(2)*COSD3(2)+ & COSD3(3)*COSD3(3)) * DO 70 I=1,3 COSD1(I)=COSD1(I)/COSD1L COSD3(I)=COSD3(I)/COSD3L 70 CONTINUE * COSD2(1)=COSD3(2)*COSD1(3)-COSD3(3)*COSD1(2) COSD2(2)=COSD3(3)*COSD1(1)-COSD3(1)*COSD1(3) COSD2(3)=COSD3(1)*COSD1(2)-COSD3(2)*COSD1(1) * DO 80 NOE=1,NBNN r_z1 = XZERO r_z2 = XZERO DO I = 1, 3 r_z1 = r_z1 + XE(I,NOE)*COSD1(I) r_z2 = r_z2 + XE(I,NOE)*COSD2(I) ENDDO XE1(1,NOE) = r_z1 XE1(2,NOE) = r_z2 80 CONTINUE * * BOUCLE SUR LES POINTS DE GAUSS * IFOIS=0 IFOI2=0 EPAI = XZERO DO 20 IGAU=1,NBPGAU * * CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET * DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS * DO NP=1,NBNN DO I=1,NFIN SHP(I,NP)=SHPTOT(I,NP,IGAU) enddo enddo * * DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE * ET LE JACOBIEN CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC) IF (DJAC.LT.XZERO) IFOIS=IFOIS+1 IF (ABS(DJAC).LT.XPETIT) IFOI2=IFOI2 +1 DO NP=1,NBNN FORME(NP)=SHP(1,NP) DO I= 1,NDIM GRAD(I,NP)=SHP(I+1,NP) enddo enddo * * ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE * POINT DE GAUSS CONSIDERE * DJAC=ABS(DJAC)*POIGAU(IGAU) * * ON CHERCHE LES VALEURS DE COMPOSANTES DE LA CONDUCTIVITE * ET L'EPAISSEUR DE LA COQUE DO i = 1, NMATR c* IF (IVAL(i).NE.0) THEN MELVAL = IVAL(i) IBMN = MIN(IEL,VELCHE(/2)) IGMN = MIN(IGAU,VELCHE(/1)) VALMAT(i) = VELCHE(IGMN,IBMN) c* ELSE c* VALMAT(i) = XZERO c* ENDIF ENDDO * EP = VALMAT(NMATR) * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A * UNE EPAISSEUR NULLE IF (EP.LE.XPETIT) THEN INTERR(1) = IEL INTERR(2) = IGAU MOTERR(1:4) = NOMTP(NEF) CALL ERREUR(355) GOTO 999 ENDIF EPAI = EPAI + EP * * MATERIAU ISOTROPE * IF (IMATE.EQ.1) THEN * XK3 = VALMAT(1) * DJAC * * ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(GRAD)*GRAD * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1 * CALL NTNST(GRAD,XK3,NBNN,NDIM,CEL1) * ELSE IF (IMATE.EQ.2) THEN * XK1 = VALMAT(1) XK2 = VALMAT(2) XK3 = VALMAT(3) * DJAC * COSA = VALMAT(5) SINA = VALMAT(6) * * CALUL DE LA MATRICE DES COEFFICIENTS DE CONDUCTIVITES DANS LE * PLAN PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT * COS2 = COSA*COSA SIN2 = SINA*SINA YK(1,1) = COS2*XK1 + SIN2*XK2 YK(1,2) = SINA*COSA*(XK1-XK2) YK(2,1) = YK(1,2) YK(2,2) = SIN2*XK1 + COS2*XK2 * * ON AJOUTE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*YK*GRAD * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1 * CALL BDBST(GRAD,DJAC,YK,NBNN,NDIM,CEL1) * ENDIF * * ON AJOUTE LE PRODUIT K3*DJAC*TRANSPOSEE(FORME)*FORME POUR LE * DE GAUSS CONSIDERE A LA MATRICE CEL2 * CALL NTNST(FORME,XK3,NBNN,1,CEL2) * 20 CONTINUE * * LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT IF (IFOIS.NE.0.AND.IFOIS.NE.NBPGAU) THEN INTERR(1) = iel CALL ERREUR(195) GOTO 999 ELSE IF (IFOI2.EQ.NBPGAU) THEN * CAS OU LE JACOBIEN EST TRES PETIT INTERR(1) = iel CALL ERREUR (259) GOTO 999 ENDIF * * REMPLISSAGE DE XMATRI * EN SUPPOSANT UNE EPAISSEUR MOYENNE CONSTANTE ! * EPAI = EPAI / NBPGAU CALL MCONDT(CEL1,CEL2,NBNN,EPAI,RE(1,1,iel)) * 10 CONTINUE * * DESACTIVATION DES SEGMENTS 999 CONTINUE SEGSUP,MMAT1 RETURN END