Télécharger dvhyp2.eso

Retour à la liste

Numérotation des lignes :

dvhyp2
  1. C DVHYP2 SOURCE KICH 19/10/25 21:15:08 10351
  2. subroutine dvhyp2(nbrobl,nombre,s,n,liste,iok2,r2,centre)
  3. c
  4. c *************************************************
  5. c trouver la plus petite hypersphere circonscrite
  6. c aux points de la liste
  7. c *************************************************
  8. c
  9. implicit real*8 (a-h,o-z)
  10. implicit integer (i-n)
  11. real*8 s(nbrobl-1,nombre)
  12. integer liste(6)
  13. real*8 tns(5,5),vc(5),res(5),u(5),v(5),centre(5)
  14.  
  15. iok2 = 0
  16. do mm=1,5
  17. u(mm) = 0.d0
  18. v(mm) = 0.d0
  19. vc(mm) = 0.d0
  20. enddo
  21. n = n-1
  22. do k=1,n
  23. do l=k,n
  24. do ict=1,nbrobl-1
  25. u(ict) = s(ict,liste(l+1))-s(ict,liste(1))
  26. v(ict) = s(ict,liste(k+1))-s(ict,liste(1))
  27. enddo
  28. tns(k,l) = u(1)*v(1) + u(2)*v(2) + 2.d0*(u(3)*v(3)
  29. & + u(4)*v(4) + u(5)*v(5))
  30. tns(l,k)=tns(k,l)
  31. enddo
  32. do ict=1,nbrobl-1
  33. u(ict) = s(ict,liste(k+1))-s(ict,liste(1))
  34. enddo
  35. vc(k) = (u(1)**2+u(2)**2+2.*(u(3)**2+u(4)**2+u(5)**2))/2.d0
  36. enddo
  37. call dvinve(n,tns,vc,res,iok3)
  38. if(iok3.eq.1) go to 525
  39. iok2 = 0
  40. go to 600
  41. 525 continue
  42. do k=1,nbrobl-1
  43. centre(k)=s(k,liste(1))
  44. do l=1,n
  45. centre(k)=centre(k)+res(l)*(s(k,liste(l+1))-s(k,liste(1)))
  46. enddo
  47. vc(k)=s(k,liste(1))-centre(k)
  48. enddo
  49. r2 = (vc(1)**2+vc(2)**2+2.*(vc(3)**2+vc(4)**2+vc(5)**2))
  50. 600 continue
  51. return
  52. end
  53.  
  54.  
  55.  
  56.  

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