Télécharger la plaquette Cast3M


fr en

Télécharger vervol.eso

Retour à la liste

Numérotation des lignes : 

vervol

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

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