Télécharger vervol.eso

Retour à la liste

Numérotation des lignes :

  1. C VERVOL SOURCE JC220346 16/11/29 21:15:40 9221
  2. C verification que le pt ip n'est pas dans un volume
  3. C ayant une arete ipi ipj
  4. C
  5. LOGICAL FUNCTION VERVOL(IPT,IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. -INC CCOPTIO
  9. -INC TDEMAIT
  10. dimension ipp(8),ivtemp(50)
  11. np=0
  12. if (ip1.gt.0) then
  13. np=np+1
  14. ipp(np)=ip1
  15. endif
  16. if (ip2.gt.0) then
  17. np=np+1
  18. ipp(np)=ip2
  19. endif
  20. if (ip3.gt.0) then
  21. np=np+1
  22. ipp(np)=ip3
  23. endif
  24. if (ip4.gt.0) then
  25. np=np+1
  26. ipp(np)=ip4
  27. endif
  28. if (ip5.gt.0) then
  29. np=np+1
  30. ipp(np)=ip5
  31. endif
  32. if (ip6.gt.0) then
  33. np=np+1
  34. ipp(np)=ip6
  35. endif
  36. if (ip7.gt.0) then
  37. np=np+1
  38. ipp(np)=ip7
  39. endif
  40. if (ip8.gt.0) then
  41. np=np+1
  42. ipp(np)=ip8
  43. endif
  44. vervol=.true.
  45. * return
  46. *
  47. * boucle sur les elements
  48. *
  49. nvt=0
  50. do 9 iq=1,np
  51. ip=ipp(iq)
  52. do 9 ipf=1,40
  53. if=npf(ipf,iq)
  54. if (if.eq.0) goto 5
  55. do 6 ifv=1,2
  56. iv=nfv(ifv,if)
  57. if (iv.eq.0) goto 9
  58. do 8 ivt=1,nvt
  59. if (ivtemp(ivt).eq.iv) goto 7
  60. 8 continue
  61. nvt=nvt+1
  62. ivtemp(nvt)=iv
  63. 7 continue
  64. 6 continue
  65. 5 continue
  66. 9 continue
  67. do 10 ivt=1,nvt
  68. iv=ivtemp(ivt)
  69. it=0
  70. do 20 ip=1,8
  71. if (ivol(ip,iv).eq.ip1) it=it+1
  72. if (ivol(ip,iv).eq.ip2) it=it+1
  73. if (ivol(ip,iv).eq.ip3) it=it+1
  74. if (ivol(ip,iv).eq.ip4) it=it+1
  75. if (ivol(ip,iv).eq.ip5) it=it+1
  76. if (ivol(ip,iv).eq.ip6) it=it+1
  77. if (ivol(ip,iv).eq.ip7) it=it+1
  78. if (ivol(ip,iv).eq.ip8) it=it+1
  79. 20 continue
  80. if (it.lt.2) goto 10
  81. * l'element a 2 pt commun avec le notre ==> test supplementaire
  82. * cas du tetraedre
  83. if (ivol(9,iv).eq.25) then
  84. v1=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(3,iv))
  85. v2=vol(ipt,ivol(2,iv),ivol(1,iv),ivol(4,iv))
  86. v3=vol(ipt,ivol(3,iv),ivol(2,iv),ivol(4,iv))
  87. v4=vol(ipt,ivol(1,iv),ivol(3,iv),ivol(4,iv))
  88. vv=v1+v2+v3+v4
  89. * write (6,*) ' vervol vv v1 v2 v3 v4 ',vv,v1,v2,v3,v4
  90. if (vv*v1.gt.0..and.vv*v2.gt.0..and.vv*v3.gt.0..and.
  91. * vv*v4.gt.0.) vervol=.false.
  92. endif
  93. if (.not.vervol) then
  94. * write (6,*) ' vervol element incorrect tetraedre'
  95. * write (6,*) ' vervol point teste ',ipt
  96. * write (6,*) xyz(1,ipt),xyz(2,ipt),xyz(3,ipt)
  97. ipv=ivol(1,iv)
  98. * write (6,*) ' pt du volume ',ipv
  99. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  100. ipv=ivol(2,iv)
  101. * write (6,*) ' pt du volume ',ipv
  102. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  103. ipv=ivol(3,iv)
  104. * write (6,*) ' pt du volume ',ipv
  105. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  106. ipv=ivol(4,iv)
  107. * write (6,*) ' pt du volume ',ipv
  108. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  109. return
  110. endif
  111. * cas de la pyramide
  112. if (ivol(9,iv).eq.35) then
  113. v1=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(3,iv))
  114. v2=vol(ipt,ivol(1,iv),ivol(3,iv),ivol(4,iv))
  115. v3=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(4,iv))
  116. v4=vol(ipt,ivol(2,iv),ivol(3,iv),ivol(4,iv))
  117.  
  118. v5=vol(ipt,ivol(2,iv),ivol(1,iv),ivol(5,iv))
  119. v6=vol(ipt,ivol(3,iv),ivol(2,iv),ivol(5,iv))
  120. v7=vol(ipt,ivol(4,iv),ivol(3,iv),ivol(5,iv))
  121. v8=vol(ipt,ivol(1,iv),ivol(4,iv),ivol(5,iv))
  122. vv=v1+v2+v3+v4+v5+v6+v7+v8
  123. if (vv*v1.gt.0..and.vv*v2.gt.0..and.vv*v3.gt.0..and.
  124. * vv*v4.gt.0..and.vv*v5.gt.0..and.vv*v6.gt.0..and.
  125. * vv*v7.gt.0..and.vv*v8.gt.0.) vervol=.false.
  126. endif
  127. if (.not.vervol) then
  128. * write (6,*) ' vervol element incorrect pyramide'
  129. * write (6,*) xyz(1,ipt),xyz(2,ipt),xyz(3,ipt)
  130. ipv=ivol(1,iv)
  131. * write (6,*) ' pt du volume ',ipv
  132. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  133. ipv=ivol(2,iv)
  134. * write (6,*) ' pt du volume ',ipv
  135. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  136. ipv=ivol(3,iv)
  137. * write (6,*) ' pt du volume ',ipv
  138. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  139. ipv=ivol(4,iv)
  140. * write (6,*) ' pt du volume ',ipv
  141. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  142. ipv=ivol(5,iv)
  143. * write (6,*) ' pt du volume ',ipv
  144. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  145. return
  146. endif
  147. * cas du prisme
  148. if (ivol(9,iv).eq.30) then
  149. v1=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(3,iv))
  150.  
  151. v2=vol(ipt,ivol(1,iv),ivol(4,iv),ivol(5,iv))
  152. v3=vol(ipt,ivol(1,iv),ivol(5,iv),ivol(2,iv))
  153. v4=vol(ipt,ivol(1,iv),ivol(4,iv),ivol(2,iv))
  154. v5=vol(ipt,ivol(4,iv),ivol(5,iv),ivol(2,iv))
  155.  
  156. v6=vol(ipt,ivol(2,iv),ivol(5,iv),ivol(6,iv))
  157. v7=vol(ipt,ivol(2,iv),ivol(6,iv),ivol(3,iv))
  158. v8=vol(ipt,ivol(2,iv),ivol(5,iv),ivol(3,iv))
  159. v9=vol(ipt,ivol(5,iv),ivol(6,iv),ivol(3,iv))
  160.  
  161. v10=vol(ipt,ivol(3,iv),ivol(6,iv),ivol(4,iv))
  162. v11=vol(ipt,ivol(3,iv),ivol(4,iv),ivol(1,iv))
  163. v12=vol(ipt,ivol(3,iv),ivol(6,iv),ivol(1,iv))
  164. v13=vol(ipt,ivol(4,iv),ivol(1,iv),ivol(2,iv))
  165.  
  166. v14=vol(ipt,ivol(6,iv),ivol(5,iv),ivol(4,iv))
  167. vv=v1+v2+v3+v4+v5+v6+v7+v8+v9+v10+v11+v12+v13+v14
  168. if (vv*v1.gt.0..and.vv*v2.gt.0..and.vv*v3.gt.0..and.
  169. * vv*v4.gt.0..and.vv*v5.gt.0..and.vv*v6.gt.0..and.
  170. * vv*v7.gt.0..and.vv*v8.gt.0..and.vv*v9.gt.0..and.
  171. * vv*v10.gt.0..and.vv*v11.gt.0..and.vv*v12.gt.0..and.
  172. * vv*v13.gt.0..and.vv*v14.gt.0.) vervol=.false.
  173. endif
  174. if (.not.vervol) then
  175. * write (6,*) ' vervol element incorrect prisme '
  176. * write (6,*) ' vervol point teste ',ipt
  177. IF (IVERB.EQ.1) write (6,*) xyz(1,ipt),xyz(2,ipt),xyz(3,ipt)
  178. ipv=ivol(1,iv)
  179. * write (6,*) ' pt du volume ',ipv
  180. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  181. ipv=ivol(2,iv)
  182. * write (6,*) ' pt du volume ',ipv
  183. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  184. ipv=ivol(3,iv)
  185. * write (6,*) ' pt du volume ',ipv
  186. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  187. ipv=ivol(4,iv)
  188. * write (6,*) ' pt du volume ',ipv
  189. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  190. ipv=ivol(5,iv)
  191. * write (6,*) ' pt du volume ',ipv
  192. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  193. ipv=ivol(6,iv)
  194. * write (6,*) ' pt du volume ',ipv
  195. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  196. return
  197. endif
  198. * cas du cube
  199. if (ivol(9,iv).eq.20) then
  200. v1=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(3,iv))
  201. v2=vol(ipt,ivol(1,iv),ivol(3,iv),ivol(4,iv))
  202. v3=vol(ipt,ivol(1,iv),ivol(2,iv),ivol(4,iv))
  203. v4=vol(ipt,ivol(2,iv),ivol(3,iv),ivol(4,iv))
  204. v5=vol(ipt,ivol(1,iv),ivol(5,iv),ivol(6,iv))
  205. v6=vol(ipt,ivol(1,iv),ivol(6,iv),ivol(2,iv))
  206. v7=vol(ipt,ivol(1,iv),ivol(5,iv),ivol(2,iv))
  207. v8=vol(ipt,ivol(5,iv),ivol(6,iv),ivol(2,iv))
  208. v9=vol(ipt,ivol(2,iv),ivol(6,iv),ivol(7,iv))
  209. v10=vol(ipt,ivol(2,iv),ivol(7,iv),ivol(3,iv))
  210. v11=vol(ipt,ivol(2,iv),ivol(6,iv),ivol(3,iv))
  211. v12=vol(ipt,ivol(6,iv),ivol(7,iv),ivol(3,iv))
  212. v13=vol(ipt,ivol(3,iv),ivol(7,iv),ivol(8,iv))
  213. v14=vol(ipt,ivol(3,iv),ivol(8,iv),ivol(4,iv))
  214. v15=vol(ipt,ivol(3,iv),ivol(7,iv),ivol(4,iv))
  215. v16=vol(ipt,ivol(7,iv),ivol(8,iv),ivol(4,iv))
  216. v17=vol(ipt,ivol(4,iv),ivol(8,iv),ivol(5,iv))
  217. v18=vol(ipt,ivol(4,iv),ivol(5,iv),ivol(1,iv))
  218. v19=vol(ipt,ivol(4,iv),ivol(8,iv),ivol(1,iv))
  219. v20=vol(ipt,ivol(8,iv),ivol(5,iv),ivol(1,iv))
  220. v21=vol(ipt,ivol(5,iv),ivol(8,iv),ivol(7,iv))
  221. v22=vol(ipt,ivol(5,iv),ivol(7,iv),ivol(6,iv))
  222. v23=vol(ipt,ivol(5,iv),ivol(8,iv),ivol(6,iv))
  223. v24=vol(ipt,ivol(8,iv),ivol(7,iv),ivol(6,iv))
  224. vv=v1+v2+v3+v4+v5+v6+v7+v8+v9+v10+v11+v12+
  225. * v13+v14+v15+v16+v17+v18+v19+v20+v21+v22+v23+v24
  226. if (vv*v1.gt.0..and.vv*v2.gt.0..and.vv*v3.gt.0..and.
  227. * vv*v4.gt.0..and.vv*v5.gt.0..and.vv*v6.gt.0..and.
  228. * vv*v7.gt.0..and.vv*v8.gt.0..and.vv*v9.gt.0..and.
  229. * vv*v10.gt.0..and.vv*v11.gt.0..and.vv*v12.gt.0..and.
  230. * vv*v13.gt.0..and.vv*v14.gt.0..and.vv*v15.gt.0..and.
  231. * vv*v16.gt.0..and.vv*v17.gt.0..and.vv*v18.gt.0..and.
  232. * vv*v19.gt.0..and.vv*v20.gt.0..and.vv*v21.gt.0..and.
  233. * vv*v22.gt.0..and.vv*v23.gt.0..and.vv*v24.gt.0.)
  234. * vervol=.false.
  235. endif
  236. if (.not.vervol) then
  237. * write (6,*) ' vervol element incorrect cube'
  238. * write (6,*) ' vervol point teste ',ipt
  239. * write (6,*) xyz(1,ipt),xyz(2,ipt),xyz(3,ipt)
  240. ipv=ivol(1,iv)
  241. * write (6,*) ' pt du volume ',ipv
  242. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  243. ipv=ivol(2,iv)
  244. * write (6,*) ' pt du volume ',ipv
  245. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  246. ipv=ivol(3,iv)
  247. * write (6,*) ' pt du volume ',ipv
  248. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  249. ipv=ivol(4,iv)
  250. * write (6,*) ' pt du volume ',ipv
  251. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  252. ipv=ivol(5,iv)
  253. * write (6,*) ' pt du volume ',ipv
  254. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  255. ipv=ivol(6,iv)
  256. * write (6,*) ' pt du volume ',ipv
  257. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  258. ipv=ivol(7,iv)
  259. * write (6,*) ' pt du volume ',ipv
  260. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  261. ipv=ivol(8,iv)
  262. * write (6,*) ' pt du volume ',ipv
  263. * write (6,*) xyz(1,ipv),xyz(2,ipv),xyz(3,ipv)
  264. return
  265. endif
  266. 10 continue
  267. end
  268.  
  269.  
  270.  
  271.  

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