C SURFP6    SOURCE    PV        20/03/24    21:22:19     10554          
*>>>>> P.M. 04/10/90
      SUBROUTINE SURFP6 (OPERAT,XPROJ,NDEB,NUMNP,ISUPPR,msurfp)
************************************************************************
*
*                             S U R F P 6
*                             -----------
*
* FONCTION:
* ---------
*
*     HOMOLOGUE DE "PPLAN", "PCYLI" ET CIE, AVEC L'OPTION IOP=2,
*     UTILISE DANS LE CAS DU TRAITEMENT D'UNE SURFACE AVEC L'OPTION
*     "POLYNOME".
*     PASSAGE AUX COORDONNEES REELLES POUR LES POINTS INTERIEURS CREES.
*
* MODULES UTILISES:
* -----------------
*
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC TMSURFP
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     OPERAT  (E)  NOM DE L'OPERATEUR UTILISE
*     XPROJ   (E)  COORDONNEES PARAMETRIQUES DES POINTS DE LA SURFACE.
*     NDEB    (E)  INDICE, DANS "XPROJ", DU PREMIER NOEUD INTERIEUR DE
*                  LA SURFACE.
*     NUMNP   (E)  INDICE, DANS "XPROJ", DU DERNIER NOEUD INTERIEUR DE
*                  LA SURFACE.
*     ISUPPR  (E)  = 1 POUR SUPPRIMER LES SEGMENTS DE TRAVAIL "XPROJ",
*                  "MSURFP" ET SEGMENTS SOUS-JACENTS.
*                  = 0 SINON.
*    +IDIM    (E)  VOIR LE COMMUN "COPTIO".
*    +MSURFP  (E)  POINTEUR DE SURFACE PARAMETREE.
*    +MCOORD  (S)  REMPLISSAGE DES COORDONNEES DES NOEUDS INTERIEURS
*                  A LA SURFACE.
*<<<<<
*
      CHARACTER*(*) OPERAT
      SEGMENT XPROJ(3,IMAX)
*
* VARIABLES:
* ---------
*
*     ASUR( ) : 1ERE COORDONNEE PARAMETRIQUE DES POINTS DE LA SURFACE
*     BSUR( ) : 2EME COORDONNEE PARAMETRIQUE DES POINTS DE LA SURFACE
*     DSUR( ) : DENSITE DES POINTS DE LA SURFACE, CALCULEE DANS SURFP5
*
      INTEGER LONG,NOMB1,NOMB2,NOMB3,NOMB4
      REAL*8 R1,R2,R3
      SEGMENT,MTRAV
         REAL*8 ASUR(LONG),BSUR(LONG),DSUR(LONG)
      ENDSEGMENT
*
* FONCTIONS:
* ----------
*
      REAL*8 POLYN2
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     26 FEVRIER 1987
*
* LANGAGE:
* --------
*
*     ESOPE77 FORTRAN77 + EXTENSION: DECLARATION "REAL*8".
*
************************************************************************
*
      SEGACT,MSURFP*MOD
      SEGACT,XPROJ*MOD
*
      SEGACT,MCOORD*MOD
      NBPTA = nbpts
      NBPTS = NBPTA + NUMNP - NDEB + 1
*
      IF (NBPTS .GT. NBPTA) THEN
*
         SEGADJ,MCOORD
         IF (OPERAT(1:4).EQ.'SURF') THEN
            LONG=NUMNP-NDEB+1
            SEGINI,MTRAV
            DO 500 IB=NDEB,NUMNP
               ASUR(IB-NDEB+1) = XPROJ(1,IB)
               BSUR(IB-NDEB+1) = XPROJ(2,IB)
               DSUR(IB-NDEB+1) = XPROJ(3,IB)
500            CONTINUE
*           END DO
            CALL SURFP8(.FALSE.,ASUR,BSUR,DSUR,LONG,U1SUR,U2SUR,V1SUR,
     &                  V2SUR,NOMB1,NOMB2,NOMB3,NOMB4)
            NUPT = NBPTA
            DO 510 IB=1,LONG
               NUPT = NUPT + 1
               R1 = ASUR(IB)
               R2 = BSUR(IB)
               R3 = - DSUR(IB)
               CALL SURFP9 (NUPT,R1,R2,R3,msurfp)
 510           CONTINUE
*           END DO
            SEGSUP,MTRAV
         ELSE
            NUPT = NBPTA
            DO 520 IB=NDEB,NUMNP
               NUPT = NUPT + 1
               R1 = XPROJ(1,IB)
               R2 = XPROJ(2,IB)
               R3 = - XPROJ(3,IB)
               CALL SURFP9 (NUPT,R1,R2,R3,msurfp)
 520           CONTINUE
*           END DO
         END IF
      END IF
*
*>>>>> P.M. 04/10/90
      IF (ISUPPR .EQ. 1) THEN
*<<<<<
*     DESTRUCTION DES SEGMENTS DE TRAVAIL:
      SEGSUP,XPROJ
      MUVSUR = IUVSUR
      SEGSUP,MUVSUR
      MCOFSU = ICOFSU
      SEGSUP,MCOFSU
      SEGSUP,MSURFP
*>>>>> P.M. 04/10/90
      END IF
*<<<<<
*
      END




 
