Télécharger bcirco.eso

Retour à la liste

Numérotation des lignes :

  1. C BCIRCO SOURCE BP208322 16/11/18 21:15:14 9177
  2. SUBROUTINE BCIRCO(IRN1,IPT0,JEL,XC,XR)
  3. C---------------------------------------------------------------------C
  4. C BCIRCO renvoie les coordonnees du centre et le rayon de la C
  5. C boule circonscrite a l'element JEL du MELEME IPT0. C
  6. C C
  7. C IPT0 : pointeur de type MELEME actif en entree et en sortie C
  8. C JEL : numero de l'element de IPT0 dont on cherche le centre et C
  9. C le rayon de la boule circonscrite C
  10. C XC : vecteur de dimension IDIM contenant les coordonnees du C
  11. C centre de la boule circonscrite C
  12. C XR : rayon de la boule circonscrite C
  13. C---------------------------------------------------------------------C
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8 (A-H,O-Z)
  16. c
  17. -INC CCOPTIO
  18. -INC SMELEME
  19. -INC SMCOORD
  20. -INC CCGEOME
  21. DIMENSION XC(3),XPTS(4,3),A(3,3),B(3,1),BB(4),XM(4,3)
  22. C
  23. DIMENSION RPTS(4),XPTS1(3),YPTS1(3),ZPTS1(3),W(3)
  24.  
  25. SEGMENT RAYONOE
  26. REAL*8 RAYN(NBNER)
  27. ENDSEGMENT
  28. POINTEUR IRN1.RAYONOE
  29.  
  30.  
  31. IDIMP1=IDIM+1
  32. IPT1=IPT0
  33. c
  34. DO I=1,IDIMP1
  35. RPTS(I)=IRN1.RAYN(IPT1.NUM(I,JEL))
  36. END DO
  37. C
  38. IF (IDIM.EQ.3) THEN
  39. IREF1=(IPT1.NUM(1,JEL)-1)*IDIMP1
  40. IREF2=(IPT1.NUM(2,JEL)-1)*IDIMP1
  41. IREF3=(IPT1.NUM(3,JEL)-1)*IDIMP1
  42. IREF4=(IPT1.NUM(4,JEL)-1)*IDIMP1
  43. XPTS(1,1)=XCOOR(IREF1+1)
  44. XPTS(1,2)=XCOOR(IREF1+2)
  45. XPTS(1,3)=XCOOR(IREF1+3)
  46. XPTS(2,1)=XCOOR(IREF2+1)
  47. XPTS(2,2)=XCOOR(IREF2+2)
  48. XPTS(2,3)=XCOOR(IREF2+3)
  49. XPTS(3,1)=XCOOR(IREF3+1)
  50. XPTS(3,2)=XCOOR(IREF3+2)
  51. XPTS(3,3)=XCOOR(IREF3+3)
  52. XPTS(4,1)=XCOOR(IREF4+1)
  53. XPTS(4,2)=XCOOR(IREF4+2)
  54. XPTS(4,3)=XCOOR(IREF4+3)
  55. C
  56. DO i=1,3
  57. W(i)= (RPTS(1)*RPTS(1))-(RPTS(i+1)*RPTS(i+1))
  58. & +(XPTS(i+1,1)*XPTS(i+1,1))+(XPTS(i+1,2)*XPTS(i+1,2))
  59. & +(XPTS(i+1,3)*XPTS(i+1,3))-(XPTS(1,1)*XPTS(1,1))
  60. & -(XPTS(1,2)*XPTS(1,2))-(XPTS(1,3)*XPTS(1,3))
  61. W(i)=0.5*W(i)
  62. END DO
  63.  
  64. A(1,1)=XPTS(2,1)-XPTS(1,1)
  65. A(1,2)=XPTS(2,2)-XPTS(1,2)
  66. A(1,3)=XPTS(2,3)-XPTS(1,3)
  67. A(2,1)=XPTS(3,1)-XPTS(1,1)
  68. A(2,2)=XPTS(3,2)-XPTS(1,2)
  69. A(2,3)=XPTS(3,3)-XPTS(1,3)
  70. A(3,1)=XPTS(4,1)-XPTS(1,1)
  71. A(3,2)=XPTS(4,2)-XPTS(1,2)
  72. A(3,3)=XPTS(4,3)-XPTS(1,3)
  73. B(1,1)=W(1)
  74. B(2,1)=W(2)
  75. B(3,1)=W(3)
  76. C
  77. c
  78.  
  79. CALL GAUSSK(A,3,3,B,1,1)
  80. C
  81. IF (IERR.NE.0) then
  82. WRITE(6,*) 'il y a une erreur dans bcirco'
  83. RETURN
  84. endif
  85. C
  86. XC(1)=B(1,1)
  87. XC(2)=B(2,1)
  88. XC(3)=B(3,1)
  89. C
  90. XR=(XC(1)-XPTS(1,1))*(XC(1)-XPTS(1,1))
  91. & +(XC(2)-XPTS(1,2))*(XC(2)-XPTS(1,2))
  92. & +(XC(3)-XPTS(1,3))*(XC(3)-XPTS(1,3))
  93. & - ((RPTS(1))*(RPTS(1)))
  94. c
  95. XR = XR**0.5
  96. c
  97. C
  98. ELSEIF (IDIM.EQ.2) THEN
  99. IREF1=(IPT1.NUM(1,JEL)-1)*IDIMP1
  100. IREF2=(IPT1.NUM(2,JEL)-1)*IDIMP1
  101. IREF3=(IPT1.NUM(3,JEL)-1)*IDIMP1
  102. XPTS(1,1)=XCOOR(IREF1+1)
  103. XPTS(1,2)=XCOOR(IREF1+2)
  104. XPTS(2,1)=XCOOR(IREF2+1)
  105. XPTS(2,2)=XCOOR(IREF2+2)
  106. XPTS(3,1)=XCOOR(IREF3+1)
  107. XPTS(3,2)=XCOOR(IREF3+2)
  108. C
  109. DO i=1,2
  110. W(i)= ((RPTS(1))**2)-((RPTS(i+1))**2)
  111. & +((XPTS(i+1,1))**2)+((XPTS(i+1,2))**2)
  112. & -((XPTS(1,1))**2)-((XPTS(1,2))**2)
  113. W(i)=0.5*W(i)
  114. END DO
  115. c
  116. A(1,1)=XPTS(2,1)-XPTS(1,1)
  117. A(1,2)=XPTS(2,2)-XPTS(1,2)
  118. A(2,1)=XPTS(3,1)-XPTS(1,1)
  119. A(2,2)=XPTS(3,2)-XPTS(1,2)
  120. c
  121. B(1,1)=W(1)
  122. B(2,1)=W(2)
  123. C
  124. CALL GAUSSK(A,2,3,B,1,1)
  125. C
  126. IF (IERR.NE.0) then
  127. print*,'il y a une erreur dans bcirco : GAUSSK'
  128. RETURN
  129. endif
  130. C
  131. XC(1)=B(1,1)
  132. XC(2)=B(2,1)
  133. C
  134. XR=(XC(1)-XPTS(1,1))**2+(XC(2)-XPTS(1,2))**2
  135. & - ((RPTS(1))**2)
  136. c
  137. XR = XR**0.5
  138.  
  139. c
  140. c
  141. ELSEIF (IDIM.EQ.1) THEN
  142. XPTS(1,1)=XCOOR((IPT1.NUM(1,JEL)-1)*IDIMP1+1)
  143. XPTS(2,1)=XCOOR((IPT1.NUM(2,JEL)-1)*IDIMP1+1)
  144. XC(1)=0.5*((RPTS(1)**2)-(RPTS(2)**2)+(XPTS(2,1)**2)-
  145. & (XPTS(1,1)**2))/(XPTS(2,1)-XPTS(1,1))
  146. XR = XC(1)-XPTS(1,1)
  147. ENDIF
  148. C
  149. RETURN
  150. END
  151.  
  152.  
  153.  
  154.  
  155.  

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