1 : C COURB2 SOURCE PV 07/11/23 21:16:06 5978 2 : SUBROUTINE COURB2 (MCOURB,LIGNE) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C O U R B 2 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * CONSTRUCTION DE LA COURBE POLYNOMIALE. 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : -INC CCGEOME 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : -INC SMCOORD 22 : -INC SMELEME 23 : -INC TMCOURB 24 : * 25 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 26 : * ----------- 27 : * 28 : * MCOURB (E) SEGMENT ACTIF. 29 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 30 : * +IDCOUL (E) VOIR LE COMMUN "CGEOME". 31 : * +ILCOUR (E) VOIR LE COMMUN "CGEOME". 32 : * +KDEGRE (E) VOIR LE COMMUN "CGEOME". 33 : * +NBNNE (E) VOIR LE COMMUN "CGEOME". 34 : * +MCOORD (E) VOIR LE COMMUN "COPTIO". 35 : * +XPETIT (E) VOIR LE COMMUN "CREEL". 36 : * LIGNE (S) OBJET 'MAILLAGE'. 37 : * 38 : * VARIABLES: 39 : * ---------- 40 : * 41 : * ABSC ABSCISSE CURVILIGNE OU PARAMETRIQUE COURANTE. 42 : * ABSCIS TABLE DES ABSCISSES CURVILIGNES OU PARAMETRIQUES, SELON 43 : * QUE L'ON A L'OPTION "REGULIER" OU NON. 44 : * ON N'Y MET PAS LES ABSCISSES DES EXTREMITES. 45 : * ALONG LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE. 46 : * APROG "RAISON" DE LA PROGRESSION GEOMETRIQUE DES DENSITES 47 : * SUCCESSIVES LE LONG DE LA COURBE. 48 : * D9COU LARGEUR COURANTE DE MAILLE EN UNITES DE LONGUEUR OU 49 : * PARAMETRIQUES (SELON L'OPTION "REGULIER" OU NON). 50 : * MABCUR SEGMENT CREE DANS "COURB3" ET UTILISE DANS "COURB4". 51 : * PT0COU DERNIER POINT CREE AVANT CREATION DES POINTS INTERIEURS 52 : * DE LA COURBE. 53 : * PT9COU POINT COURANT DE LA COURBE. 54 : * 55 : SEGMENT,MABCUR 56 : REAL*8 ABCURV(NPDISC) 57 : ENDSEGMENT 58 : SEGMENT,MABSCI 59 : REAL*8 ABSCIS(NPOIN) 60 : ENDSEGMENT 61 : INTEGER PT0COU,PT9COU 62 : * 63 : * AUTEUR, DATE DE CREATION: 64 : * ------------------------- 65 : * 66 : * PASCAL MANIGOT 8 SEPTEMBRE 1986 67 : * P.M. 6 MARS 1987: AMELIORATION DU CALCUL DE LA DENSITE. 68 : * 69 : * LANGAGE: 70 : * -------- 71 : * 72 : * ESOPE + FORTRAN77 73 : * 74 : ************************************************************************ 75 : * 76 : IF (D1COU.EQ.0. .OR. D2COU.EQ.0.) THEN 76 : CALL ERREUR(17) 77 : RETURN 78 : END IF 79 : * 79 : CALL COURB3 (MCOURB, ALONG,MABCUR) 80 : * CONTRAIREMENT AUX OPERATEURS "DROITE" ET CIE, ON ACCEPTE DE CREER 81 : * UNE COURBE POLYNOMIALE DE LONGUEUR NULLE. CECI EST PARTICULIERE- 82 : * MENT UTILE LORSQUE CETTE COURBE EST LE COTE D'UNE SURFACE 83 : * PARAMETREE. 84 : IF (ALONG .LT. XPETIT) ALONG = XPETIT 85 : * 86 : D1COU = D1COU / ALONG 87 : D2COU = D2COU / ALONG 88 : * 89 : * DETERMINATION DE LA RAISON DES DENSITES SUCCESSIVES (PROGRESSION 90 : * GEOMETRIQUE) ET DU NOMBRE D'ELEMENTS DE LA COURBE: 91 : DEN1=D1COU 92 : DEN2=D2COU 92 : CALL DECOUP(NLMCOU,DEN1,DEN2,APROG,NBELEM,DENI,DECA,ALONG) 93 : D1COU=DEN1 94 : D2COU=DEN2 95 : * 96 : NLMCOU = NBELEM 97 : * 98 : IF (REGCOU) THEN 99 : D1COU = D1COU * ALONG 100 : ELSE 101 : D1COU = D1COU * (U2COU-U1COU) 102 : END IF 103 : IF (ILCOUR .EQ. 0) GOTO 900 104 : ITYPLM = KDEGRE(ILCOUR) 105 : IF (ITYPLM .EQ. 0) GOTO 900 106 : NBNN = NBNNE(ITYPLM) 107 : IF (NBNN .NE. 2 .AND. NBNN .NE. 3) GOTO 900 108 : NBSOUS = 0 109 : NBREF = 0 110 : SEGINI,MELEME 111 : ITYPEL = ITYPLM 112 : DO 150 IB=1,NBELEM 113 : ICOLOR(IB) = IDCOUL 114 : 150 CONTINUE 115 : * END DO 116 : * 117 : NPOIN = NBELEM * (NBNN - 1) - 1 118 : SEGINI,MABSCI 119 : PT0COU = XCOOR(/1) / (IDIM+1) 120 : * 121 : PT9COU = PT0COU 122 : NUM(1,1) = PT1COU 123 : D9COU = D1COU 124 : IF (REGCOU) THEN 125 : ABSC = 0. 126 : ELSE 127 : ABSC = U1COU 128 : END IF 129 : * 130 : IF (NBNN .EQ. 2) THEN 131 : DO 300 IB=1,(NBELEM-1) 132 : PT9COU = PT9COU + 1 133 : NUM(2,IB) = PT9COU 134 : NUM(1,IB+1) = PT9COU 135 : D9COU = D9COU * APROG 136 : ABSC = ABSC + D9COU 137 : ABSCIS(PT9COU-PT0COU) = ABSC 138 : 300 CONTINUE 139 : * END DO 140 : NUM(2,NBELEM) = PT2COU 141 : ELSE 142 : * "NBNN" = 3 143 : DO 310 IB=1,(NBELEM-1) 144 : PT9COU = PT9COU + 1 145 : NUM(2,IB) = PT9COU 146 : D9COU = D9COU * APROG 147 : ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC 148 : PT9COU = PT9COU + 1 149 : NUM(3,IB) = PT9COU 150 : NUM(1,IB+1) = PT9COU 151 : ABSC = ABSC + D9COU 152 : ABSCIS(PT9COU-PT0COU) = ABSC 153 : 310 CONTINUE 154 : * END DO 155 : PT9COU = PT9COU + 1 156 : NUM(2,NBELEM) = PT9COU 157 : D9COU = D9COU * APROG 158 : ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC 159 : NUM(3,NBELEM) = PT2COU 160 : END IF 161 : * 162 : LIGNE = MELEME 163 : SEGDES,MELEME 164 : * 165 : IF (NPOIN .GT. 0) THEN 166 : IF (REGCOU) THEN 166 : CALL COURB4 (MCOURB,MABCUR,MABSCI,ALONG) 167 : ELSE 167 : CALL COURB5 (MCOURB,MABSCI) 168 : END IF 169 : END IF 170 : SEGSUP,MABSCI,MABCUR 171 : * 172 : RETURN 173 : * 174 : * TRAITEMENT DES ERREURS: 175 : * 176 : 900 CONTINUE 177 : * ERREUR SUR LE TYPE D'ELEMENT. 177 : CALL ERREUR (16) 178 : RETURN 179 : * 180 : END 181 : 182 : 183 : 184 : 185 : 186 : 187 : 188 : 189 : 190 :
© Cast3M 2003 - All rights reserved.
Disclaimer