Sources Esope | Cast3M

courb2
C COURB2    SOURCE    PV        20/03/30    21:16:43     10567          
      SUBROUTINE COURB2 (MCOURB,LIGNE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
************************************************************************
*
*                             C O U R B 2
*                             -----------
*
* FONCTION:
* ---------
*
*     CONSTRUCTION DE LA COURBE POLYNOMIALE.
*
* MODULES UTILISES:
* -----------------
*
-INC CCGEOME
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCOORD
-INC SMELEME
-INC TMCOURB
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     MCOURB  (E)  SEGMENT ACTIF.
*    +IDIM    (E)  VOIR LE COMMUN "COPTIO".
*    +IDCOUL  (E)  VOIR LE COMMUN "CGEOME".
*    +ILCOUR  (E)  VOIR LE COMMUN "CGEOME".
*    +KDEGRE  (E)  VOIR LE COMMUN "CGEOME".
*    +NBNNE   (E)  VOIR LE COMMUN "CGEOME".
*    +MCOORD  (E)  VOIR LE COMMUN "COPTIO".
*    +XPETIT  (E)  VOIR LE COMMUN "CREEL".
*     LIGNE   (S)  OBJET 'MAILLAGE'.
*
* VARIABLES:
* ----------
*
*     ABSC     ABSCISSE CURVILIGNE OU PARAMETRIQUE COURANTE.
*     ABSCIS   TABLE DES ABSCISSES CURVILIGNES OU PARAMETRIQUES, SELON
*              QUE L'ON A L'OPTION "REGULIER" OU NON.
*              ON N'Y MET PAS LES ABSCISSES DES EXTREMITES.
*     ALONG    LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE.
*     APROG    "RAISON" DE LA PROGRESSION GEOMETRIQUE DES DENSITES
*              SUCCESSIVES LE LONG DE LA COURBE.
*     D9COU    LARGEUR COURANTE DE MAILLE EN UNITES DE LONGUEUR OU
*              PARAMETRIQUES (SELON L'OPTION "REGULIER" OU NON).
*     MABCUR   SEGMENT CREE DANS "COURB3" ET UTILISE DANS "COURB4".
*     PT0COU   DERNIER POINT CREE AVANT CREATION DES POINTS INTERIEURS
*              DE LA COURBE.
*     PT9COU   POINT COURANT DE LA COURBE.
*
      SEGMENT,MABCUR
         REAL*8 ABCURV(NPDISC)
      ENDSEGMENT
      SEGMENT,MABSCI
         REAL*8 ABSCIS(NPOIN)
      ENDSEGMENT
      INTEGER PT0COU,PT9COU
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     8 SEPTEMBRE 1986
*     P.M.  6 MARS 1987: AMELIORATION DU CALCUL DE LA DENSITE.
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      IF (D1COU.EQ.0. .OR. D2COU.EQ.0.) THEN
         CALL ERREUR(17)
         RETURN
      END IF
*
      CALL COURB3 (MCOURB,  ALONG,MABCUR)
*     CONTRAIREMENT AUX OPERATEURS "DROITE" ET CIE, ON ACCEPTE DE CREER
*     UNE COURBE POLYNOMIALE DE LONGUEUR NULLE. CECI EST PARTICULIERE-
*     MENT UTILE LORSQUE CETTE COURBE EST LE COTE D'UNE SURFACE
*     PARAMETREE.
      IF (ALONG .LT. XPETIT) ALONG = XPETIT
*
      D1COU = D1COU / ALONG
      D2COU = D2COU / ALONG
*
*     DETERMINATION DE LA RAISON DES DENSITES SUCCESSIVES (PROGRESSION
*     GEOMETRIQUE) ET DU NOMBRE D'ELEMENTS DE LA COURBE:
      DEN1=D1COU
      DEN2=D2COU
      CALL DECOUP(NLMCOU,DEN1,DEN2,APROG,NBELEM,DENI,DECA,ALONG)
      D1COU=DEN1
      D2COU=DEN2
*
      NLMCOU = NBELEM
*
      IF (REGCOU) THEN
         D1COU = D1COU * ALONG
      ELSE
         D1COU = D1COU * (U2COU-U1COU)
      END IF
      IF (ILCOUR .EQ. 0) GOTO 900
      ITYPLM = KDEGRE(ILCOUR)
      IF (ITYPLM .EQ. 0) GOTO 900
      NBNN = NBNNE(ITYPLM)
      IF (NBNN .NE. 2 .AND. NBNN .NE. 3) GOTO 900
      NBSOUS = 0
      NBREF = 0
      SEGINI,MELEME
      ITYPEL = ITYPLM
      DO 150 IB=1,NBELEM
         ICOLOR(IB) = IDCOUL
  150    CONTINUE
*     END DO
*
      NPOIN = NBELEM * (NBNN - 1) - 1
      SEGINI,MABSCI
      PT0COU = nbpts     
*
      PT9COU = PT0COU
      NUM(1,1) = PT1COU
      D9COU = D1COU
      IF (REGCOU) THEN
         ABSC = 0.
      ELSE
         ABSC = U1COU
      END IF
*
      IF (NBNN .EQ. 2) THEN
         DO 300 IB=1,(NBELEM-1)
            PT9COU = PT9COU + 1
            NUM(2,IB) = PT9COU
            NUM(1,IB+1) = PT9COU
            D9COU = D9COU * APROG
            ABSC = ABSC + D9COU
            ABSCIS(PT9COU-PT0COU) = ABSC
  300       CONTINUE
*        END DO
         NUM(2,NBELEM) = PT2COU
      ELSE
*        "NBNN" = 3
         DO 310 IB=1,(NBELEM-1)
            PT9COU = PT9COU + 1
            NUM(2,IB) = PT9COU
            D9COU = D9COU * APROG
            ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC
            PT9COU = PT9COU + 1
            NUM(3,IB) = PT9COU
            NUM(1,IB+1) = PT9COU
            ABSC = ABSC + D9COU
            ABSCIS(PT9COU-PT0COU) = ABSC
  310       CONTINUE
*        END DO
         PT9COU = PT9COU + 1
         NUM(2,NBELEM) = PT9COU
         D9COU = D9COU * APROG
         ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC
         NUM(3,NBELEM) = PT2COU
      END IF
*
      LIGNE = MELEME
      SEGDES,MELEME
*
      IF (NPOIN .GT. 0) THEN
         IF (REGCOU) THEN
            CALL COURB4 (MCOURB,MABCUR,MABSCI,ALONG)
         ELSE
            CALL COURB5 (MCOURB,MABSCI)
         END IF
      END IF
      SEGSUP,MABSCI,MABCUR
*
      RETURN
*
*     TRAITEMENT DES ERREURS:
*
  900 CONTINUE
*     ERREUR SUR LE TYPE D'ELEMENT.
      CALL ERREUR (16)
      RETURN
*
      END