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