Télécharger co2loc.eso

Retour à la liste

Numérotation des lignes :

  1. C CO2LOC SOURCE LJ1 14/11/13 21:15:12 8249
  2.  
  3. SUBROUTINE CO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL,IDIM)
  4. C=======================================================================
  5. C
  6. C -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT COA2
  7. C -TEST DE PLANEITE DES FACES DE L'ELEMENT
  8. C -CALCUL DE LA MATRICE DE PASSAGE BPSS
  9. C -CALCUL DES COORDONNEES LOCALES XEL
  10. C ROUTINE FORTRAN PUR
  11. C DERIVEE DE LA ROUTINE JO4LOC PAR S. FELIX
  12. C=======================================================================
  13. C INPUT
  14. C XE = COORDONNEES DE L ELEMENT
  15. C SHPTOT = FONCTIONS DE FORME
  16. C = SHPTOT(1,...) = FONCTIONS DE FORME
  17. C = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI
  18. C = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA
  19. C NBNO = NOMBRE DE NOEUDS DE L ELEMENT
  20. C IVRF = DEMANDE DE VERIFICATION DE L ELEMENT
  21. C OUTPUT
  22. C XEL = COORDONNEES LOCALES
  23. C BPSS = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL
  24. C NOQUAL = INDICE DE QUALITE
  25. C = 0 SI OK
  26. C = 1 SI NOEUD TROP VOISINS
  27. C = 2 SI NOEUD NON COPLANAIRES
  28. C
  29. C REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES, DEFO. PLANES
  30. C AXISYMETRIQUE, LA MATRICE TETA SERA UNE MATRICE DE
  31. C DIMENSION (2X2), ET SERA CONSTITUEE PAR LES VECTEURS
  32. C S1 ET SN. LES CAS CONT.PLANES,DEF.PLANES ET AXISYMETRIQUE
  33. C SERONT DONC SIMILAIRES AU CAS D UN JOINT BIDIMENSIONNEL
  34. C
  35. C=======================================================================
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8(A-H,O-Z)
  38. INTEGER IND4(0:4)
  39. DIMENSION XE(3,6),XEL(3,6),BPSS(3,3),SHPTOT(6,NBNO,*)
  40. DIMENSION U1(3),V1(3),XD(3,6),V2(3)
  41. DIMENSION S1(3),S2(3),SN(3)
  42. DIMENSION XX(3,6)
  43. DATA IND4/3,1,2,3,1/
  44. C
  45. NOQUAL = 0
  46. C
  47. C---------- CALCUL DE LA MATRICE DE PASSAGE
  48. C
  49. DO 6 I=1,IDIM
  50. S1(I)=0.0D0
  51. SN(I)=0.0D0
  52. IF (IDIM.EQ.3) THEN
  53. S2(I)=0.0D0
  54. V2(I)=0.0D0
  55. END IF
  56. 6 CONTINUE
  57.  
  58. C
  59. DO 7 I=1,NBNO
  60. C
  61. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  62. C
  63. S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  64. S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  65. IF (IDIM.EQ.3) S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
  66. C
  67. C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
  68. C
  69. ccccccccc
  70. IF (IDIM.EQ.2) THEN
  71. XNORME = SQRT((S1(1)**2) + (S1(2)**2))
  72. S1(1) = S1(1) / XNORME
  73. S1(2) = S1(2) / XNORME
  74. SN(1) = -S1(2)
  75. SN(2) = S1(1)
  76. ELSE IF (IDIM.EQ.3) THEN
  77. IF (S1(1).EQ.0.0D0.AND.S1(2).EQ.0.0D0) THEN
  78. V2(1) = 1.0D0
  79. V2(2) = 0.0D0
  80. V2(3) = 0.0D0
  81. ELSE IF (S1(2).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN
  82. V2(1) = 0.0D0
  83. V2(2) = 1.D0
  84. V2(3) = 0.D0
  85. ELSE IF (S1(1).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN
  86. V2(1) = 1.0D0
  87. V2(2) = 0.D0
  88. V2(3) = 0.0D0
  89. ELSE IF (S1(2).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN
  90. V2(1) = 0.0D0
  91. V2(2) = -S1(3)
  92. V2(3) = S1(2)
  93. ELSE IF (S1(1).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN
  94. V2(1) = -S1(3)
  95. V2(2) = 0.0D0
  96. V2(3) = S1(1)
  97. ELSE IF (S1(1).NE.0.0D0.AND.S1(2).NE.0.0D0) THEN
  98. V2(1) = -S1(2)
  99. V2(2) = S1(1)
  100. V2(3) = 0.0D0
  101. END IF
  102. END IF
  103. ccccccccc
  104. 7 CONTINUE
  105. C
  106. IF (IDIM.EQ.3) THEN
  107. CALL NORMER(S1)
  108. CALL NORMER(V2)
  109.  
  110. C-------------------NORMALE AU PLAN DU JOINT
  111. C
  112. SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
  113. SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
  114. SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
  115. CALL NORMER(SN)
  116. C
  117. C-------------------ORTHOGONALISATION DE S2
  118. C
  119. S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
  120. S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
  121. S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
  122. CALL NORMER(S2)
  123. END IF
  124. C
  125. C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  126. C
  127. DO 10 I=1,IDIM
  128. BPSS(1,I) = S1(I)
  129. IF (IDIM.EQ.2) THEN
  130. BPSS(2,I) = SN(I)
  131. ELSE IF (IDIM.EQ.3) THEN
  132. BPSS(2,I) = S2(I)
  133. BPSS(3,I) = SN(I)
  134. END IF
  135. 10 CONTINUE
  136. C
  137. C---------- CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  138. C
  139. C
  140. C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
  141. C
  142. DO 8 J=1,NBNO
  143. DO 8 I=1,IDIM
  144. XD(I,J) = XE(I,J) - XE(I,1)
  145. 8 CONTINUE
  146. C
  147. C-------------------PROJECTION SUR LE PLAN DU JOINT
  148. C
  149. DO 9 J=1,NBNO
  150. XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))
  151. XEL(2,J)=0.0d0
  152. IF (IDIM.EQ.3) THEN
  153. XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
  154. XEL(3,J)=0.0D0
  155. END IF
  156. 9 CONTINUE
  157. C+PPj
  158. C
  159. C---------- CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
  160. C QUE L ON STOCKE DANS LA FIN DE XEL
  161.  
  162. NBNOS2=NBNO/2
  163. DO J=1,NBNOS2
  164. DO I=1,IDIM
  165. XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2
  166. ENDDO
  167. ENDDO
  168. C
  169. C----------- CHANGEMENT D ORIGINE DU PLAN MOYEN DU JOINT
  170. C (ORIGINE AU NOEUD 1)
  171. DO J=1,NBNOS2
  172. DO I=1,IDIM
  173. XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
  174. ENDDO
  175. ENDDO
  176. RETURN
  177. END
  178.  
  179.  
  180.  
  181.  
  182.  

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