C KAVOWN SOURCE CHAT 05/01/13 00:51:48 5004 SUBROUTINE KAVOWN(RI,ZI,RJ,ZJ,DRI,DZI,DRJ,DZJ,KVU,NM,NAL,AL,KIMP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C Include contenant quelques constantes dont XPI : -INC CCREEL C********************************************************************* C SP appele par KAXK C C - DETERMINATION DE LES LIMITES D INTEGRATION ANGULAIRE POUR LES C POINTS I (SUR LE SEGMENT 1) ET J(SUR LE SGMENT 2) N NE TENANT C PAS COMPTE DES OBSTRUCTEURS C - EN CAS DE VISIBILITE INITIALISATION DU TABLEAU AL C entree: C RI,ZI :COORDONNEES DU POINT I SUR LE SEGMENT 1 C RJ,ZJ :COORDONNEES DU POINT J SUR LE SEGMENT 2 C DRI,DZI :COORDONNEES DU VECTEUR SEGMENT 1 C DRI,DZI :COORDONNEES DU VECTEUR SEGMENT 2 C resultat: C KVU : 1 SI VISIBLE ,0 SINON C AL :INTERVALLES D INTEGRATION C NAL :NOMBRE D INTERVALLES C********************************************************************* DIMENSION AL(2,NM) EMIN= 1.D-10 EMIN1=-EMIN DMIN= 1.D-4 KVU=1 H=ZJ-ZI AI=-H*DRI AJ= H*DRJ T1=0.D0 T2=XPI C>> TRAITEMENT DU POINT I SUR LA FACE 1 IF(DABS(DZI).LE.EMIN) THEN IF(AI.GE.EMIN1) THEN KVU=0 RETURN ENDIF ELSEIF(DZI.GE.EMIN) THEN A = (RI+H*DRI/DZI)/RJ IF(KIMP.GE.4) WRITE(6,*) ' PT I DZI A ',DZI,A IF(A.LT.(-1.D0+EMIN)) THEN KVU=0 RETURN ELSEIF(A.GE.(1.D0-EMIN)) THEN KVU=1 ELSE KVU=1 T1=DACOS(A) ENDIF ELSE A = (RI+H*DRI/DZI)/RJ IF(KIMP.GE.4) WRITE(6,*) ' PT I DZI A ',DZI,A IF(A.LT.(-1.D0+EMIN)) THEN KVU=1 ELSEIF(A.GE.(1.D0-EMIN)) THEN KVU=0 RETURN ELSE KVU=1 T2=DACOS(A) ENDIF ENDIF C>> TRAITEMENT DU POINT J SUR LA FACE 2 IF(DABS(DZJ).LE.EMIN) THEN IF(AJ.GE.EMIN1) THEN KVU=0 RETURN ENDIF ELSEIF(DZJ.GE.EMIN) THEN A = (RJ-H*DRJ/DZJ)/RI IF(KIMP.GE.4) WRITE(6,*) ' PT J DZJ A ',DZJ,A IF(A.LT.(-1.D0+EMIN)) THEN KVU=0 RETURN ELSEIF(A.GE.(1.D0-EMIN)) THEN KVU=1 ELSE KVU=1 T1=DMAX1(T1,DACOS(A)) ENDIF ELSE A = (RJ-H*DRJ/DZJ)/RI IF(KIMP.GE.4) WRITE(6,*) ' PT J DZJ A ',DZJ,A IF(A.LT.(-1.D0+EMIN)) THEN KVU=1 ELSEIF(A.GE.(1.D0-EMIN)) THEN KVU=0 RETURN ELSE KVU=1 T2=DMIN1(T2,DACOS(A)) ENDIF ENDIF IF(KIMP.GE.4)WRITE(6,*) ' KAVOWN KVU T1 T2 ',KVU,T1,T2 C IF(KVU.NE.1) WRITE(6,*) ' ERREUR ' C>> INITIALISATION INTERVALLES INTEGRATION IF(T2-T1.GE.DMIN) THEN NAL=1 AL(1,1)=T1 AL(2,1)=T2 AL(1,2)=XPI ELSE KVU=0 ENDIF RETURN END