Télécharger kapcu1.eso

Retour à la liste

Numérotation des lignes :

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

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