Sources Esope | Cast3M

surfp7
C SURFP7    SOURCE    PV        07/11/23    21:19:40     5978
      SUBROUTINE SURFP7 (PT1,PT2,LIGNE1,LIGNE2,LIGNE3,LIGNE4,NOMB1,
     $ msurfp)
************************************************************************
*
*                             S U R F P 7
*                             -----------
*
* FONCTION:
* ---------
*
*     SOUS-PROGRAMME SPECIFIQUE APPELE PAR LE SOUS-PROGRAMME "SURFP3".
*
*     ACTION EFFECTUEE SI LE COTE FOURNI EN DONNEE EST DE LONGUEUR
*     NULLE.
*
* MODULES UTILISES:
* -----------------
*
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER(I-N)
-INC SMELEME
-INC TMSURFP
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     PT1     (E)  PREMIER POINT DU COTE (I).
*     PT2     (E)  DERNIER POINT DU COTE (I).
*             (S)  EVENTUELLEMENT MODIFIE EN SORTIE.
*     LIGNE1  (E)  POINTEUR DU MAILLAGE DU COTE (I).
*                  SEGMENT SUPPOSE ACTIF.
*     LIGNE2  (E)  POINTEUR DU MAILLAGE DU COTE (I+1).
*                  SEGMENT SUPPOSE ACTIF.
*     LIGNE3  (E)  POINTEUR DU MAILLAGE DU COTE (I+2).
*                  SEGMENT SUPPOSE ACTIF.
*     LIGNE4  (E)  POINTEUR DU MAILLAGE DU COTE (I+3).
*                  SEGMENT SUPPOSE ACTIF.
*    +MSURFP  (E)  POINTEUR DE LA SURFACE PARAMETREE.
*                  SEGMENT SUPPOSE ACTIF.
*             (S)  MODIFICATIONS EVENTUELLES DE "USUR" ET "VSUR".
*     NOMB1   (S)  NOMBRE D'ELEMENTS QUI ONT ETE RETENUS POUR LE COTE.
*                  (= NOMBRE INITIAL OU BIEN "0")
*
      INTEGER PT1,PT2,LIGNE1,LIGNE2,LIGNE3,LIGNE4,NOMB1
*
*>>>>> P.M. 21/09/90
* VARIABLES:
* ----------
*
      REAL*8 EPS1
*
*&lt;&lt;&lt;&lt;&lt;
* FONCTIONS:
* ----------
*
      LOGICAL EGA1
*
* REMARQUES:
* ----------
*
*     LA METHODE DE FUSION DE 2 SOMMETS TRES PROCHES QUI A ETE CHOISIE
*     PRESENTE POUR SEUL INCONVENIENT DE LAISSER TRAINER UN POINT
*     INUTILE.
*     EN CONTRE-PARTIE, ELLE CONSERVE LA CORRESPONDANCE ENTRE LES
*     NUMEROS DES POINTS ET LES TABLEAUX "USUR" ET "VSUR" DE LA SURFACE
*     PARAMETREE, MEME SI LES POINTS-SOMMETS ONT ETE FOURNIS EN DONNEE
*     ET NON PAS CALCULES (CE QUI SERA PEUT-ETRE AUTORISE UN JOUR).
*     LES METHODES PAR APPEL A "CONFON", APPEL A "TASSP2" OU REMODELAGE
*     DIRECT DE "XCOOR" N'ASSURENT PAS LA CONSERVATION DE CETTE
*     CORRESPONDANCE.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     03 MARS 1987
*
* LANGAGE:
* --------
*
*     ESOPE77 FORTRAN77
*
************************************************************************
*
      IPT1 = LIGNE1
      IPT2 = LIGNE2
      IPT3 = LIGNE3
      IPT4 = LIGNE4
*
      NOMB1 = IPT1.NUM(/2)
      NBNN = IPT1.NUM(/1)
*
      IF (NOMB1 .LE. 1) THEN
*        CE COTE NE SERAIT-IL PAS DE LONGUEUR NULLE ?
         EPS1 = -1.
         IF (EGA1(PT1,PT2,EPS1)) THEN
*
*           ON CONFOND LES POINTS ET ON SUPPRIME LE COTE CORRESPONDANT:
            MUVSUR = IUVSUR
            SEGACT,MUVSUR
            N0 = NU0SUR
            USUR(PT1-N0) = (USUR(PT1-N0) + USUR(PT2-N0)) / 2.D0
            VSUR(PT1-N0) = (VSUR(PT1-N0) + VSUR(PT2-N0)) / 2.D0
            USUR(PT2-N0) = 0.D0
            VSUR(PT2-N0) = 0.D0
            SEGDES,MUVSUR
*           LA MANIP. CI-DESSUS N'EST PAS BONNE SI L'ON TOMBE SUR UNE
*           SURFACE A 2 COTES ADJACENTS DEGENERES: LE POINT FINAL NE
*           SERA PAS, DANS LE REPERE DES COORDONNEES INTRINSEQUES,
*           L'ISOBARYCENTRE DES 3 POINTS CONFONDUS. MAIS, DE TOUTES
*           FACONS, C'EST UN CAS TRES TORDU.
            IF (IPT2.NUM(1,1) .EQ. PT2) IPT2.NUM(1,1) = PT1
            NOMB2 = IPT2.NUM(/2)
            IF (IPT2.NUM(NBNN,NOMB2) .EQ. PT2)
     &                           IPT2.NUM(NBNN,NOMB2) = PT1
            IF (IPT3.NUM(1,1) .EQ. PT2) IPT3.NUM(1,1) = PT1
            NOMB3 = IPT3.NUM(/2)
            IF (IPT3.NUM(NBNN,NOMB3) .EQ. PT2)
     &                           IPT3.NUM(NBNN,NOMB3) = PT1
            IF (IPT4.NUM(1,1) .EQ. PT2) IPT4.NUM(1,1) = PT1
            NOMB4 = IPT4.NUM(/2)
            IF (IPT4.NUM(NBNN,NOMB4) .EQ. PT2)
     &                           IPT4.NUM(NBNN,NOMB4) = PT1
*
            PT2 = PT1
            NOMB1 = 0
*
         END IF
      END IF
*
      END