Télécharger jt3loc.eso

Retour à la liste

Numérotation des lignes :

  1. C JT3LOC SOURCE CHAT 05/01/13 00:50:10 5004
  2. SUBROUTINE JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
  3. C=======================================================================
  4. C
  5. C -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT JOT3
  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 DERIVEE DE LA ROUTINE JO4LOC PAR S. FELIX
  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:4)
  38. DIMENSION XE(3,6),XEL(3,6),BPSS(3,3),SHPTOT(6,NBNO,*)
  39. DIMENSION U1(3),V1(3),XD(3,6),V2(3)
  40. DIMENSION S1(3),S2(3),SN(3)
  41. DIMENSION XX(3,6)
  42. DATA IND4/3,1,2,3,1/
  43. C
  44. NOQUAL = 0
  45. C1 = 0.0D0
  46. C2 = 0.0D0
  47. C3 = 0.0D0
  48. C
  49. C---------- VERIFICATION DE LA DISTANCE MINIMALE ENTRE LES POINTS
  50. C---------- PAR COMPARAISON AVEC LE POURTOUR DU JOINT
  51. C
  52. PP = 0.0D0
  53. DO 1 I=1,3
  54. II = I+1
  55. IF (II.EQ.4) II=1
  56. C1 = ABS(XE(1,I)-XE(1,II))
  57. C2 = ABS(XE(2,I)-XE(2,II))
  58. C3 = ABS(XE(3,I)-XE(3,II))
  59. C1 = C1*C1 + C2*C2 + C3*C3
  60. PP = PP + SQRT(C1)
  61. 1 CONTINUE
  62. C
  63. DMIN=PP/50.0D0
  64. DO 2 I=1,2
  65. I1 = I+1
  66. DO 2 N=I1,3
  67. IF ( ABS(XE(1,I)-XE(1,N)).LE.DMIN.AND.
  68. & ABS(XE(2,I)-XE(2,N)).LE.DMIN.AND.
  69. & ABS(XE(3,I)-XE(3,N)).LE.DMIN ) THEN
  70. C NOEUDS TROP VOISINS
  71. NOQUAL=1
  72. ENDIF
  73. 2 CONTINUE
  74. C
  75. C---------- CALCUL DE LA MATRICE DE PASSAGE
  76. C
  77. DO 6 I=1,3
  78. S1(I)=0.0D0
  79. S2(I)=0.0D0
  80. SN(I)=0.0D0
  81. V2(I)=0.0D0
  82. 6 CONTINUE
  83. C
  84. DO 7 I=1,NBNO
  85. C
  86. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  87. C
  88. S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  89. S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  90. S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
  91. C
  92. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
  93. C
  94. V2(1) = V2(1) + ( SHPTOT(3,I,1)*XE(1,I) )
  95. V2(2) = V2(2) + ( SHPTOT(3,I,1)*XE(2,I) )
  96. V2(3) = V2(3) + ( SHPTOT(3,I,1)*XE(3,I) )
  97. 7 CONTINUE
  98. C
  99. CALL NORMER(S1)
  100. CALL NORMER(V2)
  101. C-------------------NORMALE AU PLAN DU JOINT
  102. C
  103. SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
  104. SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
  105. SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
  106. CALL NORMER(SN)
  107. C
  108. C-------------------ORTHOGONALISATION DE S2
  109. C
  110. S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
  111. S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
  112. S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
  113. CALL NORMER(S2)
  114. C
  115. C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  116. C
  117. DO 10 I=1,3
  118. BPSS(1,I) = S1(I)
  119. BPSS(2,I) = S2(I)
  120. BPSS(3,I) = SN(I)
  121. 10 CONTINUE
  122. C
  123. C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  124. C
  125. C
  126. C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
  127. C
  128. * DO 8 J=1,NBNO
  129. * DO 8 I=1,3
  130. * XD(I,J) = XE(I,J) - XE(I,1)
  131. * 8 CONTINUE
  132. C
  133. C-------------------PROJECTION SUR LE PLAN DU JOINT
  134. C
  135. * DO 9 J=1,NBNO
  136. * XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
  137. * XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
  138. * XEL(3,J)=0.0D0
  139. * 9 CONTINUE
  140. C+PPj
  141. C
  142. C---------- CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
  143. C QUE L'ON STOCKE DANS LA FIN DE XEL
  144. C
  145. NBNOS2=NBNO/2
  146. DO J=1,NBNOS2
  147. DO I=1,3
  148. XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2
  149. ENDDO
  150. ENDDO
  151. C
  152. C----------- CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT
  153. C (ORIGINE AU NOEUD 1)
  154. C
  155. DO J=1,NBNOS2
  156. DO I=1,3
  157. XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
  158. ENDDO
  159. ENDDO
  160. C
  161. C----------- PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE
  162. C DEBUT DE XEL
  163. C
  164. DO J=1,NBNOS2
  165. XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
  166. XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
  167. XEL(3,J)=0.0D0
  168. ENDDO
  169. C
  170. C+PPj
  171. C
  172. C---------- TEST DE PLANEITE
  173. C
  174. C CALCUL DES 4 NORMALES LOCALES
  175. C
  176. DO 3 K=1,3
  177. KP1 = IND4(K+1)
  178. KM1 = IND4(K-1)
  179. DO 4 J=1,3
  180. U1(J) = XE(J,KP1) - XE(J,K)
  181. V1(J) = XE(J,KM1) - XE(J,K)
  182. 4 CONTINUE
  183. C
  184. XD(1,K) = U1(2)*V1(3) - U1(3)*V1(2)
  185. XD(2,K) = U1(3)*V1(1) - U1(1)*V1(3)
  186. XD(3,K) = U1(1)*V1(2) - U1(2)*V1(1)
  187. C
  188. XXD = (XD(1,K)**2) + (XD(2,K)**2) + (XD(3,K)**2)
  189. XXD = SQRT(XXD)
  190. C
  191. IF (XXD.GT.0.0D0) THEN
  192. DO 5 J=1,3
  193. XD(J,K) = XD(J,K)/XXD
  194. 5 CONTINUE
  195. ENDIF
  196. 3 CONTINUE
  197. C
  198. C CALCUL DE LA NON PLANEITE
  199. C
  200. COS12 = XD(1,2)*XD(1,1) + XD(2,2)*XD(2,1) + XD(3,2)*XD(3,1)
  201. COS23 = XD(1,3)*XD(1,2) + XD(2,3)*XD(2,2) + XD(3,3)*XD(3,2)
  202. IF (MIN(COS12,COS23).LT.0.99999) THEN
  203. C NON PLANEITE DE 0.25 DEGRE OU PLUS
  204. C 0.99999, QUI EQUIVAUT A 1 DEGRE, EST INSUFFISANT
  205. NOQUAL = 2
  206. ENDIF
  207. C
  208. RETURN
  209. END
  210.  
  211.  
  212.  
  213.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales