1 : C JO4LOC SOURCE CHAT 05/01/13 00:49:47 5004 2 : SUBROUTINE JO4LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL) 3 : C======================================================================= 4 : C 5 : C -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT JOI4 6 : C -TEST DE PLANEITE DES FACES DE L'ELEMENT 7 : C -CALCUL DE LA MATRICE DE PASSAGE BPSS 8 : C -CALCUL DES COORDONNEES LOCALES XEL 9 : C ROUTINE FORTRAN PUR 10 : C CODE S. FELIX MAI 92 11 : C======================================================================= 12 : C INPUT 13 : C XE = COORDONNEES DE L ELEMENT 14 : C SHPTOT = FONCTIONS DE FORME 15 : C = SHPTOT(1,...) = FONCTIONS DE FORME 16 : C = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI 17 : C = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA 18 : C NBNO = NOMBRE DE NOEUDS DE L'ELEMENT 19 : C IVRF = DEMANDE DE VERIFICATION DE L 'ELEMENT 20 : C OUTPUT 21 : C XEL = COORDONNEES LOCALES 22 : C BPSS = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL 23 : C NOQUAL = INDICE DE QUALITE 24 : C = 0 SI OK 25 : C = 1 SI NOEUD TROP VOISINS 26 : C = 2 SI NOEUD NON COPLANAIRES 27 : C 28 : C REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES, DEFO. PLANES 29 : C AXISYMETRIQUE, LA MATRICE TETA SERA UNE MATRICE DE 30 : C DIMENSION (2X2), ET SERA CONSTITUEE PAR LES VECTEURS 31 : C S1 ET SN. LES CAS CONT.PLANES,DEF.PLANES ET AXISYMETRIQUE 32 : C SERONT DONC SIMILAIRES AU CAS D'UN JOINT BIDIMENSIONNEL 33 : C 34 : C======================================================================= 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8(A-H,O-Z) 37 : INTEGER IND4(0:5) 38 : DIMENSION XE(3,8),XEL(3,8),BPSS(3,3),SHPTOT(6,NBNO,*) 39 : DIMENSION U1(3),V1(3),XD(3,8),V2(3) 40 : DIMENSION S1(3),S2(3),SN(3) 41 : DATA IND4/4,1,2,3,4,1/ 42 : C 43 : NOQUAL = 0 44 : C1 = 0.0D0 45 : C2 = 0.0D0 46 : C3 = 0.0D0 47 : C 48 : C---------- VERIFICATION DE LA DISTANCE MINIMALE ENTRE LES POINTS 49 : C---------- PAR COMPARAISON AVEC LE POURTOUR DU JOINT 50 : C 51 : PP = 0.0D0 52 : DO 1 I=1,4 53 : II = I+1 54 : IF (II.EQ.5) II=1 55 : C1 = ABS(XE(1,I)-XE(1,II)) 56 : C2 = ABS(XE(2,I)-XE(2,II)) 57 : C3 = ABS(XE(3,I)-XE(3,II)) 58 : C1 = C1*C1 + C2*C2 + C3*C3 59 : PP = PP + SQRT(C1) 60 : 1 CONTINUE 61 : C 62 : DMIN=PP/50.0D0 63 : DO 2 I=1,3 64 : I1 = I+1 65 : DO 2 N=I1,4 66 : IF ( ABS(XE(1,I)-XE(1,N)).LE.DMIN.AND. 67 : & ABS(XE(2,I)-XE(2,N)).LE.DMIN.AND. 68 : & ABS(XE(3,I)-XE(3,N)).LE.DMIN ) THEN 69 : C NOEUDS TROP VOISINS 70 : NOQUAL=1 71 : ENDIF 72 : 2 CONTINUE 73 : C 74 : C---------- CALCUL DE LA MATRICE DE PASSAGE 75 : C 76 : DO 6 I=1,3 77 : S1(I)=0.0D0 78 : S2(I)=0.0D0 79 : SN(I)=0.0D0 80 : V2(I)=0.0D0 81 : 6 CONTINUE 82 : C 83 : DO 7 I=1,NBNO 84 : C 85 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI 86 : C 87 : S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) ) 88 : S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) ) 89 : S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) ) 90 : C 91 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA 92 : C 93 : V2(1) = V2(1) + ( SHPTOT(3,I,1)*XE(1,I) ) 94 : V2(2) = V2(2) + ( SHPTOT(3,I,1)*XE(2,I) ) 95 : V2(3) = V2(3) + ( SHPTOT(3,I,1)*XE(3,I) ) 96 : 7 CONTINUE 97 : C 97 : CALL NORMER(S1) 97 : CALL NORMER(V2) 98 : C-------------------NORMALE AU PLAN DU JOINT 99 : C 100 : SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2)) 101 : SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3)) 102 : SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1)) 102 : CALL NORMER(SN) 103 : C 104 : C-------------------ORTHOGONALISATION DE S2 105 : C 106 : S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2)) 107 : S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3)) 108 : S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1)) 108 : CALL NORMER(S2) 109 : C 110 : C-------------------STOCKAGE DE LA MATRICE DE PASSAGE 111 : C 112 : DO 10 I=1,3 113 : BPSS(1,I) = S1(I) 114 : BPSS(2,I) = S2(I) 115 : BPSS(3,I) = SN(I) 116 : 10 CONTINUE 117 : C 118 : C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT 119 : C 120 : C 121 : C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1) 122 : C 123 : * DO 8 J=1,NBNO 124 : * DO 8 I=1,3 125 : * XD(I,J) = XE(I,J) - XE(I,1) 126 : * 8 CONTINUE 127 : C 128 : C-------------------PROJECTION SUR LE PLAN DU JOINT 129 : C 130 : * DO 9 J=1,NBNO 131 : * XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3)) 132 : * XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3)) 133 : * XEL(3,J)=0.0D0 134 : * 9 CONTINUE 135 : C+PPj 136 : C 137 : C---------- CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT 138 : C QUE L'ON STOCKE DANS LA FIN DE XEL 139 : C 140 : NBNOS2=NBNO/2 141 : DO J=1,NBNOS2 142 : DO I=1,3 143 : XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2 144 : ENDDO 145 : ENDDO 146 : C 147 : C----------- CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT 148 : C (ORIGINE AU NOEUD 1) 149 : C 150 : DO J=1,NBNOS2 151 : DO I=1,3 152 : XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2) 153 : ENDDO 154 : ENDDO 155 : C 156 : C----------- PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE 157 : C DEBUT DE XEL 158 : C 159 : DO J=1,NBNOS2 160 : XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3)) 161 : XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3)) 162 : XEL(3,J)=0.0D0 163 : ENDDO 164 : C 165 : C+PPj 166 : C 167 : C---------- TEST DE PLANEITE 168 : C 169 : C CALCUL DES 4 NORMALES LOCALES 170 : C 171 : DO 3 K=1,4 172 : KP1 = IND4(K+1) 173 : KM1 = IND4(K-1) 174 : DO 4 J=1,3 175 : U1(J) = XE(J,KP1) - XE(J,K) 176 : V1(J) = XE(J,KM1) - XE(J,K) 177 : 4 CONTINUE 178 : C 179 : XD(1,K) = U1(2)*V1(3) - U1(3)*V1(2) 180 : XD(2,K) = U1(3)*V1(1) - U1(1)*V1(3) 181 : XD(3,K) = U1(1)*V1(2) - U1(2)*V1(1) 182 : C 183 : XXD = (XD(1,K)**2) + (XD(2,K)**2) + (XD(3,K)**2) 184 : XXD = SQRT(XXD) 185 : C 186 : IF (XXD.GT.0.0D0) THEN 187 : DO 5 J=1,3 188 : XD(J,K) = XD(J,K)/XXD 189 : 5 CONTINUE 190 : ENDIF 191 : 3 CONTINUE 192 : C 193 : C CALCUL DE LA NON PLANEITE 194 : C 195 : COS13 = XD(1,3)*XD(1,1) + XD(2,3)*XD(2,1) + XD(3,3)*XD(3,1) 196 : COS24 = XD(1,4)*XD(1,2) + XD(2,4)*XD(2,2) + XD(3,4)*XD(3,2) 197 : IF (MIN(COS13,COS24).LT.0.99999) THEN 198 : C NON PLANEITE DE 0.25 DEGRE OU PLUS 199 : C 0.99999, QUI EQUIVAUT A 1 DEGRE, EST INSUFFISANT 200 : NOQUAL = 2 201 : ENDIF 202 : C 203 : RETURN 204 : END 205 : 206 :
© Cast3M 2003 - All rights reserved.
Disclaimer