Télécharger la plaquette Cast3M


fr en

Télécharger ameli2.eso

Retour à la liste

Numérotation des lignes : 

ameli2

  1. C AMELI2    SOURCE    PV        07/11/23    21:15:18     5978
  2.       SUBROUTINE AMELI2 (NUM,NSA,NBNN,NUMELG,NUMNP,NBVOIS,MAXVOI,KON)
  3. ************************************************************************
  4. *
  5. *                             A M E L I 2
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     AMELIORATION D'UN MAILLAGE DE "QUA4" ET/OU "TRI3" SANS
  12. *     DEPLACEMENT DES NOEUDS.
  13. *
  14. * MODULES UTILISES:
  15. * -----------------
  16. *
  17.       IMPLICIT INTEGER(I-N)
  18.       implicit real*8 (a-h,o-z)
  19. -INC CCREEL
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. *
  24. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. *     NUM(I,J)  E/S  NUMERO DU I-EME NOEUD DU J-EME ELEMENT.
  28. *                    - MELANGE "QUA4" ET "TRI3" DANS LE MEME TABLEAU,
  29. *                    - TABLEAU SURDIMENSIONNE.
  30. *                    - NUMEROTATION DES NOEUDS LOCALE A L'OPERATEUR.
  31. *     NSA       (E)  TABLEAU DE CORRESPONDANCE ENTRE NUMEROS LOCAUX ET
  32. *                    GLOBAUX.
  33. *     NBNN      (E)  NOMBRE MAXI DE NOEUDS PAR ELEMENT.
  34. *     NUMELG    E/S  NOMBRE D'ELEMENTS DU MAILLAGE.
  35. *     NUMNP     (E)  NOMBRE DE NOEUDS DU MAILLAGE.
  36. *     NBVOIS    (E)  NOMBRE D'ELEMENTS APPUYES SUR UN NOEUD DONNE.
  37. *     KON       (E)  TABLEAU DE CONNEXIONS DES NOEUDS.
  38. *                    KON(I, N.NOEUD - CSTE) = N.ELEMENT
  39. *
  40.       INTEGER NUM(NBNN,*),NSA(*),NBVOIS(*),KON(MAXVOI,*)
  41. *
  42. * CONSTANTES:
  43. * -----------
  44. *
  45.       PARAMETER (PI = XPI)
  46.       PARAMETER (ANGMIN =  30.D0 * XPI/180.D0)
  47.       PARAMETER (ANGMAX = XPI - ANGMIN)
  48.       PARAMETER (QUAL0 = 0.3)
  49. *
  50. * VARIABLES:
  51. * ----------
  52. *
  53. *     QUADRA = .TRUE.  SI ON CHERCHE A MAILLER EN QUADRANGLES.
  54. *
  55.       LOGICAL QUADRA
  56. *
  57. * FONCTIONS:
  58. * ----------
  59. *
  60.       LOGICAL QUAD
  61.       QUAD(I) = (NBNN.EQ.4).AND.(NUM(NBNN,I).NE.0)
  62. *
  63. * REMARQUES:
  64. * ----------
  65. *
  66. *     CRITERES DE QUALITE:
  67. *     - PLUS GRAND ANGLE DE QUADRANGLE (ANALOGUE AU S.P. "AMELIO"),
  68. *     - PLUS PETIT ANGLE DE QUADRANGLE,
  69. *     - SURFACE TRIANGLE PAR RAPPORT A EQUILATERAL (ANALOGUE AU S.P.
  70. *       "AMELIO", LIMITE A 0.3 AU LIEU DE 0.4)
  71. *     MAIS CALCUL DANS L'ESPACE GEOMETRIQUE REEL ET IMPOSSIBILITE DE
  72. *     DEPLACER LES NOEUDS.
  73. *
  74. * AUTEUR, DATE DE CREATION:
  75. * -------------------------
  76. *
  77. *     PASCAL MANIGOT     19 NOVEMBRE 1990
  78. *
  79. * LANGAGE:
  80. * --------
  81. *
  82. *     FORTRAN77
  83. *
  84. ************************************************************************
  85. *
  86.       IF (NUMELG.LE.1) RETURN
  87. *
  88.       QUADRA = NBNN.EQ.4
  89. *
  90. *
  91. *     1) CONVERSION DES QUADRANGLES APLATIS EN COUPLES DE TRIANGLES
  92. *
  93.       IF (QUADRA) THEN
  94. *
  95.          NUMEL0 = NUMELG
  96.          DO 100 L1=1,NUMEL0
  97.             IF (.NOT. QUAD(L1)) GOTO 100
  98. *
  99.             I1=NUM(1,L1)
  100.             I2=NUM(2,L1)
  101.             I3=NUM(3,L1)
  102.             I4=NUM(4,L1)
  103.             N1 = NSA(I1)
  104.             N2 = NSA(I2)
  105.             N3 = NSA(I3)
  106.             N4 = NSA(I4)
  107.             CALL ANGQUA (N1,N2,N3,N4,  ANG1,ANG2,ANG3,ANG4)
  108.             IF  (ANG1.GT.ANGMAX .OR. ANG2.LT.ANGMIN
  109.      &           .OR. ANG3.GT.ANGMAX .OR. ANG4.LT.ANGMIN) THEN
  110.                NUM(4,L1)=0
  111.                NUMELG=NUMELG+1
  112.                NUM(1,NUMELG)=I1
  113.                NUM(2,NUMELG)=I3
  114.                NUM(3,NUMELG)=I4
  115.                NUM(4,NUMELG)=0
  116.             ELSE IF  (ANG1.LT.ANGMIN .OR. ANG2.GT.ANGMAX
  117.      &              .OR. ANG3.LT.ANGMIN .OR. ANG4.GT.ANGMAX) THEN
  118.                NUM(4,L1)=0
  119.                NUM(3,L1)=I4
  120.                NUMELG=NUMELG+1
  121.                NUM(1,NUMELG)=I2
  122.                NUM(2,NUMELG)=I3
  123.                NUM(3,NUMELG)=I4
  124.                NUM(4,NUMELG)=0
  125.             END IF
  126.  100     CONTINUE
  127. *        END DO
  128. *
  129.          IF (IIMPI .EQ. 1808) THEN
  130.             WRITE (IOIMP,2100) (NUMELG - NUMEL0)
  131.  2100       FORMAT (1X,I5,' DECOUPAGES DE 1 QUADRANGLE EN 2 TRIANGLES.')
  132.          END IF
  133. *
  134.       END IF
  135. *
  136. *
  137.       MODIF2 = 0
  138.       MODIF4 = 0
  139.       MODIF6 = 0
  140. *     DO
  141.  400  CONTINUE
  142.       MODIF1 = MODIF2
  143.       MODIF3 = MODIF4
  144.       MODIF5 = MODIF6
  145. *
  146. *
  147. *        2) RECHERCHE DE TRIANGLES ADJACENTS POUR:
  148. *           - CREATION DE QUADRANGLE, OU
  149. *           - INVERSION EVENTUELLE DE DIAGONALE.
  150. *
  151. *
  152. *        DEFINITION DE LA TABLE DES CONNEXIONS:
  153.       DO 200 I=1,NUMNP
  154.          NBVOIS(I)=0
  155.  200  CONTINUE
  156. *        END DO
  157.       DO 202 L2=1,NUMELG
  158.          DO 2021 I=1,NBNN
  159.             IA = NUM(I,L2)
  160.             IF (IA .NE. 0) THEN
  161.                NBVOIS(IA)=NBVOIS(IA)+1
  162.                KON(NBVOIS(IA),IA)=L2
  163.             END IF
  164.  2021    CONTINUE
  165.  202  CONTINUE
  166. *        END DO
  167. *
  168.       L1 = 0
  169.  500  IF (L1.LT.NUMELG) THEN
  170.          L1 = L1 + 1
  171.          IF (QUAD(L1)) GOTO 500
  172. *
  173.          I1=NUM(1,L1)
  174.          I2=NUM(2,L1)
  175.          I3=NUM(3,L1)
  176.          N1 = NSA(I1)
  177.          N2 = NSA(I2)
  178.          N3 = NSA(I3)
  179.          CALL VALTRI (N1,N2,N3,  CAL1)
  180. *
  181.          DO 540 IPOI=1,3
  182. *
  183.             NODL1 = NUM(IPOI,L1)
  184.             NM=NBVOIS(NODL1)
  185. *
  186.             DO 520 IVOIS=1,NM
  187. *
  188.                L2=KON(IVOIS,NODL1)
  189.                IF (L2 .EQ. L1) GOTO 520
  190.                IF (QUAD(L2)) GOTO 520
  191. *
  192.                IF    ((I1.EQ.NUM(1,L2)).AND.(I2.EQ.NUM(3,L2))) THEN
  193.                   I9=NUM(2,L2)
  194.                ELSEIF((I1.EQ.NUM(2,L2)).AND.(I2.EQ.NUM(1,L2))) THEN
  195.                   I9=NUM(3,L2)
  196.                ELSEIF((I1.EQ.NUM(3,L2)).AND.(I2.EQ.NUM(2,L2))) THEN
  197.                   I9=NUM(1,L2)
  198. *
  199.                ELSEIF((I1.EQ.NUM(1,L2)).AND.(I3.EQ.NUM(2,L2))) THEN
  200.                   IAA=I1
  201.                   I1=I3
  202.                   I3=I2
  203.                   I2=IAA
  204.                   I9=NUM(3,L2)
  205.                ELSEIF((I1.EQ.NUM(2,L2)).AND.(I3.EQ.NUM(3,L2))) THEN
  206.                   IAA=I1
  207.                   I1=I3
  208.                   I3=I2
  209.                   I2=IAA
  210.                   I9=NUM(1,L2)
  211.                ELSEIF((I1.EQ.NUM(3,L2)).AND.(I3.EQ.NUM(1,L2))) THEN
  212.                   IAA=I1
  213.                   I1=I3
  214.                   I3=I2
  215.                   I2=IAA
  216.                   I9=NUM(2,L2)
  217. *
  218.                ELSEIF((I2.EQ.NUM(1,L2)).AND.(I3.EQ.NUM(3,L2))) THEN
  219.                   IAA=I1
  220.                   I1=I2
  221.                   I2=I3
  222.                   I3=IAA
  223.                   I9=NUM(2,L2)
  224.                ELSEIF((I2.EQ.NUM(2,L2)).AND.(I3.EQ.NUM(1,L2))) THEN
  225.                   IAA=I1
  226.                   I1=I2
  227.                   I2=I3
  228.                   I3=IAA
  229.                   I9=NUM(3,L2)
  230.                ELSEIF((I2.EQ.NUM(3,L2)).AND.(I3.EQ.NUM(2,L2))) THEN
  231.                   IAA=I1
  232.                   I1=I2
  233.                   I2=I3
  234.                   I3=IAA
  235.                   I9=NUM(1,L2)
  236.                ELSE
  237. *                    ITERATE
  238.                   GOTO 520
  239.                END IF
  240. *
  241.                N1 = NSA(I1)
  242.                N9 = NSA(I9)
  243.                N2 = NSA(I2)
  244.                N3 = NSA(I3)
  245.                CALL ANGQUA (N1,N9,N2,N3,  ANG1,ANG2,ANG3,ANG4)
  246. *
  247.                IF (QUADRA) THEN
  248.                   IF   (MIN(ANG1,ANG2,ANG3,ANG4).GT.ANGMIN
  249.      &                 .AND. MAX(ANG1,ANG2,ANG3,ANG4).LT.ANGMAX) THEN
  250. *                       ON PEUT ASSEMBLER UN QUADRANGLE:
  251.                      NUM(1,L1)=I1
  252.                      NUM(2,L1)=I9
  253.                      NUM(3,L1)=I2
  254.                      NUM(4,L1)=I3
  255. *
  256. *                       ON ENLEVE L'ELEMENT "L2":
  257.                      NUMELG=NUMELG-1
  258.                      DO 102 K=L2,NUMELG
  259.                         NUM(1,K)=NUM(1,K+1)
  260.                         NUM(2,K)=NUM(2,K+1)
  261.                         NUM(3,K)=NUM(3,K+1)
  262.                         NUM(4,K)=NUM(4,K+1)
  263.  102                 CONTINUE
  264. *                       END DO
  265.                      IF (L1.GT.L2) L1 = L1 - 1
  266.                      DO 103 K1=1,MAXVOI
  267.                         DO 1031 K2=1,NUMNP
  268.                            IF (KON(K1,K2).GT.L2) THEN
  269.                               KON(K1,K2)=KON(K1,K2)-1
  270.                            ELSE IF (KON(K1,K2).EQ.L2) THEN
  271.                               NBVOIS(K2) = NBVOIS(K2) - 1
  272.                               DO 120 K1B = K1,NBVOIS(K2)
  273.                                  KON(K1B,K2) = KON(K1B+1,K2)
  274.  120                          CONTINUE
  275. *                             END DO
  276.                            END IF
  277.  1031                   CONTINUE
  278.  103                 CONTINUE
  279. *                       END DO
  280. *                       FIN DE LA SUPPRESSION DE L'ELEMENT "L2"
  281. *
  282.                      MODIF2 = MODIF2 + 1
  283.                      GOTO 500
  284.                   END IF
  285.                END IF
  286. *
  287.                IF (MAX(ANG1,ANG2,ANG3,ANG4) .LT. PI) THEN
  288. *                    INVERSION EVENTUELLE DE DIAGONALE POUR LES 2
  289. *                    TRIANGLES ADJACENTS:
  290.                   CALL VALTRI (N1,N9,N3,  CAL2)
  291.                   IF (CAL2.GT.CAL1) THEN
  292.                      CALL VALTRI (N9,N2,N3,  CAL2)
  293.                      IF (CAL2.GT.CAL1) THEN
  294. *                          ON PEUT COUPER SUIVANT LA DEUXIEME DIAGONALE
  295.                         NUM(1,L1)=I1
  296.                         NUM(2,L1)=I9
  297.                         NUM(3,L1)=I3
  298.                         NUM(1,L2)=I9
  299.                         NUM(2,L2)=I2
  300.                         NUM(3,L2)=I3
  301.                         MODIF4 = MODIF4 + 1
  302.                         GOTO 500
  303.                      END IF
  304.                   END IF
  305.                END IF
  306. *
  307.  520        CONTINUE
  308. *              END DO
  309. *
  310.  540     CONTINUE
  311. *           END DO
  312. *
  313.          GOTO 500
  314.       END IF
  315. *
  316.       IF (IIMPI .EQ. 1808) THEN
  317.          WRITE (IOIMP,2000) (MODIF2 - MODIF1)
  318.  2000    FORMAT (1X,I5,
  319.      &        ' TRANSFORMATIONS DE 2 TRIANGLES EN 1 QUADRANGLE.')
  320.          WRITE (IOIMP,2110) (MODIF4 - MODIF3)
  321.  2110    FORMAT (1X,I5,' INVERSIONS DE DIAGONALES.')
  322.       END IF
  323. *
  324.       IF (.NOT. QUADRA) THEN
  325.          IF (MODIF4 .GT. MODIF3) GOTO 400
  326.          RETURN
  327.       END IF
  328. *
  329. *
  330. *        3) AMELIORATION DES QUADRANGLES PAR GLISSEMENT DES TRIANGLES
  331. *
  332. *
  333.       IF ((MODIF2+MODIF4) .GT. (MODIF1+MODIF3)) THEN
  334. *           REDEFINITION DE LA TABLE DES CONNEXIONS:
  335.          DO 610 I=1,NUMNP
  336.             NBVOIS(I)=0
  337.  610     CONTINUE
  338. *           END DO
  339.          DO 620 L2=1,NUMELG
  340.             DO 6201 I=1,NBNN
  341.                IA = NUM(I,L2)
  342.                IF (IA .NE. 0) THEN
  343.                   NBVOIS(IA)=NBVOIS(IA)+1
  344.                   KON(NBVOIS(IA),IA)=L2
  345.                END IF
  346.  6201       CONTINUE
  347.  620     CONTINUE
  348. *           END DO
  349.       END IF
  350. *
  351.       L1 = 0
  352.  700  IF (L1.LT.NUMELG) THEN
  353.          L1 = L1 + 1
  354.          IF (QUAD(L1)) GOTO 700
  355. *
  356.          I1=NUM(1,L1)
  357.          I2=NUM(2,L1)
  358.          I3=NUM(3,L1)
  359.          PABO1 = ANGMAX * 1.01
  360. *
  361.          DO 740 IPOI=1,3
  362. *
  363.             NODL1 = NUM(IPOI,L1)
  364.             NM=NBVOIS(NODL1)
  365. *
  366.             DO 720 IVOIS=1,NM
  367. *
  368.                L2=KON(IVOIS,NODL1)
  369.                IF (.NOT.QUAD(L2)) GOTO 720
  370. *
  371.                IF ((I1.EQ.NUM(1,L2)).AND.(I2.EQ.NUM(4,L2))) THEN
  372.                   II1 = I2
  373.                   II2 = I3
  374.                   II3 = I1
  375.                   II4 = NUM(2,L2)
  376.                   II5 = NUM(3,L2)
  377.                ELSEIF((I1.EQ.NUM(2,L2)).AND.(I2.EQ.NUM(1,L2))) THEN
  378.                   II1 = I2
  379.                   II2 = I3
  380.                   II3 = I1
  381.                   II4 = NUM(3,L2)
  382.                   II5 = NUM(4,L2)
  383.                ELSEIF((I1.EQ.NUM(3,L2)).AND.(I2.EQ.NUM(2,L2))) THEN
  384.                   II1 = I2
  385.                   II2 = I3
  386.                   II3 = I1
  387.                   II4 = NUM(4,L2)
  388.                   II5 = NUM(1,L2)
  389.                ELSEIF((I1.EQ.NUM(4,L2)).AND.(I2.EQ.NUM(3,L2))) THEN
  390.                   II1 = I2
  391.                   II2 = I3
  392.                   II3 = I1
  393.                   II4 = NUM(1,L2)
  394.                   II5 = NUM(2,L2)
  395. *
  396.                ELSEIF((I1.EQ.NUM(1,L2)).AND.(I3.EQ.NUM(2,L2))) THEN
  397.                   II1 = I1
  398.                   II2 = I2
  399.                   II3 = I3
  400.                   II4 = NUM(3,L2)
  401.                   II5 = NUM(4,L2)
  402.                ELSEIF((I1.EQ.NUM(2,L2)).AND.(I3.EQ.NUM(3,L2))) THEN
  403.                   II1 = I1
  404.                   II2 = I2
  405.                   II3 = I3
  406.                   II4 = NUM(4,L2)
  407.                   II5 = NUM(1,L2)
  408.                ELSEIF((I1.EQ.NUM(3,L2)).AND.(I3.EQ.NUM(4,L2))) THEN
  409.                   II1 = I1
  410.                   II2 = I2
  411.                   II3 = I3
  412.                   II4 = NUM(1,L2)
  413.                   II5 = NUM(2,L2)
  414.                ELSEIF((I1.EQ.NUM(4,L2)).AND.(I3.EQ.NUM(1,L2))) THEN
  415.                   II1 = I1
  416.                   II2 = I2
  417.                   II3 = I3
  418.                   II4 = NUM(2,L2)
  419.                   II5 = NUM(3,L2)
  420. *
  421.                ELSEIF((I2.EQ.NUM(1,L2)).AND.(I3.EQ.NUM(4,L2))) THEN
  422.                   II1 = I3
  423.                   II2 = I1
  424.                   II3 = I2
  425.                   II4 = NUM(2,L2)
  426.                   II5 = NUM(3,L2)
  427.                ELSEIF((I2.EQ.NUM(2,L2)).AND.(I3.EQ.NUM(1,L2))) THEN
  428.                   II1 = I3
  429.                   II2 = I1
  430.                   II3 = I2
  431.                   II4 = NUM(3,L2)
  432.                   II5 = NUM(4,L2)
  433.                ELSEIF((I2.EQ.NUM(3,L2)).AND.(I3.EQ.NUM(2,L2))) THEN
  434.                   II1 = I3
  435.                   II2 = I1
  436.                   II3 = I2
  437.                   II4 = NUM(4,L2)
  438.                   II5 = NUM(1,L2)
  439.                ELSEIF((I2.EQ.NUM(4,L2)).AND.(I3.EQ.NUM(3,L2))) THEN
  440.                   II1 = I3
  441.                   II2 = I1
  442.                   II3 = I2
  443.                   II4 = NUM(1,L2)
  444.                   II5 = NUM(2,L2)
  445.                ELSE
  446. *                    ITERATE
  447.                   GOTO 720
  448.                END IF
  449. *
  450.                N1 = NSA(II1)
  451.                N2 = NSA(II2)
  452.                N3 = NSA(II3)
  453.                N4 = NSA(II4)
  454.                N5 = NSA(II5)
  455. *                 TRIANGLE=1,2,3    QUADRANGLE=1,3,4,5
  456. *
  457. *                 QUALITE DU QUADRANGLE ACTUEL:
  458.                CALL ANGQUA (N1,N3,N4,N5,  ANG1,ANG2,ANG3,ANG4)
  459.                AN1345 = MAX(ANG1,ANG2,ANG3,ANG4,
  460.      &              PI-ANG1,PI-ANG2,PI-ANG3,PI-ANG4)
  461. *                 2 AUTRES QUADRANGLES POSSIBLES:
  462.                CALL ANGQUA (N1,N2,N3,N4,  ANG1,ANG2,ANG3,ANG4)
  463.                AN1234 = MAX(ANG1,ANG2,ANG3,ANG4,
  464.      &              PI-ANG1,PI-ANG2,PI-ANG3,PI-ANG4)
  465.                CALL ANGQUA (N1,N2,N3,N5,  ANG1,ANG2,ANG3,ANG4)
  466.                AN1235 = MAX(ANG1,ANG2,ANG3,ANG4,
  467.      &              PI-ANG1,PI-ANG2,PI-ANG3,PI-ANG4)
  468. *
  469.                IF (AN1234 .LT. AN1345) THEN
  470.                   IF (AN1234 .LT. PABO1) THEN
  471. *                       1ER NOUVEAU TRIANGLE POSSIBLE:
  472.                      CALL VALTRI (N1,N4,N5,  CAL1)
  473.                      IF (CAL1 .GT. QUAL0) THEN
  474.                         PABO1 = AN1234
  475.                         L2BEST = L2
  476.                         III1 = II4
  477.                         III2 = II5
  478.                         III3 = II1
  479.                         III4 = II2
  480.                         III5 = II3
  481.                      END IF
  482.                   END IF
  483.                END IF
  484.                IF (AN1235 .LT. PI) THEN
  485. *                    2EME NOUVEAU TRIANGLE POSSIBLE:
  486.                   CALL VALTRI (N1,N2,N5,  CAL1)
  487.                   IF (CAL1 .GT. QUAL0) THEN
  488.                      CALL ANGQUA (N2,N3,N4,N5,  ANG1,ANG2,ANG3,ANG4)
  489.                      PABO3 = MAX(ANG1,ANG2,ANG3,ANG4,
  490.      &                    PI-ANG1,PI-ANG2,PI-ANG3,PI-ANG4)
  491.                      IF (PABO3 .LT. AN1345) THEN
  492.                         IF (PABO3 .LT. PABO1) THEN
  493.                            PABO1 = PABO3
  494.                            L2BEST = L2
  495.                            III1 = II5
  496.                            III2 = II1
  497.                            III3 = II2
  498.                            III4 = II3
  499.                            III5 = II4
  500.                         END IF
  501.                      END IF
  502.                   END IF
  503.                END IF
  504.                IF (AN1234 .LT. PI) THEN
  505. *                    3EME NOUVEAU TRIANGLE POSSIBLE:
  506.                   CALL VALTRI (N2,N3,N4,  CAL1)
  507.                   IF (CAL1 .GT. QUAL0) THEN
  508.                      CALL ANGQUA (N4,N5,N1,N2,  ANG1,ANG2,ANG3,ANG4)
  509.                      PABO3 = MAX(ANG1,ANG2,ANG3,ANG4,
  510.      &                    PI-ANG1,PI-ANG2,PI-ANG3,PI-ANG4)
  511.                      IF (PABO3 .LT. AN1345) THEN
  512.                         IF (PABO3 .LT. PABO1) THEN
  513.                            PABO1 = PABO3
  514.                            L2BEST = L2
  515.                            III1 = II2
  516.                            III2 = II3
  517.                            III3 = II4
  518.                            III4 = II5
  519.                            III5 = II1
  520.                         END IF
  521.                      END IF
  522.                   END IF
  523.                END IF
  524.                IF (AN1235 .LT. AN1345) THEN
  525.                   IF (AN1235 .LT. PABO1) THEN
  526. *                       4EME NOUVEAU TRIANGLE POSSIBLE:
  527.                      CALL VALTRI (N3,N4,N5,  CAL1)
  528.                      IF (CAL1 .GT. QUAL0) THEN
  529.                         PABO1 = AN1235
  530.                         L2BEST = L2
  531.                         III1 = II3
  532.                         III2 = II4
  533.                         III3 = II5
  534.                         III4 = II1
  535.                         III5 = II2
  536.                      END IF
  537.                   END IF
  538.                END IF
  539. *
  540.  720        CONTINUE
  541. *              END DO
  542. *
  543.  740     CONTINUE
  544. *           END DO
  545. *
  546.          IF (PABO1 .LT. ANGMAX) THEN
  547. *              ON A TROUVE LE MOYEN DE MIEUX REPRESENTER UN ENSEMBLE
  548. *              QUADRANGLE+TRIANGLE DANS UN POLYGONE DE 5 POINTS.
  549.             MODIF6 = MODIF6 + 1
  550.             L2 = MAX(L1,L2BEST)
  551.             L1 = MIN(L1,L2BEST)
  552.             NUM(1,L1) = III1
  553.             NUM(2,L1) = III2
  554.             NUM(3,L1) = III3
  555.             NUM(4,L1) = 0
  556.             NUM(1,L2) = III1
  557.             NUM(2,L2) = III3
  558.             NUM(3,L2) = III4
  559.             NUM(4,L2) = III5
  560.             L1 = L1 - 1
  561.          END IF
  562. *
  563.          GOTO 700
  564.       END IF
  565. *
  566.       IF (IIMPI .EQ. 1808) THEN
  567.          WRITE (IOIMP,2010) (MODIF6 - MODIF5)
  568.  2010    FORMAT (1X,I5,' DEPLACEMENTS DE TRIANGLES.')
  569.       END IF
  570. *
  571.       IF ((MODIF4+MODIF6) .GT. (MODIF3+MODIF5)) GOTO 400
  572. *     END DO
  573. *
  574.       END
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  

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