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

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