C JO2LOC SOURCE CHAT 05/01/13 00:49:42 5004 SUBROUTINE JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL) C======================================================================= C C -TEST DE PLANEITE DES FACES DE L'ELEMENT JOI2 C -CALCUL DE LA MATRICE DE PASSAGE BPSS C -CALCUL DES COORDONNEES LOCALES XEL C ROUTINE FORTRAN PUR C CODE S. FELIX SEPTEMBRE 92 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 OUTPUT C XEL = COORDONNEES LOCALES C BPSS = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL C NOQUAL = INDICE DE QUALITE C = 0 SI OK C = 2 SI NOEUD NON COPLANAIRES C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION XE(3,*),XEL(3,*),BPSS(3,3),SHPTOT(6,NBNO,*) DIMENSION XD(2,4) DIMENSION S1(2),SN(2) C NOQUAL = 0 C C---------- CALCUL DE LA MATRICE DE PASSAGE C DO 6 I=1,2 S1(I)=0.0D0 SN(I)=0.0D0 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) ) 7 CONTINUE C C-------------------NORMALISATION DE S1 C XNORME = SQRT((S1(1)**2) + (S1(2)**2)) S1(1) = S1(1) / XNORME S1(2) = S1(2) / XNORME C C-------------------NORMALE AU JOINT (PAR ROTATION DE 90 DEGRES C SN(1) = -S1(2) SN(2) = S1(1) C C-------------------STOCKAGE DE LA MATRICE DE PASSAGE C DO 10 I=1,2 BPSS(1,I) = S1(I) BPSS(2,I) = SN(I) 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,2 * 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 * 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 C NBNOS2=NBNO/2 DO J=1,NBNOS2 DO I=1,2 XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNO+1-J))/2 ENDDO ENDDO C C----------- CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT C (ORIGINE AU NOEUD 1) C DO J=1,NBNOS2 DO I=1,2 XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2) ENDDO ENDDO C C----------- PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE C DEBUT DE XEL C DO J=1,NBNOS2 XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2)) XEL(2,J)=0.0D0 ENDDO C C+PPj C C-------------------VERIFIER S'IL FAUT FAIRE UN TEST DE PLANEITE C RETURN END