Télécharger la plaquette Cast3M


fr en

Télécharger tiret3.eso

Retour à la liste

Numérotation des lignes : 

tiret3

  1. C TIRET3    SOURCE    PV        22/04/19    16:18:14     11344          
  2. C    NOUVELLE VERSION DE TIRET
  3. C    LA BOUCLE SE FAIT SUR LES ELEMENTS ET NON PLUS SUR LES NOEUDS
  4. C    CETTE VERSION EST ADAPTEE A GIBI
  5. C
  6.       SUBROUTINE TIRET3(XPROJ,MELEME,ICPR,XMIN,XMAX,YMIN,YMAX,IVU,NELEM,
  7.      # TMIN,TMAX,MCOUP)
  8. C   NUMNP   NOMBRE DE POINTS A TRACER
  9. C   NBELEM  NOMBRE D'ELEMENTS DANS L'OBJET ELEMENTAIRE
  10. C   MCOUP <>0 => COUPE LA PLAN DE COUPE EST DANS LA DERNIERE
  11. C   COMPOSANTE DE MELEME ET SES NOEUDS SONT VUS
  12.       IMPLICIT INTEGER(I-N)
  13. C
  14. C     TABLEAUX : KTR    TRIANGLES PAR ELEMENTS
  15. C                KTL    NOMBRE DE TRIANGLES PAR ELEM
  16. C                NPZON  ZONE A LAQUELLE APPARTIENT UN POINT
  17. C                INDZON POINTEUR SUR NPOIN
  18. C                NPOIN  TABLEAU DES POINTS CLASSES
  19. C                IVU    TABLEAU VU PAS VU (POINT)
  20. C
  21. C-----------------------------------------------------------------------
  22. C
  23. C   SEGMENTS
  24. C
  25.       SEGMENT/XPROJ/(X(3,ITE))
  26.       SEGMENT IVU(NUMNP)
  27.       SEGMENT ICPR(0)
  28.       SEGMENT/TRAV/(NTAUX(NUMNP),INDZON(NUMNP+2),NPZON(NUMNP+2),
  29.      #   IJK(NUMNP+2),NPOIN(NUMNP+2))
  30.       SEGMENT MCOUP(0)
  31.       REAL   XMIN,XMAX,YMIN,YMAX
  32. C
  33. C-----------------------------------------------------------------------
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC CCGEOME
  38. -INC CCREEL
  39. *-
  40. -INC SMELEME
  41.  
  42.       NMULT=3
  43.       SEGACT ICPR
  44.       NUMNP=X(/2)
  45.       NUPLUS=NUMNP+1
  46. *     CALL LIRENT(NMULT,0,IRETOU)  GENANT EN FULLSCREEN
  47. *     IF (IRETOU.EQ.1) NMULT=MAX(1,NMULT)
  48.       SEGINI TRAV
  49. C   INITIALISATION DE L'HORLOGE
  50.       XDIST=XMAX-XMIN
  51.       YDIST=YMAX-YMIN
  52. **    write(6,*) 'tiret3 xdist ydist ',xdist,ydist
  53. cbp : petites limitations pour les cas XDIST et/ou YDIST tres petits
  54.       if(XDIST.le.XSPETI.and.YDIST.le.XSPETI) then
  55.           XDIST=1.D0
  56.           YDIST=1.D0
  57.       elseif(XDIST.lt.(1.D-5*YDIST)) then
  58.           XDIST=1.D-5 * YDIST
  59.       elseif(YDIST.lt.(1.D-5*XDIST)) then
  60.           YDIST=1.D-5 * XDIST
  61.       endif
  62.       SMO=1E-5*XDIST*YDIST/NUMNP
  63.       SMA=1E-5*(XDIST*YDIST/NUMNP)**1.5
  64. C   CALCUL DU DECOUPAGE EN ZONE
  65.       NBZONE=NUMNP*NMULT
  66.       RAP=YDIST/XDIST
  67.       NDEC=MAX(INT(SQRT(REAL(NBZONE)/RAP)),1)
  68.       MDEC=NBZONE/NDEC
  69.       NBZONE=NDEC*MDEC
  70.       IF (IIMPI.NE. 0) WRITE (IOIMP,8933) NDEC,MDEC,NBZONE
  71.  8933 FORMAT(' DECOUPAGE EN X ',I6,' EN Y ',I6,' SOIT ',I8,'ZONES ')
  72.       XDEC=XDIST/NDEC*1.00001
  73.       YDEC=YDIST/MDEC*1.00001
  74.       IF (IIMPI.NE. 0) WRITE (IOIMP,8935) XMIN,XMAX,YMIN,YMAX,XDEC,YDEC
  75.  8935 FORMAT (' XMIN,XMAX,YMIN,YMAX,XDEC,YDEC ',6G12.5)
  76. C  CLASSEMENT DES POINTS
  77.       DO 40 I=1,NUPLUS+1
  78.         INDZON(I)=0
  79.         IJK(I)=0
  80.   40  CONTINUE
  81.       DO 2 I=1,NUMNP
  82.       IZONE=INT(real((X(1,I)-XMIN)/XDEC))+1+
  83.      & INT(real((X(2,I)-YMIN)/YDEC))*NDEC
  84.       if(izone.lt.1) then
  85. **     write(6,*) 'tiret3 izone xmin xdec x',xmin,xdec,x(1,i)
  86.       endif
  87.  
  88.  
  89.  
  90.       NTAUX(I)=IZONE
  91.       IPOINT=IZONE/NMULT+1
  92.       INDZON(IPOINT)=INDZON(IPOINT)+1
  93.    2  CONTINUE
  94. C   INDZON= NB DE POINTS PAR SUPER-ZONE DE CLASSEMENT
  95.       DO 4 I=2,NUPLUS
  96.         INDZON(I)=INDZON(I-1)+INDZON(I)
  97.    4  CONTINUE
  98. C   INDZON(I)=FIN DE SUPER-ZONE I
  99. C   RANGEMENT DES POINTS PAR SUPER-ZONE
  100.       NBPOIN=INDZON(NUPLUS)
  101.       INDZON(NUPLUS+1)=NBPOIN
  102.       DO 5 I=1,NUMNP
  103.       IZONE=NTAUX(I)
  104.       IPOINT=IZONE/NMULT+1
  105.       IAD=INDZON(IPOINT)
  106.       NPZON(IAD)=I
  107.       INDZON(IPOINT)=IAD-1
  108.    5  CONTINUE
  109. C  TRI DANS CHAQUE SUPER-ZONE
  110. C  INDZON(I+1) EST DEVENU LA FIN DE SUPER-ZONE I
  111.       DO 6 I=1,NUPLUS
  112.       IDEB=INDZON(I)+1
  113.       IFIN=INDZON(I+1)
  114.       IF (IDEB.GT.IFIN) GOTO 6
  115. C  IL FAUT ORDONNER NPZON SUIVANT NTAUX ET METTRE LE RESULTAT DANS NPOIN
  116.       IJK(1)=IDEB
  117.       IJK(2)=IFIN
  118.       IZ=2
  119.    8  IZ=IZ-1
  120.       IF (IZ.LE.0) GOTO 9
  121.       IPB=IJK(IZ*2-1)
  122.       IPH=IJK(IZ*2)
  123.       IF (IPB.GE.IPH) GOTO 8
  124.       JPB=IPB-1
  125.       JPH=IPH+1
  126. C   CALCUL DU PIVOT
  127.       IPV=0
  128.       DO 7 J=IPB,IPH
  129.       IPV=IPV+NTAUX(NPZON(J))
  130.    7  CONTINUE
  131.       IPV=IPV/(IPH-IPB+1)
  132.   42  JPB=JPB+1
  133.       IF (JPH.EQ.JPB) GOTO 45
  134.       IF (NTAUX(NPZON(JPB)).GE.IPV) GOTO 43
  135.       GOTO 42
  136.   43  JPH=JPH-1
  137.       IF (JPH.EQ.JPB) GOTO 45
  138.       IF (NTAUX(NPZON(JPH)).LE.IPV) GOTO 44
  139.       GOTO 43
  140.   44  IAUX=NPZON(JPB)
  141. C  CORRECTION JPH AU LIEU DE IPH
  142.       NPZON(JPB)=NPZON(JPH)
  143.       NPZON(JPH)=IAUX
  144.       GOTO 42
  145. C   JPH=JPB MAIS ATTENTION PEUT ETRE A L'EXTERIEUR
  146.   45  IF (JPB.GE.IPB) GOTO 47
  147.       JPB=JPB+1
  148.       JPH=JPH+2
  149.       GOTO 48
  150.   47  IF (JPH.LE.IPH) GOTO 49
  151.       JPB=JPB-2
  152.       JPH=JPH-1
  153.       GOTO 48
  154.   49  IF (NTAUX(NPZON(JPB)).GE.IPV) GOTO 50
  155.       IF (JPH.EQ.IPH) GOTO 51
  156.   52  JPH=JPH+1
  157.       GOTO 48
  158.   50  IF (JPB.EQ.IPB) GOTO 52
  159.   51  JPB=JPB-1
  160.   48  IF (JPB.EQ.IPB) GOTO 53
  161.       IJK(2*IZ)=JPB
  162.       IZ=IZ+1
  163.   53  IF (JPH.EQ.IPH) GOTO 8
  164.       IJK(2*IZ)=IPH
  165.       IJK(2*IZ-1)=JPH
  166.       IZ=IZ+1
  167.       GOTO 8
  168.    9  CONTINUE
  169.       DO 46 J=IDEB,IFIN
  170.       NPOIN(J)=NPZON(J)
  171.   46  CONTINUE
  172.    6  CONTINUE
  173. C  REMPLISSAGE DE NPZON
  174.       DO 41 I=1,NUMNP
  175.         NPZON(I)=NTAUX(NPOIN(I))
  176.   41  CONTINUE
  177. C#      TMIN=XGRAND
  178.       TMIN=XSGRAN
  179.       TMAX=0.
  180.       DO 30 I=1,NUMNP
  181.       TMIN=MIN(TMIN,X(3,I))
  182.       TMAX=MAX(TMAX,X(3,I))
  183.    30 CONTINUE
  184.       TDIST=(TMAX-TMIN)/NUMNP*1.00001
  185. C   ATTENTION PAS DE CLASSEMENT DES ELEMENTS SELON LA DISTANCE
  186. C   REMPLISSAGE DE INDZON
  187.       NBZOR=NBZONE/NMULT+1
  188.       DO 23 I=1,NBZOR+1
  189.         INDZON(I)=0
  190.   23  CONTINUE
  191.       DO 21 I=1,NUMNP
  192.       NPOS=NPZON(I)/NMULT+1
  193.       IF (INDZON(NPOS).EQ.0) INDZON(NPOS)=I
  194.   21  CONTINUE
  195.       INDZON(NBZOR+1)=NUMNP
  196.       DO 35 I=1,NBZOR
  197.       II=NBZOR+1-I
  198.       IF (INDZON(II).EQ.0) INDZON(II)=INDZON(II+1)
  199.   35  CONTINUE
  200. C   ON COMPTE LES ELEMENTS
  201.       NELEM=0
  202.       IPT1=MELEME
  203.       SEGACT MELEME
  204.       DO 3101 IOB=1,MAX(1,LISOUS(/1))
  205.       IF (LISOUS(/1).NE.0) THEN
  206.        IPT1=LISOUS(IOB)
  207.        SEGACT IPT1
  208.       ENDIF
  209.       NELEM=NELEM+IPT1.NUM(/2)
  210.  3101 CONTINUE
  211. C   MODIF JUIN 1986 IVU=2 POUR LES POINTS DU PLAN DE COUPE (NON CACHABLE
  212.       IF (MCOUP.NE.0) THEN
  213.       IPT1=LISOUS(LISOUS(/1))
  214.       DO 3200 IEL=1,IPT1.NUM(/2)
  215.        IF (MOD(MCOUP(IEL)/8,2).EQ.0) GOTO 3200
  216.       DO 3201 JNN=1,IPT1.NUM(/1)
  217.        IVU(ICPR(IPT1.NUM(JNN,IEL)))=2
  218.  3201 CONTINUE
  219.  3200 CONTINUE
  220.       ENDIF
  221. C
  222. C   FIN DES PREPARATIFS
  223. C  MAINTENANT ON PEUT TRAVAILLER
  224. C  ON BOUCLE SUR LES ELEMENTS EN CACHANT TOUT CE QUI DOIT ETRE CACHE
  225. C
  226. C  ON TRAVAILLE PAR OBJET ELEMENTAIRE
  227.       IPT1=MELEME
  228.       DO 3001 IOB=1,MAX(1,LISOUS(/1))
  229.       IF (LISOUS(/1).NE.0) IPT1=LISOUS(IOB)
  230.       SEGACT IPT1
  231.       IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 3004
  232.       NBELEM=IPT1.NUM(/2)
  233.       NBNN=IPT1.NUM(/1)
  234.       NBFAC=LTEL(1,IPT1.ITYPEL)
  235.       IAD=LTEL(2,IPT1.ITYPEL)-1
  236.       IF (NBFAC.EQ.0) GOTO 3004
  237.       DO 101 IFAC=1,NBFAC
  238.       ITYP=LDEL(1,IAD+IFAC)
  239.       NPFAC=KDFAC(1,ITYP)
  240.       JAD=LDEL(2,IAD+IFAC)-1
  241.       IDEP=KDFAC(2,ITYP)
  242.       IFEP=IDEP+3*(KDFAC(3,ITYP)-1)
  243.       DO 1011 ITRIAN=IDEP,IFEP,3
  244.       IAFA=LFAC(JAD+KFAC(ITRIAN))
  245.       IBFA=LFAC(JAD+KFAC(ITRIAN+1))
  246.       ICFA=LFAC(JAD+KFAC(ITRIAN+2))
  247.       DO 110 IEL=1,NBELEM
  248.       IA=ICPR(IPT1.NUM(IAFA,IEL))
  249.       IB=ICPR(IPT1.NUM(IBFA,IEL))
  250.       IC=ICPR(IPT1.NUM(ICFA,IEL))
  251.       IF (IVU(IA).LT.1.AND.IVU(IB).LT.1.AND.IVU(IC).LT.1) GOTO 110
  252.       XA=X(1,IA)
  253.       XB=X(1,IB)
  254.       XC=X(1,IC)
  255.       YA=X(2,IA)
  256.       YB=X(2,IB)
  257.       YC=X(2,IC)
  258.       IZA=INT(real((XA-XMIN)/XDEC))+1+INT(real((YA-YMIN)/YDEC))*NDEC
  259.       IZB=INT(real((XB-XMIN)/XDEC))+1+INT(real((YB-YMIN)/YDEC))*NDEC
  260.       IZC=INT(real((XC-XMIN)/XDEC))+1+INT((real(YC-YMIN)/YDEC))*NDEC
  261.       ZA=X(3,IA)
  262.       ZB=X(3,IB)
  263.       ZC=X(3,IC)
  264.       DISTLI=MIN(ZA,ZB,ZC)
  265.       DISTLS=MAX(ZA,ZB,ZC)
  266. C  DECOUPONS LE TRIANGLE IA,IB,IC EN BANDELETTES DE ZONES
  267.       IRETO = 0
  268. C CLASSEMENT DE A B C
  269.       IF (IZA.LE.IZB) GOTO 200
  270.       IAUX=IZA
  271.       IZA=IZB
  272.       IZB=IAUX
  273.       IAUX=IA
  274.       IA=IB
  275.       IB=IAUX
  276.  200  IF(IZA.LE.IZC) GOTO 201
  277.       IAUX=IZA
  278.       IZA=IZC
  279.       IZC=IAUX
  280.       IAUX=IA
  281.       IA=IC
  282.       IC=IAUX
  283. C  IA EST LE POINT LE PLUS BAS
  284.  201  MIA=(IZA-1)/NDEC
  285.       NIA=IZA-MIA*NDEC
  286.       MIB=(IZB-1)/NDEC
  287.       NIB=IZB-MIB*NDEC
  288.       MIC=(IZC-1)/NDEC
  289.       NIC=IZC-MIC*NDEC
  290.       IF (MIA.EQ.MIB) GOTO 300
  291.       IF (MIA.NE.MIC) GOTO 202
  292.       IAUX=IZB
  293.       IZB=IZC
  294.       IZC=IAUX
  295.       IAUX=IB
  296.       IB=IC
  297.       IC=IAUX
  298.       IAUX=MIC
  299.       MIC=MIB
  300.       MIB=IAUX
  301.       IAUX=NIC
  302.       NIC=NIB
  303.       NIB=IAUX
  304.       GOTO 300
  305. C  AUCUN POINT N'EST DANS LA MEME BANDE QUE A
  306.  202  PENTB=REAL(NIA-NIB)/REAL(MIA-MIB)
  307.       PENTC=REAL(NIA-NIC)/REAL(MIA-MIC)
  308.       IF (PENTC.GT.PENTB) GOTO 203
  309.       IAUX=IB
  310.       IB=IC
  311.       IC=IAUX
  312.       IAUX=NIB
  313.       NIB=NIC
  314.       NIC=IAUX
  315.       IAUX=MIB
  316.       MIB=MIC
  317.       MIC=IAUX
  318.       AUX=PENTB
  319.       PENTB=PENTC
  320.       PENTC=AUX
  321. C  IB EST MAITENANT LE POINT DE GAUCHE
  322.  203  IBAND=MIA-1
  323.       ISTEP=0
  324.       IFINB=MAX(MIB,MIC)
  325.       NP=MIN(NIA,NIB)
  326.       NG=MAX(NIA,NIC)
  327.       NMP=MIN(NIB,NIC)
  328.       NMG=MAX(NIB,NIC)
  329.       IRETO = 1
  330. C*      ASSIGN 205 TO IRETO  <- DELETED
  331.       IF (MIB.EQ.MIC) GOTO 205
  332.       PENTA=REAL(NIB-NIC)/REAL(MIB-MIC)
  333.  205  IBAND=IBAND+1
  334.       IF(IBAND.GT.IFINB) GOTO 400
  335.       IF (IBAND.GT.MIB) GOTO 210
  336.       PZ=NIA+PENTB*REAL(IBAND-MIA)
  337.       IZD=INT(PZ-ABS(PENTB))
  338.       IZD1=INT(PZ+1+ABS(PENTB))
  339.       IZD=MAX(IZD,NP)
  340.       IF (IBAND.EQ.MIB.AND.ISTEP.EQ.0) GOTO 210
  341.  220  IF (IBAND.GT.MIC) GOTO 211
  342.       PZ=NIA+PENTC*REAL(IBAND-MIA)
  343.       IZF=INT(PZ+1+ABS(PENTC))
  344.       IZF1=INT(PZ-ABS(PENTC))
  345.       IZF=MIN(IZF,NG)
  346.       IF (IBAND.EQ.MIC.AND.ISTEP.EQ.0) GOTO 211
  347.       GOTO 1000
  348.  231  CONTINUE
  349.       PZ=NIA+PENTC*REAL(IBAND-MIA)
  350.       IZF=INT(PZ+1+ABS(PENTC))
  351.        IZF=MIN(IZF,NG)
  352.       GOTO 230
  353.  210  IF (IBAND.EQ.MIC.AND.ISTEP.EQ.0) GOTO 231
  354.       ISTEP=1
  355.       PZ=NIB+PENTA*REAL(IBAND-MIB)
  356.       IZD1S=INT(PZ+1+ABS(PENTA))
  357.       IZDS=INT(PZ-ABS(PENTA))
  358.       IZDS=MAX(IZDS,NMP)
  359.       IF (IBAND.EQ.MIB) IZDS=MIN(IZD,IZDS)
  360.       IF (IBAND.EQ.MIB) IZD1S=MAX(IZD1S,IZD1)
  361.       IZD=IZDS
  362.       IZD1=IZD1S
  363.       GOTO 220
  364.  211  ISTEP=1
  365.       PZ=NIB+PENTA*REAL(IBAND-MIB)
  366.       IZFS=INT(PZ+1+ABS(PENTA))
  367.       IZFS=MIN(IZFS,NMG)
  368.       IZF1S=INT(PZ-ABS(PENTA))
  369.       IF (IBAND.EQ.MIC) IZFS=MAX(IZF,IZFS)
  370.       IF (IBAND.EQ.MIC) IZF1S=MIN(IZF1,IZF1S)
  371.       IZF=IZFS
  372.       IZF1=IZF1S
  373.       GOTO 1000
  374.  230  IZD1=IZF
  375.       IZF1=IZD
  376.       IRETO = 2
  377. C*      ASSIGN 400 TO IRETO <- DELETED
  378.       GOTO 1000
  379.  300  IBAND=MIA-1
  380.       IF (MIA.EQ.MIC) GOTO 311
  381.       PENTA=REAL(NIA-NIC)/REAL(MIA-MIC)
  382.       PENTB=REAL(NIB-NIC)/REAL(MIB-MIC)
  383.       IRETO = 3
  384. C*      ASSIGN 301 TO IRETO <- DELETED
  385.       NP=MIN(NIA,NIC)
  386.       NG=MAX(NIB,NIC)
  387.  301  IBAND=IBAND+1
  388.       IF (IBAND.GT.MIC) GOTO 400
  389.       PZ=NIA+PENTA*REAL(IBAND-MIA)
  390.       IZD=INT(PZ-ABS(PENTA))
  391.       IZD1=INT(PZ+1+ABS(PENTA))
  392.       IZD=MAX(NP,IZD)
  393.       PZ=NIB+PENTB*REAL(IBAND-MIB)
  394.       IZF=INT(PZ+1+ABS(PENTB))
  395.       IZF=MIN(NG,IZF)
  396.       IZF1=INT(PZ-ABS(PENTB))
  397.       IF (IBAND.EQ.MIA) GOTO 410
  398.       GOTO 1000
  399.  410  IZD1=IZF
  400.       IZF1=IZD
  401.       GOTO 1000
  402.  311  IZD=NIA
  403.       IZF=MAX(NIB,NIC)
  404.       IBAND=MIA
  405.       IRETO = 2
  406. C*      ASSIGN 400 TO IRETO <- DELETED
  407.       GOTO 410
  408. C   BOUCLE SUR LES ZONES INTERNES AU TRIANGLE
  409. C   ON VA TRAVAILLER DANS UNE BANDE ALLANT DE IZD A IZF.
  410. C   ON SAIT PAR AILLEURS QUE LES ZONES COMPRISES ENTRE IZD1 ET IZF1 SONT
  411. C   ENTIEREMENT INSCRITE DANS LE TRIANGLE IA IB IC
  412.  1000 CONTINUE
  413.       IOORD=NDEC*IBAND
  414.       IZD=IZD+IOORD
  415.       IZD1=IZD1+IOORD
  416.       IZF=IZF+IOORD
  417.       IZF1=IZF1+IOORD
  418.       INDDEB=INDZON(IZD/NMULT+1)
  419. **      write(6,*) 'tiret3 inddeb',inddeb
  420.  
  421. C  ON SE LIMITE A CHERCHER ENTRE LE DEBUT ET LA FIN DE LA BANDE
  422. C   POINT DE LA BANDE
  423.       DO 2000 INDDD=INDDEB,NBPOIN
  424.        IPZO=NPZON(INDDD)
  425. *  ON EST AVANT LE DEBUT
  426.        IF (IPZO.LT.IZD) GOTO 2000
  427. *  ON EST APRES LA FIN
  428.        IF (IPZO.GT.IZF) GOTO 2100
  429.       IPOINT=NPOIN(INDDD)
  430.       IF (IVU(IPOINT).LT.1.OR.IVU(IPOINT).EQ.2) GOTO 2000
  431.       IF (IPOINT.EQ.IA) GOTO 2000
  432.       IF (IPOINT.EQ.IB) GOTO 2000
  433.       IF (IPOINT.EQ.IC) GOTO 2000
  434.       ZP=X(3,IPOINT)
  435.       IF (ZP.LT.DISTLI) GOTO 2000
  436. C DE TOUTE FACON LE POINT EST DEVANT LE TRIANGLE
  437.       XP=X(1,IPOINT)
  438.       YP=X(2,IPOINT)
  439.       VAX=XP-XA
  440.       VBX=XP-XB
  441.       VCX=XP-XC
  442.       VAY=YP-YA
  443.       VBY=YP-YB
  444.       VCY=YP-YC
  445.       DC=VAX*VBY-VAY*VBX
  446.       DA=VBX*VCY-VBY*VCX
  447.       IF (DA*DC.LT.0.) GOTO 2000
  448.       DB=VCX*VAY-VCY*VAX
  449.       IF (DA*DB.LT.0.) GOTO 2000
  450.       IF (DB*DC.LT.0.) GOTO 2000
  451.       IF (IPZO.GT.IZD1.AND.IPZO.LT.IZF1) GOTO 2020
  452. C  CAR LE POINT EST STRICTEMENT DANS LE TRIANGLE
  453.       IF (ABS(DA).GT.SMO) GOTO 2020
  454.       IF (ABS(DB).GT.SMO) GOTO 2020
  455.       IF (ABS(DC).GT.SMO) GOTO 2020
  456.       IF (VAX*VBX.LT.-SMO) GOTO 2020
  457.       IF (VAX*VCX.LT.-SMO) GOTO 2020
  458.       IF (VAY*VCY.LT.-SMO) GOTO 2020
  459.       IF (VAY*VCY.LT.-SMO) GOTO 2020
  460.       IF (VBX*VCX.LT.-SMO) GOTO 2020
  461.       IF (VBY*VCY.LT.-SMO) GOTO 2020
  462.       GOTO 2000
  463. C IPOINT EST INSCRIT A L'INTERIEUR DU TRIANGLE
  464. C  EST-IL DERRIERE
  465.  2020 IF (ZP.GT.DISTLS) GOTO 2030
  466. C  ON FAIT UNE INTERPOLATION LINEAIRE ENTRE LES DISTANCES AUX SOMMETS
  467. C  EN UTILISANT LES COORDONNEES BARYCENTRIQUES QUI NE SONT AUTRES
  468. C  QUE LE RAPPORT DES SURFACES DES PETITS TRIANGLES AU GRAND
  469.       S=DA+DB+DC
  470.       IF (S.EQ.0.) GOTO 2000
  471.       DA=DA/S
  472.       DB=DB/S
  473.       DC=DC/S
  474.       S=DA*ZA+DB*ZB+DC*ZC
  475.       IF (S.GT.ZP) GOTO 2000
  476.  2030 CONTINUE
  477. C   SOMME NOUS VRAIMENT A L'INTERIEUR DE LA FACE
  478. C   METHODE : NOUS DEVONS APPARTENIR A UN NOMBRE PAIR DE TRIANGLE DE
  479. C   L'ELEMENT
  480.       IF (NPFAC.EQ.3) GOTO 2009
  481.       IDEDAN=1
  482.       DO 2200 ITRIA1=IDEP,IFEP,3
  483.        IF (ITRIA1.EQ.ITRIAN) GOTO 2200
  484.        IAJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1)),IEL))
  485.        IBJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1+1)),IEL))
  486.        ICJ=ICPR(IPT1.NUM(LFAC(JAD+KFAC(ITRIA1+2)),IEL))
  487.       XAJ=X(1,IAJ)
  488.       XBJ=X(1,IBJ)
  489.       XCJ=X(1,ICJ)
  490.       YAJ=X(2,IAJ)
  491.       YBJ=X(2,IBJ)
  492.       YCJ=X(2,ICJ)
  493.       VAX=XP-XAJ
  494.       VBX=XP-XBJ
  495.       VCX=XP-XCJ
  496.       VAY=YP-YAJ
  497.       VBY=YP-YBJ
  498.       VCY=YP-YCJ
  499.       DC=VAX*VBY-VAY*VBX
  500.       DA=VBX*VCY-VBY*VCX
  501.       IF (DA*DC.LT.0.) GOTO 2200
  502.       DB=VCX*VAY-VCY*VAX
  503.       IF (DA*DB.LT.0.) GOTO 2200
  504.       IF (DB*DC.LT.0.) GOTO 2200
  505. *  ON EST DANS LE TRIANGLE
  506.       IDEDAN=IDEDAN+1
  507.  2200 CONTINUE
  508.       IF (MOD(IDEDAN,2).EQ.0) GOTO 2000
  509.  2009 IF (IVU(IPOINT).NE.2) IVU(IPOINT)=-IEL-IOB*NELEM
  510.  2000 CONTINUE
  511.  2100 CONTINUE
  512.       GOTO (205,400,301),IRETO
  513. C*      GOTO IRETO,(205,400,301) <- DELETED
  514.  400  CONTINUE
  515. C  ON A FINI L'ANALYSE D'UN TRIANGLE
  516.  110  CONTINUE
  517.  1011 CONTINUE
  518.  101  CONTINUE
  519.  3004 CONTINUE
  520.  3001 CONTINUE
  521.       SEGSUP TRAV
  522. C  ON MET A 1 LES IVU 2 ( POINTS NON CACHABLES)
  523.       DO 3400 II=1,IVU(/1)
  524.        IF (IVU(II).EQ.2) IVU(II)=1
  525.  3400 CONTINUE
  526.       END
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  

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