Télécharger kapttg.eso

Retour à la liste

Numérotation des lignes :

  1. C KAPTTG SOURCE CB215821 16/04/21 21:17:26 8920
  2. SUBROUTINE KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. C SP appele par KAINTE
  7. C recherche de l existence d un point tangent associe au segment
  8. C (RA,ZA) (RB,ZB) et de son appartenance au triangle defini
  9. C les points d integration (R1,Z1) (R2,Z2)
  10. C si oui KVV=1
  11. C TC : valeur de l angle associe au point tangent
  12. C sinon KVV=0
  13. C----------------------------------------------------------------------
  14. C
  15. C
  16.  
  17. EMIN=1.D-5
  18. EMIN1=-1.D-5
  19. CMIN=1.D0-EMIN
  20. KVV=0
  21. TC=0.D0
  22.  
  23. CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1)
  24. CALL KAFTAN(R2,Z2,RA,ZA,RB,ZB,A2)
  25. C WRITE(6,*) ' A1 A2 ',A1,A2
  26.  
  27. IF(ABS(A1).LE.CMIN.AND.ABS(A2).LE.CMIN) THEN
  28. C POINT TANGENT
  29. TA1=ACOS(A1)
  30. TA2=ACOS(A2)
  31. C WRITE(6,*) ' POINT TANGENT TA1 TA2 ',TA1,TA2
  32. RD=R1*SIN(TA1)+R2*SIN(TA2)
  33. RC=R1*R2*SIN(TA1+TA2)/RD
  34. ZC=(Z1*R2*SIN(TA2)+Z2*R1*SIN(TA1))/RD
  35. C PRO< 0 PT TANGENT interieur au segment AB
  36. PRO=(RA-RC)*(RB-RC)+(ZA-ZC)*(ZB-ZC)
  37. CALL KAFINT(R1,Z1,R2,Z2,RC,ZC,AC)
  38. IF(ABS(AC).LE.1.AND.PRO.LT.EMIN1) THEN
  39. C >> LE POINT TANGENT SE TROUVE DANS LE TRIANGLE
  40.  
  41. TC=TA1+TA2
  42. IF(KIMP.GE.4)WRITE(6,*) ' POINT TANGENT ANGLE ',TC
  43. KVV=1
  44. C!!
  45. ELSE
  46. IF(KIMP.GE.4)WRITE(6,*) ' POINT TANGENT EXTERIEUR AU SEGMENT '
  47. KVV=0
  48. ENDIF
  49. ELSE
  50. C PAS DE POINT TANGENT
  51. KVV=0
  52. IF(KIMP.GE.4)WRITE(6,*) ' PAS DE POINT TANGENT TOUT VU 2'
  53. ENDIF
  54.  
  55. RETURN
  56. END
  57.  
  58.  
  59.  
  60.  

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