Sources Esope | Cast3M

surfp5
C SURFP5    SOURCE    PV        07/11/23    21:19:35     5978
      SUBROUTINE SURFP5 (FER,XPROJ,NDEB,msurfp)
************************************************************************
*
*                             S U R F P 5
*                             -----------
*
* FONCTION:
* ---------
*
*     HOMOLOGUE DE "PPLAN", "PCYLI" ET CIE, AVEC L'OPTION IOP=1,
*     UTILISE DANS LE CAS DU TRAITEMENT D'UNE SURFACE AVEC L'OPTION
*     "POLYNOME".
*
* MODULES UTILISES:
* -----------------
*
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC TMSURFP
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     FER     (E)  SEGMENT SUPPOSE ACTIF.
*     NFI     (E)  NUMEROS DES NOEUDS DU CONTOUR DE LA SURFACE, DANS
*                  L'ORDRE SUIVANT:
*                  1. NUMEROS DES POINTS-MILIEUX (SI "SEG3"),
*                  2. NUMEROS DES POINTS-EXTREMITES DES SEGMENTS DU
*                     CONTOUR.
*                  3. NUMERO DU 1ER POINT-EXTREMITE (FERMETURE DU
*                     CONTOUR ?).
*             (S)  LES NUMEROS DES POINTS-EXTREMITES SONT REMPLACES PAR
*                  LA PLACE DE CES POINTS DANS "XPROJ".
*     MAI     (E)  MAI(1) = NOMBRE DE POINTS-MILIEUX DU CONTOUR.
*                  MAI(1+ITOUR) = NOMBRE DE POINTS DU CONTOUR.
*     ITOUR   (E)  NOMBRE DE CONTOURS (= 1 ACTUELLEMENT POUR LES
*                  SURFACES PARAMETREES).
*     NDEB    (S)  NOMBRE DE POINTS DU CONTOUR  + 1 .
*     XPROJ   (S)  COORDONNEES PARAMETRIQUES DES POINTS-EXTREMITES DES
*                  SEGMENTS DU CONTOUR.
*                  ELLES SONT RANGEES A PARTIR DE LA PLACE "N+1", "N"
*                  ETANT LE NOMBRE DE POINTS-MILIEUX.
*    +MSURFP  (E)  POINTEUR DE SURFACE PARAMETREE.
*
      SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR)
      SEGMENT XPROJ(3,IMAX)
*
* VARIABLES:
* ----------
*
*     IMCT   = NOMBRE DE NOEUDS DU CONTOUR (1 SEUL CONTOUR POUR UNE
*              SURFACE PARAMETREE), POINTS-MILIEUX COMPRIS.
*     INCT   = PLACE DU 1ER POINT-EXTREMITE DU CONTOUR DANS "NFI".
*
      INTEGER IMCT,INCT
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     26 FEVRIER 1987
*
* LANGAGE:
* --------
*
*     ESOPE77 FORTRAN77
*
************************************************************************
*
      IF (ITOUR .NE. 1) THEN
         CALL ERREUR(5)
         RETURN
      END IF
*
      IMCT=MAI(ITOUR+1)
      INCT=MAI(1)+1
      IMAX=(IMCT**2)+10
*
      NDEB=IMCT+1
      SEGINI XPROJ
      SEGACT,MSURFP*MOD
      MUVSUR = IUVSUR
      SEGACT,MUVSUR*MOD
*
      N0 = NU0SUR
      DO 100 I=INCT,max(IMCT,mai(itour+2))
         II=NFI(I)
         NFI(I)=I
         XPROJ(1,I) = USUR(II-N0)
         XPROJ(2,I) = VSUR(II-N0)
100      CONTINUE
*     END DO
*
*     CALCUL DES DENSITES GRACE AUX DISTANCES AVEC LES VOISINS:
*     (NE FONCTIONNE PAS DU TOUT AVEC PLUSIEURS CONTOURS)
*
      IF (INCT .LE. IMCT) THEN
         D3 = (XPROJ(1,IMCT) - XPROJ(1,INCT) )**2
     &      + (XPROJ(2,IMCT) - XPROJ(2,INCT) )**2
         D3 = SQRT(D3)
         DO 110 I=INCT,IMCT
            IF (I .EQ. IMCT) THEN
               I3 = INCT
            ELSE
               I3 = I + 1
            END IF
            D1 = D3
            D3 = (XPROJ(1,I3) - XPROJ(1,I) )**2
     &         + (XPROJ(2,I3) - XPROJ(2,I) )**2
            D3 = SQRT(D3)
            XPROJ(3,I) = (D1 + D3) / 2.
110         CONTINUE
*        END DO
      END IF
*
      IF (IIMPI.EQ.1804) THEN
         DO 120 I=INCT,IMCT
            WRITE(IOIMP,'(I5,3(2X,G12.5))')I,XPROJ(1,I),XPROJ(2,I),
     &                                    XPROJ(3,I)
120         CONTINUE
*        END DO
      END IF
*
      SEGDES,MUVSUR,MSURFP
*
      END