Télécharger kapcu2.eso

Retour à la liste

Numérotation des lignes :

  1. C KAPCU2 SOURCE CB215821 16/04/21 21:17:25 8920
  2. SUBROUTINE KAPCU2(NES,X,A,NR,XR,IFACE,KFACE)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C PROJECTION D'UN POINT X SUR L'H.C DE RESOLUTION NR
  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. C WRITE(6,*) 'A1 XA(I) ',A1,XA(I)
  29. KS = KSIG(XA(I),EPS)
  30. C WRITE(6,*) ' KS ',KS
  31. C
  32. IF (I.EQ.1) THEN
  33. XR(2) = XA(2)/A1
  34. I1 = 1 + INT(NR2*(1+XR(2)))
  35. KFACE = MIN0(NR,I1)
  36. IF(KS.EQ.1) THEN
  37. IFACE= 1
  38. XR(1) = 1.
  39. ELSE
  40. IFACE = 2
  41. XR(1) = -1.
  42. ENDIF
  43. RETURN
  44. ENDIF
  45. IF (I.EQ.2) THEN
  46. XR(1) = XA(1)/A1
  47. I1 = 1 + INT(NR2*(1+XR(1)))
  48. KFACE = MIN0(NR,I1)
  49. IF(KS.EQ.1) THEN
  50. IFACE = 3
  51. XR(2) = 1.
  52. ELSE
  53. IFACE = 4
  54. XR(2) = -1.
  55. ENDIF
  56. RETURN
  57. ENDIF
  58. END
  59.  
  60.  
  61.  
  62.  
  63.  

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