1 : C SURFP8 SOURCE PV 07/11/23 21:19:42 5978 2 : SUBROUTINE SURFP8 (ETAPE,USUR,VSUR,DSUR,LONG,U1SUR,U2SUR,V1SUR, 3 : & V2SUR,NOMB1,NOMB2,NOMB3,NOMB4) 4 : ************************************************************************ 5 : * 6 : * S U R F P 8 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * - ETAPE 1 : MODIFICATION DES COORDONNEES PARAMETRIQUES EN FONCTION 13 : * DU NOMBRE D'ELEMENTS SUR LES LIGNES DU CONTOUR 14 : * - ETAPE 2 : OPERATION INVERSE 15 : * 16 : * 17 : * MODULES UTILISES: 18 : * ----------------- 19 : * 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT real*8 (a-h,o-z) 22 : -INC CCOPTIO 23 : * 24 : * 25 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 26 : * ----------- 27 : * 28 : * ETAPE (E) = .TRUE. POUR L'ETAPE 1 29 : * = .FALSE. POUR L'ETAPE 2 30 : * USUR() (E) 1ERE COORDONNEE PARAMETRIQUE DE POINTS DE LA SURFACE 31 : * VSUR() (E) 2EME COORDONNEE PARAMETRIQUE DE POINTS DE LA SURFACE 32 : * DSUR() (E) DENSITE DES POINTS DE LA SURFACE,CALCULEE DANS SURFP5 33 : * (SEULEMENT POUR L'ETAPE 2) 34 : * LONG (E) LONGUEUR DES TABLEAUX USUR ET VSUR 35 : * U1SUR (E) BORNE INFERIEURE DU PARAMETRE 'U' 36 : * (VALEUR SAUVEE POUR L'ETAPE 2) 37 : * U2SUR (E) BORNE SUPERIEURE DU PARAMETRE 'U' 38 : * (VALEUR SAUVEE POUR L'ETAPE 2) 39 : * V1SUR (E) BORNE INFERIEURE DU PARAMETRE 'V' 40 : * (VALEUR SAUVEE POUR L'ETAPE 2) 41 : * V2SUR (E) BORNE SUPERIEURE DU PARAMATRE 'V' 42 : * (VALEUR SAUVEE POUR L'ETAPE 2) 43 : * NOMB.. (E) NOMBRE D'ELEMENTS SUR LA LIGNE 44 : * (VALEUR SAUVEE POUR L'ETAPE 2) 45 : * USUR() (S) NOUVELLE 1ERE COORDONNEE PARAMETRIQUE 46 : * VSUR() (S) NOUVELLE 2EME COORDONNEE PARAMETRIQUE 47 : * 48 : INTEGER LONG,NOMB1,NOMB2,NOMB3,NOMB4 49 : LOGICAL ETAPE 50 : REAL*8 USUR(*),VSUR(*),DSUR(*),U1SUR,U2SUR,V1SUR,V2SUR 51 : * 52 : * CONSTANTES: 53 : * ----------- 54 : * 55 : INTEGER KMAX 56 : REAL*8 DEMI,CENT 57 : PARAMETER (DEMI=0.5D0,CENT=100.D0,KMAX=30) 58 : * 59 : * VARIABLES: 60 : * ---------- 61 : * 62 : INTEGER N1,N2,N3,N4 63 : *>>>>> P.M. 26/09/90 64 : *+* REAL U1,U2,V1,V2,U12,U21,V12,V21,UV21,U0,V0,A,UMAX,UMIN,EPSU, 65 : REAL*8 U1,U2,V1,V2,U12,U21,V12,V21,UV21,U0,V0,A,UMAX,UMIN,EPSU, 66 : *<<<<< 67 : & USURB,USURC,USURD,VSURB,VSURC,VSURD,VMAX,VMIN,EPSV 68 : LOGICAL CONVRG 69 : SAVE U0,V0,A,N1,N2,N3,N4,U1,U2,V1,V2,U12,V12 70 : * 71 : * REMARQUES 72 : * --------- 73 : * 74 : * PREMIERE DEFORMATION : CHANGEMENT D'ECHELLE SUIVANT U ET V , 75 : * ALLONGEMENT DE LA SURFACE, (FACTEUR CONSTANT). 76 : * 77 : * DEUXIEME DEFORMATION : LES COMPARAISONS ENTRE COTES OPPOSES 78 : * VONT ENTRAINER DES CHANGEMENTS D'ECHELLE, (FACTEUR LINEAIRE). 79 : * 80 : * AUTEUR, DATE DE CREATION: 81 : * ------------------------- 82 : * 83 : * LIONEL VIVAN 3 DECEMBRE 1987 84 : * 85 : * LANGAGE: 86 : * -------- 87 : * 88 : * FORTRAN77 89 : * 90 : ************************************************************************ 91 : * 92 : IF (ETAPE) THEN 93 : * 94 : * ETAPE A : PREMIERE DEFORMATION 95 : * 96 : U1=U1SUR 97 : U2=U2SUR 98 : V1=V1SUR 99 : V2=V2SUR 100 : N1=NOMB1 101 : N2=NOMB2 102 : N3=NOMB3 103 : N4=NOMB4 104 : U21=(U2-U1)*DEMI 105 : V21=(V2-V1)*DEMI 106 : UV21=ABS(U21/V21) 107 : * 108 : IF ((N1+N3).NE.0 .AND. (N2+N4).NE.0) THEN 109 : A=SQRT(UV21*(N2+N4)/(N1+N3)) 110 : DO 110 I=1,LONG 111 : USUR(I)=USUR(I)/A 112 : VSUR(I)=VSUR(I)*A 113 : 110 CONTINUE 114 : * END DO 115 : U1=U1/A 116 : U2=U2/A 117 : V1=V1*A 118 : V2=V2*A 119 : * 120 : * ETAPE B : DEUXIEME DEFORMATION 121 : * 122 : U12=(U1+U2)*DEMI 123 : V12=(V1+V2)*DEMI 124 : IF (N2.NE.N4 .AND. N1.NE.N3 .AND. N1.NE.0 .AND. 125 : & N2.NE.0 .AND. N3.NE.0 .AND. N4.NE.0) THEN 126 : U0=(N4*U2-N2*U1)/(N4-N2) 127 : V0=(N3*V1-N1*V2)/(N3-N1) 128 : DO 120 I=1,LONG 129 : USURB=USUR(I) 130 : VSURB=VSUR(I) 131 : USUR(I)=U12+(VSURB-V0)*(USURB-U12)/(V12-V0) 132 : VSUR(I)=V12+(USURB-U0)*(VSURB-V12)/(U12-U0) 133 : 120 CONTINUE 134 : * END DO 135 : ELSE IF ((N2.NE.N4 .AND. N1.EQ.N3) .OR. N2.EQ.0 .OR. 136 : & N4.EQ.0) THEN 137 : U0=(N4*U2-N2*U1)/(N4-N2) 138 : DO 130 I=1,LONG 139 : VSUR(I)=V12+(USUR(I)-U0)*(VSUR(I)-V12)/(U12-U0) 140 : 130 CONTINUE 141 : * END DO 142 : ELSE IF ((N1.NE.N3 .AND. N2.EQ.N4) .OR. N1.EQ.0 .OR. 143 : & N3.EQ.0) THEN 144 : V0=(N3*V1-N1*V2)/(N3-N1) 145 : DO 140 I=1,LONG 146 : USUR(I)=U12+(VSUR(I)-V0)*(USUR(I)-U12)/(V12-V0) 147 : 140 CONTINUE 148 : * END DO 149 : END IF 150 : * 151 : ELSE IF ((N2+N4).EQ.0) THEN 152 : * DEGENERESCENCE 2 ET 4 153 : U12=(U1+U2)*DEMI 154 : V12=(V1+V2)*DEMI 155 : DO 150 I=1,LONG 156 : VSURD=(USUR(I)-U1)*(USUR(I)-U2)*(VSUR(I)-V12) 157 : VSUR(I)=V12+VSURD/((U12-U1)*(U12-U2)) 158 : 150 CONTINUE 159 : * END DO 160 : ELSE 161 : * DEGENERESCENCE 1 ET 3 162 : U12=(U1+U2)*DEMI 163 : V12=(V1+V2)*DEMI 164 : DO 160 I=1,LONG 165 : USURD=(VSUR(I)-V1)*(VSUR(I)-V2)*(USUR(I)-U12) 166 : USUR(I)=U12+USURD/((V12-V1)*(V12-V2)) 167 : 160 CONTINUE 168 : * END DO 169 : END IF 170 : * 171 : ELSE 172 : * 173 : *------------------------- ETAPE = .FALSE. -------------------------- 174 : * 175 : IF ((N1+N3).NE.0 .AND. (N2+N4).NE.0) THEN 176 : * 177 : * INVERSION ETAPE B 178 : * 179 : UMAX=MAX(U1,U2) 180 : UMIN=MIN(U1,U2) 181 : VMAX=MAX(V1,V2) 182 : VMIN=MIN(V1,V2) 183 : EPSU=(UMAX-UMIN)/30. 184 : EPSV=(VMAX-VMIN)/30. 185 : IF (IIMPI.EQ.1805) THEN 186 : WRITE(IOIMP,*)'UMAX,UMIN,VMAX,VMIN' 187 : WRITE(IOIMP,*)UMAX,UMIN,VMAX,VMIN 188 : END IF 189 : * 190 : IF (N1.NE.N3 .AND. N2.NE.N4 .AND. N1.NE.0 .AND. 191 : & N2.NE.0 .AND. N3.NE.0 .AND. N4.NE.0) THEN 192 : DO 210 I=1,LONG 193 : USURB=USUR(I) 194 : VSURB=VSUR(I) 195 : IF (VSUR(I).GE.VMAX) THEN 196 : VSUR(I)=VMAX-EPSV 197 : ELSE IF (VSUR(I).LE.VMIN) THEN 198 : VSUR(I)=VMIN+EPSV 199 : END IF 200 : USUR(I)=U12+(V12-V0)*(USURB-U12)/(VSUR(I)-V0) 201 : IF (USUR(I).GE.UMAX) THEN 202 : USUR(I)=UMAX-EPSU 203 : ELSE IF (USUR(I).LE.UMIN) THEN 204 : USUR(I)=UMIN+EPSU 205 : END IF 206 : VSUR(I)=V12+(VSURB-V12)*(U12-U0)/(USUR(I)-U0) 207 : IF (VSUR(I).GE.VMAX) THEN 208 : VSUR(I)=VMAX-EPSV 209 : ELSE IF (VSUR(I).LE.VMIN) THEN 210 : VSUR(I)=VMIN+EPSV 211 : END IF 212 : * 213 : USURC=USUR(I) 214 : VSURC=VSUR(I) 215 : DO 212 K=1,KMAX 216 : USUR(I)=U12+(V12-V0)*(USURB-U12)/(VSUR(I)-V0) 217 : IF (USUR(I).GE.UMAX) THEN 218 : USUR(I)=UMAX-EPSU 219 : ELSE IF (USUR(I).LE.UMIN) THEN 220 : USUR(I)=UMIN+EPSU 221 : END IF 222 : VSUR(I)=V12+(VSURB-V12)*(U12-U0)/(USUR(I)-U0) 223 : IF (VSUR(I).GE.VMAX) THEN 224 : VSUR(I)=VMAX-EPSV 225 : ELSE IF (VSUR(I).LE.VMIN) THEN 226 : VSUR(I)=VMIN+EPSV 227 : END IF 227 : CALL SURF18(K,KMAX,USURC,VSURC,USUR(I),VSUR(I), 228 : & DSUR(I),CONVRG) 229 : IF (CONVRG) THEN 230 : IF (IIMPI.EQ.1805) THEN 231 : WRITE(IOIMP,'(I5)')K 232 : END IF 233 : * EXIT 234 : GOTO 214 235 : END IF 236 : 212 CONTINUE 237 : * END DO 238 : 214 CONTINUE 239 : 210 CONTINUE 240 : * END DO 241 : ELSE IF ((N2.NE.N4 .AND. N1.EQ.N3) .OR. N2.EQ.0 .OR. 242 : & N4.EQ.0) THEN 243 : DO 220 I=1,LONG 244 : VSUR(I)=V12+(VSUR(I)-V12)*(U12-U0)/(USUR(I)-U0) 245 : 220 CONTINUE 246 : * END DO 247 : ELSE IF ((N1.NE.N3 .AND. N2.EQ.N4) .OR. N1.EQ.0 .OR. 248 : & N3.EQ.0) THEN 249 : DO 230 I=1,LONG 250 : USUR(I)=U12+(V12-V0)*(USUR(I)-U12)/(VSUR(I)-V0) 251 : 230 CONTINUE 252 : * END DO 253 : END IF 254 : * 255 : * INVERSION ETAPE A 256 : * 257 : DO 240 I=1,LONG 258 : USUR(I)=USUR(I)*A 259 : VSUR(I)=VSUR(I)/A 260 : 240 CONTINUE 261 : * END DO 262 : * 263 : ELSE IF ((N2+N4).EQ.0) THEN 264 : * DEGENERESCENCE 2 ET 4 265 : DO 250 I=1,LONG 266 : VSURD=(VSUR(I)-V12)*(U12-U1)*(U12-U2) 267 : VSUR(I)=V12+VSURD/((USUR(I)-U1)*(USUR(I)-U2)) 268 : 250 CONTINUE 269 : * END DO 270 : * 271 : ELSE 272 : * DEGENERESCENCE 1 ET 3 273 : DO 260 I=1,LONG 274 : USURD=(USUR(I)-U12)*(V12-V1)*(V12-V2) 275 : USUR(I)=U12+USURD/((VSUR(I)-V1)*(VSUR(I)-V2)) 276 : 260 CONTINUE 277 : * END DO 278 : END IF 279 : END IF 280 : * 281 : END 282 : 283 : 284 :
© Cast3M 2003 - All rights reserved.
Disclaimer