Télécharger jo4loc.eso

Retour à la liste

Numérotation des lignes :

  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
  98. CALL NORMER(S1)
  99. CALL NORMER(V2)
  100. C-------------------NORMALE AU PLAN DU JOINT
  101. C
  102. SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
  103. SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
  104. SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
  105. CALL NORMER(SN)
  106. C
  107. C-------------------ORTHOGONALISATION DE S2
  108. C
  109. S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
  110. S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
  111. S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
  112. CALL NORMER(S2)
  113. C
  114. C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  115. C
  116. DO 10 I=1,3
  117. BPSS(1,I) = S1(I)
  118. BPSS(2,I) = S2(I)
  119. BPSS(3,I) = SN(I)
  120. 10 CONTINUE
  121. C
  122. C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  123. C
  124. C
  125. C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
  126. C
  127. * DO 8 J=1,NBNO
  128. * DO 8 I=1,3
  129. * XD(I,J) = XE(I,J) - XE(I,1)
  130. * 8 CONTINUE
  131. C
  132. C-------------------PROJECTION SUR LE PLAN DU JOINT
  133. C
  134. * DO 9 J=1,NBNO
  135. * XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
  136. * XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
  137. * XEL(3,J)=0.0D0
  138. * 9 CONTINUE
  139. C+PPj
  140. C
  141. C---------- CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
  142. C QUE L'ON STOCKE DANS LA FIN DE XEL
  143. C
  144. NBNOS2=NBNO/2
  145. DO J=1,NBNOS2
  146. DO I=1,3
  147. XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2
  148. ENDDO
  149. ENDDO
  150. C
  151. C----------- CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT
  152. C (ORIGINE AU NOEUD 1)
  153. C
  154. DO J=1,NBNOS2
  155. DO I=1,3
  156. XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
  157. ENDDO
  158. ENDDO
  159. C
  160. C----------- PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE
  161. C DEBUT DE XEL
  162. C
  163. DO J=1,NBNOS2
  164. XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
  165. XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
  166. XEL(3,J)=0.0D0
  167. ENDDO
  168. C
  169. C+PPj
  170. C
  171. C---------- TEST DE PLANEITE
  172. C
  173. C CALCUL DES 4 NORMALES LOCALES
  174. C
  175. DO 3 K=1,4
  176. KP1 = IND4(K+1)
  177. KM1 = IND4(K-1)
  178. DO 4 J=1,3
  179. U1(J) = XE(J,KP1) - XE(J,K)
  180. V1(J) = XE(J,KM1) - XE(J,K)
  181. 4 CONTINUE
  182. C
  183. XD(1,K) = U1(2)*V1(3) - U1(3)*V1(2)
  184. XD(2,K) = U1(3)*V1(1) - U1(1)*V1(3)
  185. XD(3,K) = U1(1)*V1(2) - U1(2)*V1(1)
  186. C
  187. XXD = (XD(1,K)**2) + (XD(2,K)**2) + (XD(3,K)**2)
  188. XXD = SQRT(XXD)
  189. C
  190. IF (XXD.GT.0.0D0) THEN
  191. DO 5 J=1,3
  192. XD(J,K) = XD(J,K)/XXD
  193. 5 CONTINUE
  194. ENDIF
  195. 3 CONTINUE
  196. C
  197. C CALCUL DE LA NON PLANEITE
  198. C
  199. COS13 = XD(1,3)*XD(1,1) + XD(2,3)*XD(2,1) + XD(3,3)*XD(3,1)
  200. COS24 = XD(1,4)*XD(1,2) + XD(2,4)*XD(2,2) + XD(3,4)*XD(3,2)
  201. IF (MIN(COS13,COS24).LT.0.99999) THEN
  202. C NON PLANEITE DE 0.25 DEGRE OU PLUS
  203. C 0.99999, QUI EQUIVAUT A 1 DEGRE, EST INSUFFISANT
  204. NOQUAL = 2
  205. ENDIF
  206. C
  207. RETURN
  208. END
  209.  
  210.  
  211.  

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