Numérotation des lignes :

C COURBE    SOURCE    CHAT      05/01/12    22:25:31     5004      SUBROUTINE COURBE      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)**************************************************************************                             C O U R B E*                             -----------**            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COURBE"** FONCTION:* ---------**     CREATION D'UNE COURBE POLYNOMIALE, C'EST-A-DIRE DONT LES POINTS*     "P" VERIFIENT UNE EQUATION:**                         2       3*     P(U) = P0 + U.P1 + U .P2 + U .P3 + ...** PHRASE D'APPEL (EN GIBIANE):* ----------------------------**     LILI = COURBE (N) (DINI DENS1) (DFIN DENS2) (PINI OB1) (PFIN OB2)*                   P0 P1 (P2 (P3 ...) ) (PARAMETRE U1 U2) (REGULIER) ;** OPERANDES ET RESULTATS:* -----------------------**     LILI      'MAILLAGE'  MAILLAGE RESULTANT DE L'OPERATION. OUTRE LA*                           COURBE POLYNOMIALE NOUVELLEMENT CREEE, CE*                           MAILLAGE COMPRENDRA "OB1" ET/OU "OB2", QUE*                           CE SOIENT DES 'POINTS' OU DES 'MAILLAGE'.*     N         'ENTIER  '  NOMBRE D'ELEMENTS GEOMETRIQUES DEMANDE.*                           > 0 : LONGUEURS EGALES DES ELEMENTS.*                           &lt; 0 : LONGUEURS DES ELEMENTS FONCTIONS DES*                           DENSITES DES EXTREMITES DE LA COURBE.*     DINI      'MOT     '*     DENS1     'FLOTTANT'  DENSITE DEMANDEE POUR LE 1ER ELEMENT.*     DFIN      'MOT     '*     DENS2     'FLOTTANT'  DENSITE DEMANDEE POUR LE DERNIER ELEMENT.*     PINI      'MOT     '*     OB1       'POINT   '  POINT INITIAL DE LA COURBE: SERA*                           EFFECTIVEMENT PRIS COMME TEL SI SES*                           COORDONNEES S'OBTIENNENT POUR LA VALEUR "U1"*                           (VOIR DEFINITION PLUS LOIN).*            OU 'MAILLAGE'  LE POINT FINAL DE CET OBJET "OB1" (FORCEMENT*                           UNE LIGNE) SERA LE POINT INITIAL DE LA*                           COURBE (AVEC LES MEMES RESERVES QUE*                           CI-DESSUS) ET "LILI" CONTIENDRA "OB1".*     PFIN      'MOT     '*     OB2       'POINT   '  POINT FINAL DE LA COURBE: SERA EFFECTIVEMENT*                           PRIS COMME TEL SI SES COORDONNEES*                           S'OBTIENNENT POUR LA VALEUR "U2" (VOIR*                           DEFINITION PLUS LOIN).*            OU 'MAILLAGE'  LE POINT INITIAL DE CET OBJET "OB2"*                           (FORCEMENT UNE LIGNE) SERA LE POINT FINAL*                           DE LA COURBE (AVEC LES MEMES RESERVES QUE*                           CI-DESSUS) ET "LILI" CONTIENDRA "OB2".*     P0, P1,   'POINT   '  POINTS DE LA REPRESENTATION POLYNOMIALE DE*     P2, ...               LA COURBE.*                           CES POINTS NE FONT PAS PARTIE DE LA COURBE.*                           "P0" ET "P1" SONT OBLIGATOIRES.*     PARAMETR  'MOT     '*     U1, U2    'FLOTTANT'  BORNES DU PARAMETRE "U" DU POLYNOME DE LA*                           COURBE.*                           = (0,1)  PAR DEFAUT.*     REGULIER  'MOT     '  INDIQUE QUE LA COURBE DEVRA ETRE SUBDIVISEE*                           EN ELEMENTS DONT LES LONGUEURS SERONT*                           ETABLIES SELON L'ABSCISSE CURVILIGNE ET NON*                           PAS SELON LE PARAMETRE "U".** MODULES UTILISES:* -----------------*-INC CCOPTIO-INC CCREEL-INC SMCOORD-INC TMCOURB** VARIABLES:* ----------**     BIDSP, BIDDP = VARIABLES UTILISEES POUR RESOUDRE DES PROBLEMES DE*                    LECTURES DE REELS, TANTOT EN S.P., TANTOT EN D.P.,*                    ET, PEUT-ETRE, BIENTOT EN ON-NE-SAIT-QUOI.*      SEGMENT,MTEMP         INTEGER ITEMP(2)      ENDSEGMENT** CONSTANTES:* -----------**     MOTCLE   LISTE DES MOTS-CLES RECONNUS.*      INTEGER LMOTCL      PARAMETER (LMOTCL = 6)      CHARACTER*4 MOTCLE(LMOTCL)** AUTEUR, DATE DE CREATION:* -------------------------**     PASCAL MANIGOT     11 SEPTEMBRE 1986*     P.M.  25/02/87 : REPRISE.** LANGAGE:* --------**     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS**************************************************************************      REAL*8 RBID(1)      DIMENSION IBID(1)      DATA MOTCLE/'DINI','DFIN','PINI','PFIN','PARA','REGU'/*      LONG = 0      SEGINI,MCOURB**     -- LECTURE DES PARAMETRES PARTICULIERS --**     FACTEUR DE DECOUPAGE:      CALL LIRENT (I,0,IRETOU)      IF (IRETOU .EQ. 1) THEN         NLMCOU = I      ELSE         NLMCOU = 0      END IF*      U1COU = 0.D0      U2COU = 1.D0      D1COU = 0.      D2COU = 0.      PT1COU = 0      LI1COU = 0      PT2COU = 0      LI2COU = 0      REGCOU = .FALSE.**     DO  205    CONTINUE*         IRETOU = 0         CALL LIRMOT (MOTCLE,LMOTCL,IRETOU,0)         IF (IRETOU .LE. 0) THEN*           --> SORTIE DE BOUCLE            GOTO 206         END IF*         GOTO (101,102,103,104,105,106) IRETOU  101    CONTINUE            CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU)            IF (IERR .NE. 0) RETURN            D1COU = BIDDP            GOTO 200  102    CONTINUE            CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU)            IF (IERR .NE. 0) RETURN            D2COU = BIDDP            GOTO 200  103    CONTINUE*           IL FAUT ESSAYER DE LIRE UN "MAILLAGE" AVANT UN "POINT" POUR*           NE PAS LIRE PAR ERREUR LES POINTS-COEFFICIENTS DU POLYNOME.            IRETOU = 0            CALL LIROBJ ('MAILLAGE',I,0,IRETOU)            IF (IRETOU .EQ. 1) THEN               LI1COU = I            ELSE               CALL LIROBJ ('POINT',I,1,IRETOU)               IF (IERR .NE. 0) RETURN               PT1COU = I            END IF            GOTO 200  104    CONTINUE            IRETOU = 0            CALL LIROBJ ('MAILLAGE',I,0,IRETOU)            IF (IRETOU .EQ. 1) THEN               LI2COU = I            ELSE               CALL LIROBJ ('POINT',I,1,IRETOU)               IF (IERR .NE. 0) RETURN               PT2COU = I            END IF            GOTO 200  105    CONTINUE            CALL LIRREE (BIDSP,1,IRETOU)            IF (IERR .NE. 0) RETURN            U1COU = BIDSP            CALL LIRREE (BIDSP,1,IRETOU)            IF (IERR .NE. 0) RETURN            U2COU = BIDSP*           RQ: AUCUNE RELATION D'ORDRE ENTRE "U1COU" ET "U2COU" POUR*               NE PAS IMPOSER, PAR EXEMPLE, AU POINT INITIAL DE*               CORRESPONDRE AU PLUS PETIT PARAMETRE.            GOTO 200  106    CONTINUE            REGCOU = .TRUE.            GOTO 200  200    CONTINUE*         GOTO 205*     END DO  206 CONTINUE**     -- LECTURE DES POINTS DU POLYNOME --*      SEGINI,MTEMP      CALL LIROBJ ('POINT',IP,1,IRETOU)      IF (IERR .NE. 0) RETURN      ITEMP(1) = IP      CALL LIROBJ ('POINT',IP,1,IRETOU)      IF (IERR .NE. 0) RETURN      ITEMP(2) = IP*     DO  305    CONTINUE         CALL LIROBJ ('POINT',IP,0,IRETOU)         IF (IRETOU .EQ. 1) THEN            ITEMP(**) = IP         ELSE*           --> SORTIE DE BOUCLE            GOTO 306         END IF         GOTO 305*     END DO  306 CONTINUE      ND1COU = ITEMP(/1)**     CREATION DES POLYNOMES REELS:      N = ND1COU      SEGINI,MCOFCO      ICOFCO = MCOFCO      SEGACT,MCOORD      IF (IDIM .EQ. 3) THEN         CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),COFCOU(1,3))      ELSE         CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),RBID)      END IF      SEGSUP,MTEMP      SEGDES,MCOFCO*      CALL COURB1 (MCOURB,  LIGNE)      IF (IERR .NE. 0) RETURN      MCOFCO = ICOFCO      SEGSUP,MCOFCO      SEGSUP,MCOURB*      CALL ECROBJ ('MAILLAGE',LIGNE)*      END

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