Télécharger kapcub.eso

Retour à la liste

Numérotation des lignes :

  1. C KAPCUB SOURCE CB215821 16/04/21 21:17:26 8920
  2. SUBROUTINE KAPCUB(NES,X,A,NR,XR,IFACE,KFACE1,KFACE2)
  3. *
  4. C-----------------------------------------------------------------------
  5. C Calcul des facteurs de forme en 3D
  6. C Sp appele par ksubcr
  7. C PROJECTION D'UN POINT X SUR L'H.C DE RESOLUTION NR
  8. C ---------------------------------------------------
  9. C A : CENTRE DE L'H.C
  10. C IFACE : NUMERO DE FACE
  11. C KFACE1,KFACE2 : COORDONNEES ENTIERES SUR LA FACE
  12. C
  13. C-----------------------------------------------------------------------
  14. *
  15. *
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8 (A-H,O-Z)
  18. DIMENSION X(NES),A(NES),XA(3),XR(NES)
  19. C
  20. NR2 = NR/2
  21. EPS=1E-5
  22. XAB = -EPS
  23. A1 = -1E-10
  24.  
  25. DO 1 IES = 1,NES
  26. XA(IES) = X(IES)-A(IES)
  27. A2=ABS(XA(IES))
  28. IF(A2.GT.A1) THEN
  29. A1 = A2
  30. I = IES
  31. ENDIF
  32. 1 CONTINUE
  33. C
  34. C WRITE(6,*) 'A1 XA(I) ',A1,XA(I)
  35. KS = KSIG(XA(I),EPS)
  36. C WRITE(6,*) ' KS ',KS
  37. C
  38. IF (I.EQ.1) THEN
  39. XR(2) = XA(2)/A1
  40. XR(3) = XA(3)/A1
  41. I1 = 1 + INT(NR2*(1+XR(2)))
  42. I2 = 1 + INT(NR2*(1+XR(3)))
  43. KFACE1 = MIN0(NR,I1)
  44. KFACE2 = MIN0(NR,I2)
  45. IF(KS.EQ.1) THEN
  46. IFACE= 1
  47. XR(1) = 1.
  48. ELSE
  49. IFACE = 2
  50. XR(1) = -1.
  51. ENDIF
  52. RETURN
  53. ENDIF
  54. IF (I.EQ.2) THEN
  55. XR(1) = XA(1)/A1
  56. XR(3) = XA(3)/A1
  57. I1 = 1 + INT(NR2*(1+XR(1)))
  58. I2 = 1 + INT(NR2*(1+XR(3)))
  59. KFACE1 = MIN0(NR,I1)
  60. KFACE2 = MIN0(NR,I2)
  61. IF(KS.EQ.1) THEN
  62. IFACE = 3
  63. XR(2) = 1.
  64. ELSE
  65. IFACE = 4
  66. XR(2) = -1.
  67. ENDIF
  68. RETURN
  69. ENDIF
  70. IF (I.EQ.3) THEN
  71. XR(1) = XA(1)/A1
  72. XR(2) = XA(2)/A1
  73. I1 = 1 + INT(NR2*(1+XR(1)))
  74. I2 = 1 + INT(NR2*(1+XR(2)))
  75. KFACE1 = MIN0(NR,I1)
  76. KFACE2 = MIN0(NR,I2)
  77. IF(KS.EQ.1) THEN
  78. IFACE = 5
  79. XR(3) = 1.
  80. ELSE
  81. IFACE = 6
  82. XR(3) = -1.
  83. ENDIF
  84. RETURN
  85. ENDIF
  86. END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  

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