Télécharger solpri.eso

Retour à la liste

Numérotation des lignes :

  1. C SOLPRI SOURCE PV 17/09/12 21:15:03 9542
  2. C---------------------------------------------------------------------|
  3. C |
  4. LOGICAL FUNCTION SOLPRI(IF1,IF2,IF3,IF4,IF5)
  5. C |
  6. C CETTE FONCTION LOGIQUE TESTE SI LE PRISME DECRIT PAR LES |
  7. C FACETTES IF1..IF5 EST VIDE DE POINTS. |
  8. C LES FACETTES SUPPRIMEES SONT ORIENTES DANS L'AUTRE SENS
  9. C SOLPRI EST VRAI SI LE PRISME EST VIDE (DONC VALIDE) |
  10. C SOLPRI EST FAUX SI LE PRISME CONTIENT UN POINT (ET EST |
  11. C DONC INVALIDE) |
  12. C |
  13. C---------------------------------------------------------------------|
  14. C
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. -INC CCOPTIO
  18. -INC TDEMAIT
  19. LOGICAL FACET2,vervol
  20. C
  21. C CHERCHER SI LES FACETTES SONT NOUVELLES OU ANCIENNES
  22. dimension ift(5)
  23. ift(1)=if1
  24. ift(2)=if2
  25. ift(3)=if3
  26. ift(4)=if4
  27. ift(5)=if5
  28. N1=-1
  29. N2=-1
  30. N3=-1
  31. N4=-1
  32. N5=-1
  33. IF (IFAT(IF1).NE.0) N1=1
  34. IF (IFAT(IF2).NE.0) N2=1
  35. IF (IFAT(IF3).NE.0) N3=1
  36. IF (IFAT(IF4).NE.0) N4=1
  37. IF (IFAT(IF5).NE.0) N5=1
  38. * encadrer l'hexaedre
  39. xmin=1e30
  40. xmax=-1e30
  41. ymin=1e30
  42. ymax=-1e30
  43. zmin=1e30
  44. zmax=-1e30
  45. do 92 j=1,5
  46. do 90 i=1,3
  47. xmin=min(xmin,xyz(1,nfc(i,ift(j))))
  48. xmax=max(xmax,xyz(1,nfc(i,ift(j))))
  49. ymin=min(ymin,xyz(2,nfc(i,ift(j))))
  50. ymax=max(ymax,xyz(2,nfc(i,ift(j))))
  51. zmin=min(zmin,xyz(3,nfc(i,ift(j))))
  52. zmax=max(zmax,xyz(3,nfc(i,ift(j))))
  53. 90 continue
  54. 92 continue
  55. iteste=0
  56. * DO 100 I=1,NPTMAX
  57. DO 100 I=1,0
  58. IF (NPF(1,I).EQ.0) GOTO 100
  59. DO 110 J=1,4
  60. IF (I.EQ.NFC(J,IF1)) GOTO 100
  61. IF (I.EQ.NFC(J,IF2)) GOTO 100
  62. IF (I.EQ.NFC(J,IF3)) GOTO 100
  63. IF (I.EQ.NFC(J,IF4)) GOTO 100
  64. IF (I.EQ.NFC(J,IF5)) GOTO 100
  65. 110 CONTINUE
  66. if (iteste.ne.0) then
  67. if (xyz(1,i).lt.xmin.or.xyz(1,i).gt.xmax) goto 100
  68. if (xyz(2,i).lt.ymin.or.xyz(2,i).gt.ymax) goto 100
  69. if (xyz(3,i).lt.zmin.or.xyz(3,i).gt.zmax) goto 100
  70. endif
  71. iteste=1
  72. C
  73. V1=N1*VOL(I,NFC(1,IF1),NFC(2,IF1),NFC(3,IF1))
  74. V2=N1*VOL(I,NFC(1,IF1),NFC(3,IF1),NFC(4,IF1))
  75. V3=N2*VOL(I,NFC(1,IF2),NFC(2,IF2),NFC(3,IF2))
  76. V4=N2*VOL(I,NFC(1,IF2),NFC(3,IF2),NFC(4,IF2))
  77. V5=N3*VOL(I,NFC(1,IF3),NFC(2,IF3),NFC(3,IF3))
  78. V6=N4*VOL(I,NFC(1,IF4),NFC(2,IF4),NFC(3,IF4))
  79. V7=N5*VOL(I,NFC(1,IF5),NFC(2,IF5),NFC(3,IF5))
  80. V8=N5*VOL(I,NFC(1,IF5),NFC(3,IF5),NFC(4,IF5))
  81. VV=V1+V2+V3+V4+V5+V6+V7+V8
  82. IF (VV.LE.0.) then
  83. if (IVERB.EQ.1) write (6,*) ' prisme volume negatif '
  84. GOTO 120
  85. endif
  86. IF (V1.LE.-0.01*VV) GOTO 100
  87. IF (V2.LE.-0.01*VV) GOTO 100
  88. IF (V3.LE.-0.01*VV) GOTO 100
  89. IF (V4.LE.-0.01*VV) GOTO 100
  90. IF (V5.LE.-0.01*VV) GOTO 100
  91. IF (V6.LE.-0.01*VV) GOTO 100
  92. IF (V7.LE.-0.01*VV) GOTO 100
  93. IF (V8.LE.-0.01*VV) GOTO 100
  94. GOTO 120
  95. C
  96. 100 CONTINUE
  97. C
  98. C IL N'EXISTE PAS DE POINTS INTERNES AU VOLUME
  99. SOLPRI=.TRUE.
  100. C RAJOUT PV TEST INTERSECTION DES FACETTES
  101. IF (N1.EQ.1) SOLPRI=SOLPRI.AND.FACET2(IF1)
  102. IF (N2.EQ.1) SOLPRI=SOLPRI.AND.FACET2(IF2)
  103. IF (N3.EQ.1) SOLPRI=SOLPRI.AND.FACET2(IF3)
  104. IF (N4.EQ.1) SOLPRI=SOLPRI.AND.FACET2(IF4)
  105. IF (N5.EQ.1) SOLPRI=SOLPRI.AND.FACET2(IF5)
  106. IF (.NOT.SOLPRI.AND.IVERB.EQ.1)
  107. & WRITE (6,*) ' SOLPRI INTERSECTION TROUVEE'
  108. C
  109. C on teste maintenant qu'on ne recouvre pas un autre volume
  110. ip1=nfc(1,if3)
  111. ip2=nfc(2,if3)
  112. ip3=nfc(3,if3)
  113. ip4=nfc(1,if4)
  114. ip5=nfc(2,if4)
  115. ip6=nfc(3,if4)
  116. * write (6,*) ' solpyr sommets ',ip1,ip2,ip3,ip4,ip5
  117. * write (6,*) ' solpyr coordonnees '
  118. * write (6,*) xyz(1,ip1),xyz(2,ip1),xyz(3,ip1)
  119. * write (6,*) xyz(1,ip2),xyz(2,ip2),xyz(3,ip2)
  120. * write (6,*) xyz(1,ip3),xyz(2,ip3),xyz(3,ip3)
  121. * write (6,*) xyz(1,ip4),xyz(2,ip4),xyz(3,ip4)
  122. * write (6,*) xyz(1,ip5),xyz(2,ip5),xyz(3,ip5)
  123. xbar=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip4)+
  124. * xyz(1,ip5)+xyz(1,ip6))/6.
  125. ybar=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip4)+
  126. * xyz(2,ip5)+xyz(2,ip6))/6.
  127. zbar=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip4)+
  128. * xyz(3,ip5)+xyz(3,ip6))/6.
  129. * write (6,*) ' bary ',xbar,ybar,zbar
  130. xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3))/3.
  131. yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3))/3
  132. zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3))/3.
  133. xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  134. xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  135. xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  136. solpri=solpri.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,-1,-1)
  137. if (.not.solpri) return
  138. xfac=(xyz(1,ip4)+xyz(1,ip5)+xyz(1,ip6))/3.
  139. yfac=(xyz(2,ip4)+xyz(2,ip5)+xyz(2,ip6))/3
  140. zfac=(xyz(3,ip4)+xyz(3,ip5)+xyz(3,ip6))/3.
  141. xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  142. xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  143. xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  144. solpri=solpri.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,-1,-1)
  145. if (.not.solpri) return
  146. ip1=nfc(1,if1)
  147. ip2=nfc(2,if1)
  148. ip3=nfc(3,if1)
  149. ip4=nfc(4,if1)
  150. xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  151. yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  152. zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  153. xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  154. xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  155. xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  156. solpri=solpri.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,-1,-1)
  157. if (.not.solpri) return
  158. ip1=nfc(1,if2)
  159. ip2=nfc(2,if2)
  160. ip3=nfc(3,if2)
  161. ip4=nfc(4,if2)
  162. xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  163. yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  164. zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  165. xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  166. xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  167. xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  168. solpri=solpri.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,-1,-1)
  169. if (.not.solpri) return
  170. ip1=nfc(1,if5)
  171. ip2=nfc(2,if5)
  172. ip3=nfc(3,if5)
  173. ip4=nfc(4,if5)
  174. xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  175. yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  176. zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  177. xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  178. xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  179. xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  180. solpri=solpri.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,-1,-1)
  181. if (.not.solpri) return
  182. RETURN
  183. C
  184. 120 CONTINUE
  185. C LE POINT I EST INTERNE AU VOLUME
  186. WRITE(6,1010)I
  187. 1010 FORMAT(' LE POINT ',I5,' EST INTERNE AU prisme CREE |')
  188. IF (IVERB.EQ.1) write (6,*) xyz(1,i),xyz(2,i),xyz(3,i)
  189. SOLPRI=.FALSE.
  190. RETURN
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  

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