Télécharger kapc21.eso

Retour à la liste

Numérotation des lignes :

  1. C KAPC21 SOURCE CB215821 16/04/21 21:17:24 8920
  2. SUBROUTINE KAPC21(NES,X,A,NR,XR,IFACE,KFACE,KAC)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C CAS DE 2 FACES PARALLELES: DIRECTION KAC
  7. C ----------------------------------------
  8. C A : CENTRE DE L'H.C
  9. C IFACE : NUMERO DE FACE
  10. C KFACE : COORDONNEES ENTIERES SUR LA FACE
  11. C
  12. DIMENSION X(NES),A(NES),XA(2),XR(NES)
  13. C
  14. NR2 = NR/2
  15. EPS=1D-5
  16. XAB = -EPS
  17. A1 = -1D-10
  18.  
  19. DO 1 IES = 1,NES
  20. XA(IES) = X(IES)-A(IES)
  21. A2=ABS(XA(IES))
  22. IF(A2.GT.A1) THEN
  23. A1 = A2
  24. I = IES
  25. ENDIF
  26. 1 CONTINUE
  27. C
  28. IF (I.EQ.KAC) THEN
  29. DO 2 IES = 1,NES
  30. A2 = ABS(XA(IES))
  31. ERR = ABS(1.-A2/A1)
  32. IF (IES.EQ.I.AND.ERR.LT.0.01) THEN
  33. I = IES
  34. GOTO 3
  35. ENDIF
  36. 2 CONTINUE
  37. ENDIF
  38.  
  39. 3 CONTINUE
  40.  
  41. C WRITE(6,*) 'A1 XA(I) ',A1,XA(I)
  42. KS = KSIG(XA(I),EPS)
  43. C WRITE(6,*) ' KS ',KS
  44. C
  45. IF (I.EQ.1) THEN
  46. XR(2) = XA(2)/A1
  47. I1 = 1 + INT(NR2*(1+XR(2)))
  48. KFACE = MIN0(NR,I1)
  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. I1 = 1 + INT(NR2*(1+XR(1)))
  61. KFACE = MIN0(NR,I1)
  62. IF(KS.EQ.1) THEN
  63. IFACE = 3
  64. XR(2) = 1.
  65. ELSE
  66. IFACE = 4
  67. XR(2) = -1.
  68. ENDIF
  69. RETURN
  70. ENDIF
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  

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