1 : C SURFP1 SOURCE PV 07/11/24 12:40:32 5979 2 : SUBROUTINE SURFP1 (OPERAU,LIGN01,LIGN02,LIGN03,LIGN04, 3 : $ L0TOUR,msurr) 4 : ************************************************************************ 5 : * 6 : * S U R F P 1 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * 1) LECTURE DES OPERANDES DES OPERATEURS "DALLER" ET "SURFACE" AVEC 13 : * L'OPTION "POLYNOME" (SURFACE PARAMETREE). 14 : * 15 : * 2) MAILLAGE DES COTES DE LA SURFACE (APPEL "SURFP2"). 16 : * 17 : * 3) (EVENTUELLEMENT) DEFINITION DU CONTOUR DE LA SURFACE (APPEL 18 : * "SURFP3"). 19 : * 20 : * PHRASE D'APPEL (EN GIBIANE): 21 : * ---------------------------- 22 : * 23 : * | SURFACE | 24 : * LILI = | DALLER | POLYNOME N M P00 P01 (P02 (P03 ...) ) 25 : * P10 P11 (P12 (P13 ...) ) 26 : * (P20 (P21 (P22 (P23 ...) ) 27 : * ( ... ) 28 : * (PARAMETRE U1 U2 V1 V2) (REGULIER) ; 29 : * 30 : * LE RESULTAT "LILI" EST LE MAILLAGE DE LA SURFACE D'EQUATION: 31 : * 32 : * | P00 P01 P02 P03 .. | | 1 | 33 : * 2 (M-1) | P10 P11 P12 P13 .. | | U | 34 : * P(U,V) = (1 V V ...V ) X | P20 P21 P22 P23 .. | X | .. | 35 : * | ... | |U**(N-1)| 36 : * 37 : * OPERANDES EN GIBIANE: 38 : * --------------------- 39 : * 40 : * N 'ENTIER ' NOMBRE DE COLONNES DE LA MATRICE DE POINTS. 41 : * = (DEGRE EN "U" DU POLYNOME) + 1 42 : * >= 2 43 : * M 'ENTIER ' NOMBRE DE LIGNES DE LA MATRICE DE POINTS. 44 : * = (DEGRE EN "V" DU POLYNOME) + 1 45 : * >= 2 46 : * P00, 'POINT ' COEFFICIENTS DU POLYNOME REPRESENTANT LA 47 : * P01, ... SURFACE PARAMETREE. LES ABSCISSES DES POINTS 48 : * DONNENT LA REPRESENTATION PARAMETRIQUE DES 49 : * ABSCISSES DES POINTS DE LA SURFACE, ETC... 50 : * U1, U2 'FLOTTANT' BORNES DU PARAMETRE "U" = (0,1) PAR DEFAUT. 51 : * V1, V2 'FLOTTANT' BORNES DU PARAMETRE "V" = (0,1) PAR DEFAUT. 52 : * REGULIER 'MOT ' LES POINTS DOIVENT ETRE REGULIEREMENT 53 : * REPARTIS DANS L'ESPACE GEOMETRIQUE (EU EGARD 54 : * AUX DENSITES EXISTANTES) PLUTOT QUE DANS 55 : * L'ESPACE PARAMETRIQUE. 56 : * 57 : * MODULES UTILISES: 58 : * ----------------- 59 : * 60 : IMPLICIT INTEGER(I-N) 61 : IMPLICIT real*8 (a-h,o-z) 62 : -INC CCOPTIO 63 : -INC SMCOORD 64 : -INC TMSURFP 65 : * 66 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 67 : * ----------- 68 : * 69 : * OPERAT (E) NOM DE L'OPERATEUR UTILISE. 70 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 71 : * +MCOORD (E) VOIR LE COMMUN "COPTIO". 72 : * LIGN01 (S) COTE N.1 DE LA SURFACE A MAILLER (OBJET "MAILLAGE"). 73 : * LIGN02 (S) COTE N.2 DE LA SURFACE A MAILLER (OBJET "MAILLAGE"). 74 : * LIGN03 (S) COTE N.3 DE LA SURFACE A MAILLER (OBJET "MAILLAGE"). 75 : * LIGN04 (S) COTE N.4 DE LA SURFACE A MAILLER (OBJET "MAILLAGE"). 76 : * L0TOUR (S) CONTOUR DE LA SURFACE A MAILLER (OBJET "MAILLAGE"). 77 : * FOURNI UNIQUEMENT POUR L'OPERATEUR "SURFACE". 78 : * +MSURFP (S) POINTEUR DE LA SURFACE PARAMETREE. 79 : * LAISSE DANS L'ETAT ACTIF. 80 : * 81 : CHARACTER*4 OPERAT 82 : CHARACTER*(*) OPERAU 83 : INTEGER LIGN01,LIGN02,LIGN03,LIGN04,L0TOUR 84 : REAL*8 XBID 85 : * 86 : * VARIABLES: 87 : * ---------- 88 : * 89 : * LIGNE. = COPIES LOCALES DES ARGUMENTS "LIGN0.", AVEC "."=1,2,3,4. 90 : * LETOUR = COPIE LOCALE DE L'ARGUMENT "L0TOUR". 91 : * 92 : INTEGER LIGNE1,LIGNE2,LIGNE3,LIGNE4,LETOUR 93 : real bidsp 94 : SEGMENT,MTEMP 95 : INTEGER ITEMP(N1*N2) 96 : ENDSEGMENT 97 : POINTEUR MTEMP1.MTEMP 98 : * 99 : * CONSTANTES: 100 : * ----------- 101 : * 102 : * MOTCLE = LISTE DES MOT-CLES RECONNUS. 103 : * 104 : PARAMETER (LMOTCL = 2) 105 : CHARACTER*4 MOTCLE(LMOTCL) 106 : CHARACTER*4 SURF 107 : PARAMETER (SURF = 'SURF') 108 : * 109 : * AUTEUR, DATE DE CREATION: 110 : * ------------------------- 111 : * 112 : * PASCAL MANIGOT 05 MARS 1987 113 : * 114 : * LANGAGE: 115 : * -------- 116 : * 117 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. 118 : * 119 : ************************************************************************ 120 : * 121 : DATA MOTCLE/'PARA','REGU'/ 122 : * 123 : SEGINI,MSURFP 124 : msurr=msurfp 125 : ICOFSU = 0 126 : IUVSUR = 0 127 : IPRSUR = 0 128 : * 129 : * VALEURS PAR DEFAUT DES PARAMETRES 130 : U1SUR = 0.D0 131 : U2SUR = 1.D0 132 : V1SUR = 0.D0 133 : V2SUR = 1.D0 134 : REGSUR = .FALSE. 135 : * 136 : * -- DIMENSIONS DE LA MATRICE -- 137 : * 137 : CALL LIRE03 (2,I,1,IRETOU) 138 : IF (IERR .NE. 0) RETURN 139 : NCOSUR = I 139 : CALL LIRE03 (2,I,1,IRETOU) 140 : IF (IERR .NE. 0) RETURN 141 : NLISUR = I 142 : * 143 : * -- LECTURE DES PARAMETRES PARTICULIERS -- 144 : * 145 : * DO 146 : 205 CONTINUE 147 : * 147 : CALL LIRMOT (MOTCLE,LMOTCL,IRETOU,0) 148 : IF (IRETOU .LE. 0) THEN 149 : * --> SORTIE DE BOUCLE 150 : GOTO 206 151 : END IF 152 : * 153 : GOTO (101,102) IRETOU 154 : 101 CONTINUE 154 : CALL LIRFLO (BIDSP,1,IRETOU) 155 : IF (IERR .NE. 0) RETURN 156 : U1SUR = BIDSP 156 : CALL LIRFLO (BIDSP,1,IRETOU) 157 : IF (IERR .NE. 0) RETURN 158 : U2SUR = BIDSP 159 : IF (U1SUR.EQ.U2SUR) THEN 159 : CALL ERREUR(402) 160 : RETURN 161 : END IF 162 : * RQ: AUCUNE RELATION D'ORDRE ENTRE "U1SUR" ET "U2SUR" POUR 163 : * NE PAS IMPOSER, PAR EXEMPLE, AU COTE 1 DE CORRESPONDRE 164 : * A LA PLUS PETITE VALEUR DE PARAMETRE. 164 : CALL LIRFLO (BIDSP,0,IRETOU) 165 : IF (IRETOU .EQ. 1) V1SUR = BIDSP 165 : CALL LIRFLO (BIDSP,0,IRETOU) 166 : IF (IRETOU .EQ. 1) V2SUR = BIDSP 167 : IF (V1SUR.EQ.V2SUR) THEN 167 : CALL ERREUR(402) 168 : RETURN 169 : END IF 170 : GOTO 200 171 : 102 CONTINUE 172 : REGSUR = .TRUE. 173 : GOTO 200 174 : 200 CONTINUE 175 : * 176 : GOTO 205 177 : * END DO 178 : 206 CONTINUE 179 : * 180 : * -- LECTURE DES POINTS DE LA MATRICE -- 181 : * 182 : N1 = NCOSUR 183 : N2 = NLISUR 184 : SEGINI,MTEMP 185 : N3 = N1 * N2 186 : DO 250 IB=1,N3 186 : CALL LIROBJ ('POINT ',IP,1,IRETOU) 187 : IF (IERR .NE. 0) RETURN 188 : ITEMP(IB) = IP 189 : 250 CONTINUE 190 : * END DO 191 : * 192 : * LA MATRICE A ETE DONNEE LIGNE PAR LIGNE. MAIS C'EST UN RANGEMENT 193 : * COLONNE PAR COLONNE QUI EST INTERESSANT EN FORTRAN (EQUIVALENCE 194 : * AVEC MATRICE RECTANGULAIRE). 195 : SEGINI,MTEMP1 195 : CALL TRSPOS (ITEMP,N1,N2, MTEMP1.ITEMP) 196 : SEGSUP,MTEMP 197 : * 198 : * ECLATEMENT DE LA MATRICE EN MATRICES REELLES: 199 : N = NCOSUR 200 : M = NLISUR 201 : SEGINI,MCOFSU 202 : ICOFSU = MCOFSU 203 : SEGACT,MCOORD 204 : IF (IDIM .EQ. 3) THEN 204 : CALL DCOMP1 (MTEMP1.ITEMP,N3,XCOOR, 205 : & COFSUR(1,1,1),COFSUR(1,1,2),COFSUR(1,1,3)) 206 : ELSE 206 : CALL DCOMP1 (MTEMP1.ITEMP,N3,XCOOR, 207 : & COFSUR(1,1,1),COFSUR(1,1,2),XBID) 208 : END IF 209 : SEGSUP,MTEMP1 210 : SEGDES,MCOFSU 211 : * 212 : * -- DEFINITION DES 4 COTES EN APPLIQUANT LA MATRICE DE POINTS -- 213 : * -- ET DEFINITION DU CONTOUR, POUR L'OPERATEUR "SURFACE" -- 214 : * 215 : OPERAT=OPERAU 215 : CALL SURFP2 (OPERAT,LIGNE1,LIGNE2,LIGNE3,LIGNE4,msurfp) 216 : IF (IERR .NE. 0) RETURN 217 : * 218 : IF (OPERAT .EQ. SURF) THEN 218 : CALL SURFP3 (LIGNE1,LIGNE2,LIGNE3,LIGNE4, LETOUR,msurfp) 219 : L0TOUR = LETOUR 220 : IF (IIMPI.EQ.1804) THEN 220 : CALL ECMAI1(L0TOUR,0) 221 : END IF 222 : *>>>>> P.M. 04/10/90 223 : *+* ELSE 224 : END IF 225 : *<<<<< 226 : LIGN01 = LIGNE1 227 : LIGN02 = LIGNE2 228 : LIGN03 = LIGNE3 229 : LIGN04 = LIGNE4 230 : *>>>>> P.M. 04/10/90 231 : *+* END IF 232 : *<<<<< 233 : * 234 : END 235 : 236 : 237 : 238 : 239 :
© Cast3M 2003 - All rights reserved.
Disclaimer