C ROT3R SOURCE CB215821 19/08/20 21:21:51 10287 SUBROUTINE ROT3R(NEF,IMAIL,IPMODE,IPCHEM,IPRIGI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ************************************************************************ * * R O T 3 R * --------- * * FONCTION: * --------- * CALCUL DE LA MATRICE DE RESISTANCE POUR L'ELEMENT ROT3 * * MODULES UTILISES: * ----------------- * -INC PPARAM -INC CCOPTIO -INC CCREEL *- -INC SMCOORD -INC SMINTE -INC CCHAMP -INC SMMODEL -INC SMRIGID -INC SMELEME -INC SMCHAML * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * NEF (E) NUMERO DE L'ELEMENT-FINI DANS NOMTP (VOIR CCHAMP) * IMAIL (E) NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE,DANS * L'OBJET MODELE * IPMODE (E) POINTEUR SUR UN SEGMENT IMODEL * IPCHEM (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUE * +XCOOR (E) VOIR SMCOORD * +IDIM (E) VOIR CCOPTIO * +IFOMOD (E) VOIR CCOPTIO * +XZERO (E) VOIR CCREEL * IPRIGI (E/S) POINTEUR SUR L'OBJET RESULTAT,DE TYPE RIGIDITE * * VARIABLES: * ---------- * * NBNN NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE * NEF NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP) * NBELEM NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE * NBPGAU NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI * NDIM NOMBRE DE LIGNES DE LA MATRICE GRADIENT * CEL(2*NBNN,2*NBNN) MATRICE DE CONDUCTIVITE ELEMENTAIRE * XE(3,NBNN) COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL * SHP(6,NBNN) TABLEAU DE TRAVAIL * GRAD(NDIM,NBNN) MATRICE GRADIENT DES FONCTIONS DE FORME BIDIM. * VALMAT(NMATR) TABLEAU DE TRAVAIL * SEGMENT,MMAT1 REAL*8 VALMAT(NMATR) REAL*8 XE(3,NBNN),CEL1(NBNN,NBNN),XE1(3,NBNN) REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN) ENDSEGMENT * SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT * SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT * SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT * REAL*8 COSD1(3),COSD2(3),COSD3(3),YK(2,2) CHARACTER*8 CNM CHARACTER*(NCONCH) CONM PARAMETER (NINF=3) INTEGER INFOS(NINF) * * * * AUTEUR, DATE DE CREATION: * ------------------------- * * YANN STEPHAN , JANVIER 1997 (COPIE DE TCOQ3C) * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * ************************************************************************ * * RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE * ELEMENTAIRE * IMODEL=IPMODE CONM =CONMOD IPMAIL=IMAMOD MELEME=IMAMOD SEGACT,MELEME NBNN=NUM(/1) NBELEM=NUM(/2) MRIGID=IPRIGI SEGACT,MRIGID * * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT * FINI LIE A NOTRE MAILLAGE * if(infmod(/1).lt.4) then CALL ELQUOI(NEF,0,2,IPINF,IMODEL) IF(IERR.NE.0) RETURN INFO=IPINF IPINTE=INFELL(11) else ipinte=infmod(4) endif * * INFORMATION SUR L'ELEMENT * MINTE=IPINTE SEGACT,MINTE NBPGAU=POIGAU(/1) * xMATRI=IRIGEL(4,IMAIL) SEGACT,xMATRI*MOD NLIGRP=NBNN NLIGRD=NBNN * * RECHERCHE LES POINTEURS DES SEGMENTS MELVAL QUI CORRESPONDENT * AUX COMPOSANTES DE LA CONDUCTIVITE ET L'EPAISSEUR DES ELEMENT * NFOR=FORMOD(/2) NMAT=MATMOD(/2) CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CNM,INM,INT) IF (IERR.NE.0) RETURN * * REMLIR LE TABLEAU INFOS (INFORMATIONS SUR ELEMENT) INFOS(1)=0 INFOS(2)=0 INFOS(3)=NIFOUR * NBROBL=0 NBRFAC=0 IF(CNM.EQ.'ISOTROPE')THEN NBROBL=2 SEGINI NOMID MOMATR=NOMID LESOBL(1)='ETA ' LESOBL(2)='EPAI' NMATR=2 NMATF=0 ELSE IF(CNM.EQ.'ORTHOTRO') THEN NBROBL=5 SEGINI NOMID MOMATR=NOMID LESOBL(1)='ETA1' LESOBL(2)='ETA2' LESOBL(3)='EPAI' LESOBL(4)='V1X ' LESOBL(5)='V1Y ' NMATR=5 NMATF=0 ELSE CALL ERREUR(251) RETURN ENDIF * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * CALL KOMCHA(IPCHEM,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) SEGSUP NOTYPE IF(IERR.NE.0)RETURN * MPTVAL=IVAMAT IF(CNM.EQ.'ISOTROPE')THEN IPMELV=IVAL(2) ELSE IF(CNM.EQ.'ORTHOTRO') THEN IPMELV=IVAL(3) ENDIF CALL QUELCH(IPMELV,ICONS) IF(ICONS.NE.0)THEN CALL ERREUR(566) RETURN ENDIF * * NDIM=IDIM-1 SEGINI,MMAT1 * * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL * DO 10 IEL=1,NBELEM * * MISE A ZERO DES TABLEAUX CEL1 ET XE1 * CALL ZERO(CEL1,NBNN,NBNN) CALL ZERO (XE1,3,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 DO 80 I=1,3 XE1(1,NOE)=XE1(1,NOE)+XE(I,NOE)*COSD1(I) XE1(2,NOE)=XE1(2,NOE)+XE(I,NOE)*COSD2(I) 80 CONTINUE * * * BOUCLE SUR LES POINTS DE GAUSS * IFOIS=0 IFOI2=0 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 * NFIN=NDIM+1 DO 90 NP=1,NBNN DO 90 I=1,NFIN SHP(I,NP)=SHPTOT(I,NP,IGAU) 90 CONTINUE * * DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE * ET LE JACOBIEN CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC) * DO 100 NP=1,NBNN DO 100 I= 1,NDIM GRAD(I,NP)=SHP(I+1,NP) 100 CONTINUE IF(DJAC.LT.XZERO)IFOIS=IFOIS+1 IF(ABS(DJAC).LT.XPETIT)IFOI2=IFOI2 +1 * * 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 RESISTIVITE * ET L'EPAISSEUR DE LA COQUE * MPTVAL=IVAMAT DO 30 IM=1,NMATR IF(IVAL(IM).NE.0)THEN MELVAL=IVAL(IM) IBMN=MIN(IEL,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) VALMAT(IM)=VELCHE(IGMN,IBMN) ELSE VALMAT(IM)=0 ENDIF 30 CONTINUE * * MATERIAU ISOTROPE * IF(CNM.NE.'ORTHOTRO')THEN * EP=VALMAT(2) IF(EP.LE.XPETIT)THEN * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A * UNE EPAISSEUR NULLE INTERR(1)=IEL INTERR(2)=IGAU MOTERR(1:4)=NOMTP(NEF) CALL ERREUR(355) SEGSUP,MRIGID,xMATRI GO TO 999 ENDIF XK=VALMAT(1)*DJAC/EP * * ON AJOUTE LE PRODUIT K*DJAC*TRANSPOSEE(GRAD)*GRAD * POUR LE POINT DE GAUSS CONSIDERE,A LA MATRICE CEL1 * CALL NTNST (GRAD,XK,NBNN,NDIM,CEL1) * * ELSE * * CAS ORTHOTROPE * EP=VALMAT(3) IF(EP.LE.XPETIT)THEN * L'ELEMENT (IEL) AU POINT DE GAUSS (IGAU)DE TYPE (NOMTP(NEF)) A * UNE EPAISSEUR NULLE INTERR(1)=IEL INTERR(2)=IGAU MOTERR(1:4)=NOMTP(NEF) CALL ERREUR(355) SEGSUP,MRIGID,xMATRI GO TO 999 ENDIF XK1=VALMAT(1)/EP XK2=VALMAT(2)/EP * COSA=VALMAT(4) SINA=-VALMAT(5) * CALCUL DE LA MATRICE DES COEFFICIENTS DE RESISTIVITE DANS LE * PLAN,PAR RAPPORT AU REPERE LOCAL DE L'ELEMENT * COS2=COSA*COSA SIN2=SINA*SINA SINCOS=SINA*COSA YK(1,1)=COS2*XK1+SIN2*XK2 YK(1,2)=SINCOS*(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 * 20 CONTINUE * * IF(IFOIS.NE.0.AND.IFOIS.NE.NBPGAU)THEN * * LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT INTERR(1)=IEL CALL ERREUR(195) SEGSUP,xMATRI,MRIGID GO TO 999 ELSEIF(IFOI2.EQ.NBPGAU)THEN * * CAS OU LE JACOBIEN EST TRES PETIT * INTERR(1)=IEL CALL ERREUR (259) SEGSUP,xMATRI,MRIGID GO TO 999 ENDIF * * SEGINI,XMATRI * IMATTT(IEL)=XMATRI * * REMPLISSAGE DE XMATRI * CALL REMPMT(CEL1,NBNN,RE(1,1,iel)) * SEGDES,XMATRI 10 CONTINUE * END DO * * DESACTIVATION DES SEGMENTS * SEGDES,xMATRI,MRIGID 999 CONTINUE SEGSUP,MMAT1 99 CONTINUE * SEGDES,INFO * MPTVAL=IVAMAT SEGSUP MPTVAL NOMID=MOMATR SEGSUP NOMID END