Télécharger kainte.eso

Retour à la liste

Numérotation des lignes :

  1. C KAINTE SOURCE CB215821 16/04/21 21:17:22 8920
  2. SUBROUTINE KAINTE(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVUR,NAL,NM,AL,BL,KIMP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C Include contenant quelques constantes dont XPI :
  6. -INC CCREEL
  7. C*********************************************************************
  8. C SP appele par KAVOTH
  9. C
  10. C - RECHERCHE DE L INTERSECTION DU SEGMENT (RA,ZA),(RB,ZB)
  11. C POTENTIELLEMENT OBSTRUCTEUR
  12. C AVEC LE TRIANGLE DEFINI PAR LES POINTS D INTEGRATION SPATIALE
  13. C (R1,Z1) (R2,Z2)
  14. C
  15. C - MISE A JOUR DES INTERVALLES D INTEGRATION
  16. C
  17. C entree:
  18. C R1,Z1 : POINT D INTEGRATION SUR LA FACE 1
  19. C R2,Z2 : POINT D INTEGRATION SUR LA FACE 2
  20. C RA,ZA : PREMIER POINT DU SEGMENT OBSTRUCTEUR
  21. C RB,ZB : SECOND
  22. C sortie
  23. C KVUR : 0 SI OBSTRUCTION TOTALE,2 SI PARTIELLE,1 SINON
  24. C AL : INTERVALLES D INTEGRATION ANGULAIRE
  25. C BL : TABLEAU DE TRAVAIL (SAUVEGARDE DE AL)
  26. C NAL : NOMBRE D INTERVALLES
  27. C*********************************************************************
  28. DIMENSION AL(2,NM),BL(2,NM)
  29. C
  30. C>> POINT INTERIEUR SI A COMPRIS ENTRE -1 ET 1
  31. C KAFINT(R1,Z1,R2,Z2,R,Z)
  32. C
  33. C>> SEGMENT TANGENT SI A COMPRIS ENTRE -1 ET 1.D0
  34. C KAFTAN(R1,Z1,RA,ZA,RB,ZB)
  35. C
  36. C ON ENLEVE L INTERVALLE (TMIN,TMAX)
  37.  
  38. EMIN=1.D-5
  39. EMIN1=-1.D-5
  40. CMIN=1.D0-EMIN
  41. TMIN=0.D0
  42. TMAX=XPI
  43. KVUR=1
  44.  
  45. C>> segment horizontal
  46.  
  47. IF(ABS(Z2-Z1).LE.EMIN) THEN
  48. PROD=(Z1-ZA)*(Z1-ZB)
  49. IF (PROD.GE.EMIN) THEN
  50. IF(KIMP.GE.4)WRITE(6,*) ' MEME COTE: TOUT VU '
  51. KVUR=1
  52.  
  53. ELSEIF(ABS(R2-R1).LE.EMIN) THEN
  54. CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA)
  55. IF(RI.LT.R1) THEN
  56. CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1)
  57. IF(ABS(A1).LE.CMIN) THEN
  58. KVUR=2
  59. TMIN=2*ACOS(A1)
  60. IF(KIMP.GE.4)WRITE(6,*) ' COTE OPPOSE CACHE TMIN '
  61. $ ,TMIN
  62.  
  63. ELSE
  64. KVUR=1
  65. IF(KIMP.GE.4)WRITE(6,*) ' SEG HORIZ : PT TG '
  66. RETURN
  67. ENDIF
  68. ENDIF
  69. ELSE
  70. CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA)
  71.  
  72. IF (KM.EQ.1) THEN
  73. KVUR=0
  74. RETURN
  75. ENDIF
  76.  
  77. ENDIF
  78.  
  79. ELSE
  80.  
  81. C>> segment non horizontal
  82.  
  83. CALL KAFINT(R1,Z1,R2,Z2,RA,ZA,A)
  84. CALL KAFINT(R1,Z1,R2,Z2,RB,ZB,B)
  85. IF (ABS(A).LE.CMIN)THEN
  86. TA=ACOS(A)
  87. IF(KIMP.GE.4) WRITE(6,*) ' POINT A INTERIEUR : ANGLE ',TA
  88. ENDIF
  89.  
  90. IF (ABS(B).LE.CMIN)THEN
  91. TB=ACOS(B)
  92. IF(KIMP.GE.4) WRITE(6,*) ' POINT B INTERIEUR : ANGLE ',TB
  93. ENDIF
  94.  
  95. IF (ABS(A).LE.CMIN)THEN
  96. IF (ABS(B).LE.CMIN)THEN
  97. C>> 2 points interieurs
  98.  
  99. CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP)
  100. IF(KVV.NE.0) THEN
  101. TMIN= TC
  102. TMAX= DMAX1(TA,TB)
  103. IF(TMIN.GT.TMAX) WRITE(6,*) ' KAINTE ERREUR '
  104. ELSE
  105. TMIN= DMIN1(TA,TB)
  106. TMAX= DMAX1(TA,TB)
  107. ENDIF
  108. KVUR=2
  109.  
  110. ELSE
  111.  
  112. C>> point A interieur B exterieur
  113.  
  114. IF(KIMP.GE.4)WRITE(6,*) ' POINT A INTERIEUR B EXTERIEUR'
  115. KVUR=2
  116. CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA)
  117. IF (KM.EQ.1) THEN
  118. C>> intersection avec le cote M1M2
  119. IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TA
  120. IF(KA.EQ.1) THEN
  121. TMAX=TA
  122. ELSE
  123. TMIN=TA
  124. ENDIF
  125. ELSE
  126. IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TA
  127. TMIN=TA
  128. CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP)
  129. IF(KVV.NE.0) TMIN=DMIN1(TMIN,TC)
  130. ENDIF
  131.  
  132. ENDIF
  133. ELSE
  134.  
  135. IF (ABS(B).LE.CMIN)THEN
  136.  
  137. C>> point A exterieur B interieur
  138.  
  139. IF(KIMP.GE.4)WRITE(6,*) ' POINT A EXTERIEUR B INTERIEUR'
  140. KVUR=2
  141. CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA)
  142. IF (KM.EQ.1) THEN
  143. IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TB
  144. C>> intersection avec le cote M1M2
  145. IF(KA.EQ.1) THEN
  146. TMAX=TB
  147. ELSE
  148. TMIN=TB
  149. ENDIF
  150. ELSE
  151. IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TB
  152. TMIN=TB
  153. CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP)
  154. IF(KVV.NE.0) TMIN=DMIN1(TMIN,TC)
  155. ENDIF
  156.  
  157. ELSE
  158.  
  159. C>> points A et B exterieurs
  160.  
  161. IF(KIMP.GE.4)WRITE(6,*) ' POINT A ET B EXTERIEURS'
  162.  
  163. CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA)
  164. IF (KM.EQ.1) THEN
  165. IF(KA.EQ.1) THEN
  166. KVUR=0
  167. RETURN
  168. ELSE
  169. KVUR=1
  170. ENDIF
  171. ELSE
  172.  
  173. CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1)
  174. CALL KAFTAN(R2,Z2,RA,ZA,RB,ZB,A2)
  175.  
  176. IF(ABS(A1).LE.CMIN.AND.ABS(A2).LE.CMIN) THEN
  177. C>> existence du point tangent
  178. TA1=ACOS(A1)
  179. TA2=ACOS(A2)
  180. RD=R1*SIN(TA1)+R2*SIN(TA2)
  181. RC=R1*R2*SIN(TA1+TA2)/RD
  182. ZC=(Z1*R2*SIN(TA2)+Z2*R1*SIN(TA1))/RD
  183. CALL KAFINT(R1,Z1,R2,Z2,RC,ZC,AC)
  184. IF(ABS(AC).LE.1.D0) THEN
  185. C >> le point tangent appartient au triangle
  186. TC=TA1+TA2
  187. IF(KIMP.GE.4) THEN
  188. WRITE(6,*) ' RA ZA ',RA,ZA
  189. WRITE(6,*) ' RB ZB ',RB,ZB
  190. WRITE(6,*) ' RC ZC ',RC,ZC
  191. ENDIF
  192. PC=(RC-RA)*(RC-RB)+(ZC-ZA)*(ZC-ZB)
  193. C >> le point tangent est a l interieur du segment AB
  194. IF(PC.LT.EMIN1) THEN
  195. KVUR=2
  196. TMIN=TC
  197. IF(KIMP.GE.4)WRITE(6,*)
  198. $ ' POINT TANGENT ANGLE ',TC
  199. ELSE
  200. KVUR=1
  201. IF(KIMP.GE.4)WRITE(6,*)
  202. $ ' SEGMENT EXTERIEUR : TOUT VU '
  203. ENDIF
  204.  
  205. ELSE
  206. IF(KIMP.GE.4)WRITE(6,*) ' PT TGT EXT : TOUT VU '
  207. KVUR=1
  208. ENDIF
  209. ELSE
  210. C>> pas de point tangent
  211. KVUR=1
  212. IF(KIMP.GE.4)WRITE(6,*) ' PAS DE PT TGT: TOUT VU '
  213. ENDIF
  214. ENDIF
  215.  
  216. ENDIF
  217. ENDIF
  218.  
  219. ENDIF
  220.  
  221. C>> mise a jour des intervalles d integration
  222.  
  223. IF(KVUR.EQ.2.AND.ABS(TMAX-TMIN).GE.EMIN) THEN
  224. IF (KIMP.GE.4) THEN
  225. WRITE(6,*) ' AVANT KARSET KVU MIN MAX ',KVUR,TMIN,TMAX
  226. ENDIF
  227. CALL KARSET(AL,BL,NAL,NM,TMIN,TMAX,KVU)
  228.  
  229. KVUR=KVU
  230. ENDIF
  231.  
  232. RETURN
  233. END
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  

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