C CO2LOC SOURCE LJ1 14/11/13 21:15:12 8249 SUBROUTINE CO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL,IDIM) C======================================================================= C C -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT COA2 C -TEST DE PLANEITE DES FACES DE L'ELEMENT C -CALCUL DE LA MATRICE DE PASSAGE BPSS C -CALCUL DES COORDONNEES LOCALES XEL C ROUTINE FORTRAN PUR C DERIVEE DE LA ROUTINE JO4LOC PAR S. FELIX C======================================================================= C INPUT C XE = COORDONNEES DE L ELEMENT C SHPTOT = FONCTIONS DE FORME C = SHPTOT(1,...) = FONCTIONS DE FORME C = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI C = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA C NBNO = NOMBRE DE NOEUDS DE L ELEMENT C IVRF = DEMANDE DE VERIFICATION DE L ELEMENT C OUTPUT C XEL = COORDONNEES LOCALES C BPSS = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL C NOQUAL = INDICE DE QUALITE C = 0 SI OK C = 1 SI NOEUD TROP VOISINS C = 2 SI NOEUD NON COPLANAIRES C C REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES, DEFO. PLANES C AXISYMETRIQUE, LA MATRICE TETA SERA UNE MATRICE DE C DIMENSION (2X2), ET SERA CONSTITUEE PAR LES VECTEURS C S1 ET SN. LES CAS CONT.PLANES,DEF.PLANES ET AXISYMETRIQUE C SERONT DONC SIMILAIRES AU CAS D UN JOINT BIDIMENSIONNEL C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) INTEGER IND4(0:4) DIMENSION XE(3,6),XEL(3,6),BPSS(3,3),SHPTOT(6,NBNO,*) DIMENSION U1(3),V1(3),XD(3,6),V2(3) DIMENSION S1(3),S2(3),SN(3) DIMENSION XX(3,6) DATA IND4/3,1,2,3,1/ C NOQUAL = 0 C C---------- CALCUL DE LA MATRICE DE PASSAGE C DO 6 I=1,IDIM S1(I)=0.0D0 SN(I)=0.0D0 IF (IDIM.EQ.3) THEN S2(I)=0.0D0 V2(I)=0.0D0 END IF 6 CONTINUE C DO 7 I=1,NBNO C C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI C S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) ) S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) ) IF (IDIM.EQ.3) S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) ) C C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA C ccccccccc IF (IDIM.EQ.2) THEN XNORME = SQRT((S1(1)**2) + (S1(2)**2)) S1(1) = S1(1) / XNORME S1(2) = S1(2) / XNORME SN(1) = -S1(2) SN(2) = S1(1) ELSE IF (IDIM.EQ.3) THEN IF (S1(1).EQ.0.0D0.AND.S1(2).EQ.0.0D0) THEN V2(1) = 1.0D0 V2(2) = 0.0D0 V2(3) = 0.0D0 ELSE IF (S1(2).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN V2(1) = 0.0D0 V2(2) = 1.D0 V2(3) = 0.D0 ELSE IF (S1(1).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN V2(1) = 1.0D0 V2(2) = 0.D0 V2(3) = 0.0D0 ELSE IF (S1(2).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN V2(1) = 0.0D0 V2(2) = -S1(3) V2(3) = S1(2) ELSE IF (S1(1).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN V2(1) = -S1(3) V2(2) = 0.0D0 V2(3) = S1(1) ELSE IF (S1(1).NE.0.0D0.AND.S1(2).NE.0.0D0) THEN V2(1) = -S1(2) V2(2) = S1(1) V2(3) = 0.0D0 END IF END IF ccccccccc 7 CONTINUE C IF (IDIM.EQ.3) THEN CALL NORMER(S1) CALL NORMER(V2) C-------------------NORMALE AU PLAN DU JOINT C SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2)) SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3)) SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1)) CALL NORMER(SN) C C-------------------ORTHOGONALISATION DE S2 C S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2)) S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3)) S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1)) CALL NORMER(S2) END IF C C-------------------STOCKAGE DE LA MATRICE DE PASSAGE C DO 10 I=1,IDIM BPSS(1,I) = S1(I) IF (IDIM.EQ.2) THEN BPSS(2,I) = SN(I) ELSE IF (IDIM.EQ.3) THEN BPSS(2,I) = S2(I) BPSS(3,I) = SN(I) END IF 10 CONTINUE C C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT C C C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1) C DO 8 J=1,NBNO DO 8 I=1,IDIM XD(I,J) = XE(I,J) - XE(I,1) 8 CONTINUE C C-------------------PROJECTION SUR LE PLAN DU JOINT C DO 9 J=1,NBNO XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2)) XEL(2,J)=0.0d0 IF (IDIM.EQ.3) THEN XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3)) XEL(3,J)=0.0D0 END IF 9 CONTINUE C+PPj C C---------- CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT C QUE L ON STOCKE DANS LA FIN DE XEL NBNOS2=NBNO/2 DO J=1,NBNOS2 DO I=1,IDIM XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2 ENDDO ENDDO C C----------- CHANGEMENT D ORIGINE DU PLAN MOYEN DU JOINT C (ORIGINE AU NOEUD 1) DO J=1,NBNOS2 DO I=1,IDIM XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2) ENDDO ENDDO RETURN END