Download kapttg.eso

Back to the list

   1 : C KAPTTG    SOURCE    CHAT      05/01/13    00:51:31     5004           
   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 : 
  22 :        CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1)
  22 :        CALL KAFTAN(R2,Z2,RA,ZA,RB,ZB,A2)
  23 : C      WRITE(6,*) ' A1 A2 ',A1,A2
  24 : 
  25 :          IF(DABS(A1).LE.CMIN.AND.DABS(A2).LE.CMIN) THEN
  26 : C   POINT TANGENT
  27 :            TA1=DACOS(A1)
  28 :            TA2=DACOS(A2)
  29 : C          WRITE(6,*) ' POINT TANGENT TA1 TA2 ',TA1,TA2
  30 :            RD=R1*DSIN(TA1)+R2*DSIN(TA2)
  31 :            RC=R1*R2*DSIN(TA1+TA2)/RD
  32 :            ZC=(Z1*R2*DSIN(TA2)+Z2*R1*DSIN(TA1))/RD
  33 : C PRO< 0 PT TANGENT interieur au segment AB
  34 :            PRO=(RA-RC)*(RB-RC)+(ZA-ZC)*(ZB-ZC)
  34 :            CALL KAFINT(R1,Z1,R2,Z2,RC,ZC,AC)
  35 :            IF(DABS(AC).LE.1.AND.PRO.LT.EMIN1) THEN
  36 : C >> LE POINT TANGENT SE TROUVE DANS LE TRIANGLE
  37 : 
  38 :             TC=TA1+TA2
  39 :           IF(KIMP.GE.4)WRITE(6,*) ' POINT TANGENT  ANGLE ',TC
  40 :             KVV=1
  41 : C!!
  42 :            ELSE
  43 :        IF(KIMP.GE.4)WRITE(6,*) ' POINT TANGENT EXTERIEUR AU SEGMENT '
  44 :            KVV=0
  45 :            ENDIF
  46 :          ELSE
  47 : C   PAS DE POINT TANGENT
  48 :            KVV=0
  49 :            IF(KIMP.GE.4)WRITE(6,*) ' PAS DE POINT TANGENT  TOUT VU 2'
  50 :          ENDIF
  51 : 
  52 :       RETURN
  53 :       END
  54 :  

© Cast3M 2003 - All rights reserved.
Disclaimer