Télécharger la plaquette Cast3M


fr en

Télécharger solhex.eso

Retour à la liste

Numérotation des lignes : 

solhex

  1. C SOLHEX    SOURCE    PV        17/09/12    21:15:01     9542           
  2. C---------------------------------------------------------------------|
  3. C                                                                     |
  4.        LOGICAL FUNCTION SOLHEX(IF1,IF2,IF3,IF4,IF5,IF6)
  5. C                                                                     |
  6. C      CETTE FONCTION LOGIQUE TESTE SI LE HEXAEDRE DECRIT PAR LES     |
  7. C      FACETTES IF1..IF6 EST VIDE DE POINTS.                          |
  8. C    LES FACETTES SUPPRIMEES SONT ORIENTES DANS L'AUTRE SENS          |
  9. C      SOLHEX EST VRAI SI LE HEXAEDRE EST VIDE (DONC VALIDE)          |
  10. C      SOLHEX EST FAUX SI LE HEXAEDRE 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.       dimension ift(6)
  23.       ift(1)=if1
  24.       ift(2)=if2
  25.       ift(3)=if3
  26.       ift(4)=if4
  27.       ift(5)=if5
  28.       ift(6)=if6
  29. C
  30. C   CHERCHER SI LES FACETTES SONT NOUVELLES OU ANCIENNES
  31.         N1=-1
  32.         N2=-1
  33.         N3=-1
  34.         N4=-1
  35.         N5=-1
  36.         N6=-1
  37.              IF (IFAT(IF1).NE.0) N1=1
  38.              IF (IFAT(IF2).NE.0) N2=1
  39.              IF (IFAT(IF3).NE.0) N3=1
  40.              IF (IFAT(IF4).NE.0) N4=1
  41.              IF (IFAT(IF5).NE.0) N5=1
  42.              IF (IFAT(IF6).NE.0) N6=1
  43. *  encadrer l'hexaedre
  44.        xmin=1e30
  45.        xmax=-1e30
  46.        ymin=1e30
  47.        ymax=-1e30
  48.        zmin=1e30
  49.        zmax=-1e30
  50.        do 92 j=1,6
  51.        do 90 i=1,4
  52.        xmin=min(xmin,xyz(1,nfc(i,ift(j))))
  53.        xmax=max(xmax,xyz(1,nfc(i,ift(j))))
  54.        ymin=min(ymin,xyz(2,nfc(i,ift(j))))
  55.        ymax=max(ymax,xyz(2,nfc(i,ift(j))))
  56.        zmin=min(zmin,xyz(3,nfc(i,ift(j))))
  57.        zmax=max(zmax,xyz(3,nfc(i,ift(j))))
  58.   90   continue
  59.   92   continue
  60.        iteste=0
  61. *      DO 100 I=1,NPTMAX
  62.        DO 100 I=1,0
  63.           IF (NPF(1,I).EQ.0) GOTO 100
  64.           DO 110 J=1,4
  65.              IF (I.EQ.NFC(J,IF1)) GOTO 100
  66.              IF (I.EQ.NFC(J,IF2)) GOTO 100
  67.              IF (I.EQ.NFC(J,IF3)) GOTO 100
  68.              IF (I.EQ.NFC(J,IF4)) GOTO 100
  69.              IF (I.EQ.NFC(J,IF5)) GOTO 100
  70.              IF (I.EQ.NFC(J,IF6)) GOTO 100
  71. 110       CONTINUE
  72.        if (iteste.ne.0) then
  73.        if (xyz(1,i).lt.xmin.or.xyz(1,i).gt.xmax) goto 100
  74.        if (xyz(2,i).lt.ymin.or.xyz(2,i).gt.ymax) goto 100
  75.        if (xyz(3,i).lt.zmin.or.xyz(3,i).gt.zmax) goto 100
  76.        endif
  77.        iteste=1
  78. C
  79.        V1=N1*VOL(I,NFC(1,IF1),NFC(2,IF1),NFC(3,IF1))
  80.        V2=N1*VOL(I,NFC(1,IF1),NFC(3,IF1),NFC(4,IF1))
  81.  
  82.        V3=N2*VOL(I,NFC(1,IF2),NFC(2,IF2),NFC(3,IF2))
  83.        V4=N2*VOL(I,NFC(1,IF2),NFC(3,IF2),NFC(4,IF2))
  84.  
  85.        V5=N3*VOL(I,NFC(1,IF3),NFC(2,IF3),NFC(3,IF3))
  86.        V6=N3*VOL(I,NFC(1,IF3),NFC(3,IF3),NFC(4,IF3))
  87.  
  88.        V7=N4*VOL(I,NFC(1,IF4),NFC(2,IF4),NFC(3,IF4))
  89.        V8=N4*VOL(I,NFC(1,IF4),NFC(3,IF4),NFC(4,IF4))
  90.  
  91.        V9=N5*VOL(I,NFC(1,IF5),NFC(2,IF5),NFC(3,IF5))
  92.        V10=N5*VOL(I,NFC(1,IF5),NFC(3,IF5),NFC(4,IF5))
  93.  
  94.        V11=N6*VOL(I,NFC(1,IF6),NFC(2,IF6),NFC(3,IF6))
  95.        V12=N6*VOL(I,NFC(1,IF6),NFC(3,IF6),NFC(4,IF6))
  96.        VV=V1+V2+V3+V4+V5+V6+V7+V8+V9+V10+V11+V12
  97.        IF (VV.LE.0) then
  98.         if(IVERB.EQ.1) write (6,*) ' cube volume negatif '
  99.         GOTO 120
  100.        endif
  101.        IF (V1.LE.-0.01*VV) GOTO 100
  102.        IF (V2.LE.-0.01*VV) GOTO 100
  103.        IF (V3.LE.-0.01*VV) GOTO 100
  104.        IF (V4.LE.-0.01*VV) GOTO 100
  105.        IF (V5.LE.-0.01*VV) GOTO 100
  106.        IF (V6.LE.-0.01*VV) GOTO 100
  107.        IF (V7.LE.-0.01*VV) GOTO 100
  108.        IF (V8.LE.-0.01*VV) GOTO 100
  109.        IF (V9.LE.-0.01*VV) GOTO 100
  110.        IF (V10.LE.-0.01*VV) GOTO 100
  111.        IF (V11.LE.-0.01*VV) GOTO 100
  112.        IF (V12.LE.-0.01*VV) GOTO 100
  113.        GOTO 120
  114. C
  115. 100    CONTINUE
  116. C
  117. C      IL N'EXISTE PAS DE POINTS INTERNES AU VOLUME
  118.        SOLHEX=.TRUE.
  119. C  RAJOUT PV TEST INTERSECTION DES FACETTES
  120.        IF (N1.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF1)
  121.        IF (N2.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF2)
  122.        IF (N3.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF3)
  123.        IF (N4.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF4)
  124.        IF (N5.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF5)
  125.        IF (N6.EQ.1) SOLHEX=SOLHEX.AND.FACET2(IF6)
  126.        IF (.NOT.SOLHEX.AND.IVERB.EQ.1)
  127.      &       WRITE (6,*) ' SOLHEX INTERSECTION TROUVEE'
  128. C  on teste maintenant qu'on ne recouvre pas un autre volume
  129.        ip1=nfc(1,if1)
  130.        ip2=nfc(2,if1)
  131.        ip3=nfc(3,if1)
  132.        ip4=nfc(4,if1)
  133.        ip5=nfc(1,if5)
  134.        ip6=nfc(2,if5)
  135.        ip7=nfc(3,if5)
  136.        ip8=nfc(4,if5)
  137. *      write (6,*) ' solpyr sommets ',ip1,ip2,ip3,ip4,ip5
  138. *      write (6,*) ' solpyr coordonnees '
  139. *      write (6,*) xyz(1,ip1),xyz(2,ip1),xyz(3,ip1)
  140. *      write (6,*) xyz(1,ip2),xyz(2,ip2),xyz(3,ip2)
  141. *      write (6,*) xyz(1,ip3),xyz(2,ip3),xyz(3,ip3)
  142. *      write (6,*) xyz(1,ip4),xyz(2,ip4),xyz(3,ip4)
  143. *      write (6,*) xyz(1,ip5),xyz(2,ip5),xyz(3,ip5)
  144.        xbar=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip4)+
  145.      *   xyz(1,ip5)+xyz(1,ip6)+xyz(1,ip7)+xyz(1,ip8))/8.
  146.        ybar=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip4)+
  147.      *   xyz(2,ip5)+xyz(2,ip6)+xyz(2,ip7)+xyz(2,ip8))/8.
  148.        zbar=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip4)+
  149.      *   xyz(3,ip5)+xyz(3,ip6)+xyz(3,ip7)+xyz(3,ip8))/8.
  150. *      write (6,*) ' bary ',xbar,ybar,zbar
  151.        ip1=nfc(1,if1)
  152.        ip2=nfc(2,if1)
  153.        ip3=nfc(3,if1)
  154.        ip4=nfc(4,if1)
  155.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  156.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  157.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  158.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  159.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  160.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  161.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  162.      *  ip7,ip8)
  163.        if (.not.solhex) return
  164.        ip1=nfc(1,if2)
  165.        ip2=nfc(2,if2)
  166.        ip3=nfc(3,if2)
  167.        ip4=nfc(4,if2)
  168.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  169.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  170.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  171.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  172.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  173.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  174.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  175.      *  ip7,ip8)
  176.        if (.not.solhex) return
  177.        ip1=nfc(1,if3)
  178.        ip2=nfc(2,if3)
  179.        ip3=nfc(3,if3)
  180.        ip4=nfc(4,if3)
  181.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  182.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  183.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  184.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  185.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  186.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  187.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  188.      *  ip7,ip8)
  189.        if (.not.solhex) return
  190.        ip1=nfc(1,if4)
  191.        ip2=nfc(2,if4)
  192.        ip3=nfc(3,if4)
  193.        ip4=nfc(4,if4)
  194.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  195.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  196.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  197.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  198.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  199.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  200.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  201.      *  ip7,ip8)
  202.        if (.not.solhex) return
  203.        ip1=nfc(1,if5)
  204.        ip2=nfc(2,if5)
  205.        ip3=nfc(3,if5)
  206.        ip4=nfc(4,if5)
  207.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  208.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  209.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  210.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  211.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  212.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  213.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  214.      *  ip7,ip8)
  215.        if (.not.solhex) return
  216.        ip1=nfc(1,if6)
  217.        ip2=nfc(2,if6)
  218.        ip3=nfc(3,if6)
  219.        ip4=nfc(4,if6)
  220.        xfac=(xyz(1,ip1)+xyz(1,ip2)+xyz(1,ip3)+xyz(1,ip3))/4.
  221.        yfac=(xyz(2,ip1)+xyz(2,ip2)+xyz(2,ip3)+xyz(2,ip3))/4.
  222.        zfac=(xyz(3,ip1)+xyz(3,ip2)+xyz(3,ip3)+xyz(3,ip3))/4.
  223.        xyz(1,nptmax+1)=xfac+0.1*(xbar-xfac)
  224.        xyz(2,nptmax+1)=yfac+0.1*(ybar-yfac)
  225.        xyz(3,nptmax+1)=zfac+0.1*(zbar-zfac)
  226.        solhex=solhex.and.vervol(nptmax+1,ip1,ip2,ip3,ip4,ip5,ip6,
  227.      *  ip7,ip8)
  228.        if (.not.solhex) return
  229.        RETURN
  230. C
  231. 120    CONTINUE
  232. C      LE POINT I EST INTERNE AU VOLUME
  233.        IF (IVERB.EQ.1) WRITE(6,1010)I
  234.  1010   FORMAT(' LE POINT ',I5,' EST INTERNE AU cube CREE |')
  235.         IF (IVERB.EQ.1) write (6,*) xyz(1,i),xyz(2,i),xyz(3,i)
  236.        SOLHEX=.FALSE.
  237.        RETURN
  238.        END
  239.  
  240.  
  241.  
  242.  
  243.  

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