1 SUBROUTINE ECHEL(IOPT,YLAR) 2C 3 INCLUDE 'com_coor.f' 4 INCLUDE 'com_faces.f' 5 INCLUDE 'com_options.f' 6 INCLUDE 'com_vieucu.f' 7C 8 REAL*4 XC(8),YC(8),ZC(8),ROTAINV(3,3) 9 INTEGER IOPO(8),ISUC(4),IPERM(4,6) 10 LOGICAL*4 IFBON(6) 11 DATA ISUC / 2,3,4,1 / 12 DATA IOPO / 7,8,5,6,3,4,1,2 / 13 DATA IPERM / 5,8,4,1 , 2,3,7,6 , 5,1,2,6 , 14 & 4,8,7,3 , 1,4,3,2 , 8,5,6,7 / 15C 16C Echelles 17C 18 IF (IECBOI.GT.0) THEN 19 NOGRILLE = MOD((IECBOI+1)/2,2) 20 ELSE 21 NOGRILLE = 1 22 ENDIF 23 CALL PROBOI(XC,YC,ZC) 24 SENS = REAL(ISENS) 25 IF (IPERSP.EQ.1) THEN 26 DO I=1,6 27 U1 = XC(IPERM(3,I))-XC(IPERM(1,I)) 28 U2 = YC(IPERM(3,I))-YC(IPERM(1,I)) 29 U3 = ZC(IPERM(3,I))-ZC(IPERM(1,I)) 30 V1 = XC(IPERM(4,I))-XC(IPERM(2,I)) 31 V2 = YC(IPERM(4,I))-YC(IPERM(2,I)) 32 V3 = ZC(IPERM(4,I))-ZC(IPERM(2,I)) 33 PMIXT = ( U2*V3+U3*V1+U1*V2 - (U3*V2+U1*V3+U2*V1) )*SENS 34 IFBON(I) = PMIXT.GE.0. 35 ENDDO 36 ELSE 37 DO I=1,6 38 U1 = XC(IPERM(3,I))-XC(IPERM(1,I)) 39 U2 = YC(IPERM(3,I))-YC(IPERM(1,I)) 40 U3 = ZC(IPERM(3,I))-ZC(IPERM(1,I)) 41 V1 = XC(IPERM(4,I))-XC(IPERM(2,I)) 42 V2 = YC(IPERM(4,I))-YC(IPERM(2,I)) 43 V3 = ZC(IPERM(4,I))-ZC(IPERM(2,I)) 44 OBS1 = XPUP(1)-.25* 45 & (XC(IPERM(1,I))+XC(IPERM(2,I))+XC(IPERM(3,I))+XC(IPERM(4,I))) 46 OBS2 = XPUP(2)-.25* 47 & (YC(IPERM(1,I))+YC(IPERM(2,I))+YC(IPERM(3,I))+YC(IPERM(4,I))) 48 OBS3 = XPUP(3)-.25* 49 & (ZC(IPERM(1,I))+ZC(IPERM(2,I))+ZC(IPERM(3,I))+ZC(IPERM(4,I))) 50 PMIXT = ( (U2*V3-U3*V2)*OBS1 51 & + (U3*V1-U1*V3)*OBS2 52 & + (U1*V2-U2*V1)*OBS3 )*SENS 53 IFBON(I) = PMIXT.GE.0. 54 ENDDO 55 ENDIF 56C 57 IF (IOPT.GE.0.AND.IBOITE.NE.0) THEN 58 CALL GSLW(1) 59C Projetion de la courbe sur la boite 60 IF (ICOURXYZ.NE.0.AND.ICOURXYZ.NE.2) THEN 61 CALL GSCOL(4) 62 IMAIL2 = IABS(IMAILL) 63 IF (IMAIL2.EQ.2.OR.IMAIL2.EQ.5) THEN 64 RBOUL = (YDMAX-YDMIN)/120. 65 ELSEIF(IMAIL2.EQ.4.OR.IMAIL2.EQ.7) THEN 66 RBOUL = (YDMAX-YDMIN)/60. 67 ELSE 68 RBOUL = (YDMAX-YDMIN)/250. 69 ENDIF 70 CALL GSMS(5) 71 CALL GSMB(RBOUL,RBOUL) 72 CALL INV3X3(ROTA,ROTAINV,IERR) 73 DO I=1,6 74 IF (.NOT.IFBON(I)) THEN 75 CALL PROPRO(I,X(1),Y(1),Z(1),ROTAINV,SENS,X0,Y0) 76 CALL GSMOVE(X0,Y0) 77 DO N=2,NUMNP 78 CALL PROPRO(I,X(N),Y(N),Z(N),ROTAINV,SENS,X1,Y1) 79 IF (IMAILL.GT.0) CALL GSLINE(X1,Y1) 80 IF (IMAIL2.GE.2) CALL GSMARK(X0,Y0) 81 X0 = X1 82 Y0 = Y1 83 ENDDO 84 IF (IMAIL2.GE.2) CALL GSMARK(X1,Y1) 85 ENDIF 86 ENDDO 87 ENDIF 88 CALL GSCOL(ICOLAX) 89 DO I=1,6 90 IF (.NOT.IFBON(I)) THEN 91 CALL GSMOVE(XBOITE(IPERM(1,I)),YBOITE(IPERM(1,I))) 92 CALL GSLINE(XBOITE(IPERM(2,I)),YBOITE(IPERM(2,I))) 93 CALL GSLINE(XBOITE(IPERM(3,I)),YBOITE(IPERM(3,I))) 94 CALL GSLINE(XBOITE(IPERM(4,I)),YBOITE(IPERM(4,I))) 95 CALL GSLINE(XBOITE(IPERM(1,I)),YBOITE(IPERM(1,I))) 96 ENDIF 97 ENDDO 98cc IF (IECBOI.GE.3) THEN 99 IF (NOGRILLE.EQ.0) THEN 100 CALL GSLT(1) 101 CALL GSLW(-1) 102 DO I=1,6 103 IF (.NOT.IFBON(I)) THEN 104 IF (I.EQ.1) THEN 105 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,8,5,4,1) 106 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,4,8,1,5) 107 ELSEIF(I.EQ.2) THEN 108 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,7,6,3,2) 109 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,3,7,2,6) 110 ELSEIF(I.EQ.3) THEN 111 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,2,6,1,5) 112 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,6,5,2,1) 113 ELSEIF(I.EQ.4) THEN 114 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,4,8,3,7) 115 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,7,8,3,4) 116 ELSEIF(I.EQ.5) THEN 117 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,2,1,3,4) 118 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,3,2,4,1) 119 ELSE 120 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,6,5,7,8) 121 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,7,6,8,5) 122 ENDIF 123 ENDIF 124 ENDDO 125 CALL GSLT(0) 126 CALL GSLW(1) 127 ENDIF 128 IF (IECBOI.GT.0) THEN 129 INUM = MOD(IECBOI,2) 130 IF (IECBOI.GT.4) INUM = INUM+10 131 PRES = -BIG 132 IF (IPERSP.EQ.1) THEN 133 DO I=1,8 134 TOTO = SENS*(XC(I)+YC(I)+ZC(I)) 135 IF (TOTO.GT.PRES) THEN 136 IPRES = I 137 PRES = TOTO 138 ENDIF 139 ENDDO 140 ELSE 141 DO I=1,8 142 TOTO = -SENS*((XC(I)-XPUP(1))**2 143 & +(YC(I)-XPUP(2))**2 144 & +(ZC(I)-XPUP(3))**2) 145 IF (TOTO.GT.PRES) THEN 146 IPRES = I 147 PRES = TOTO 148 ENDIF 149 ENDDO 150 ENDIF 151 ILOIN = IOPO(IPRES) 152 TAILLE = YLAR*.045 153 CALL GSLSS(IFONT1) 154 DO I=1,4 155 J = ISUC(I) 156 K = I+4 157 L = J+4 158 CALL TICS(XC,YC,ZC,I,J,IPRES,ILOIN,TAILLE,INUM) 159 CALL TICS(XC,YC,ZC,I,K,IPRES,ILOIN,TAILLE,INUM) 160 CALL TICS(XC,YC,ZC,K,L,IPRES,ILOIN,TAILLE,INUM) 161 ENDDO 162 ENDIF 163 CALL GSLW(0) 164 ELSEIF(IOPT.EQ.-2) THEN 165 CALL GSCOL(ICTFON) 166 IF (IFOUTLINE.EQ.0) THEN 167 IRESTE = 1 168 DO I=1,NOUTRANG 169 NN = IOUTRANG(I) 170 IF (NN.GE.2) THEN 171 CALL GSPLNE_SPEED(NN,XXOUT(IRESTE,1),YYOUT(IRESTE,1)) 172 IRESTE = IRESTE+NN-1 173 ENDIF 174 CALL GSSEG_SPEED(XXOUT(IRESTE,1),YYOUT(IRESTE,1) 175 & ,XXOUT(IRESTE,2),YYOUT(IRESTE,2)) 176 IRESTE = IRESTE+1 177 ENDDO 178 IF (IRESTE.LE.NOUTLINE) 179 & CALL GSSEG_SPEED(XXOUT(IRESTE,1),YYOUT(IRESTE,1) 180 & ,XXOUT(IRESTE,2),YYOUT(IRESTE,2)) 181 ENDIF 182 DO I=1,NPREC 183 CALL GSPLNEC(4,XPREC(1,I),YPREC(1,I)) 184 ENDDO 185 IF (IFOUTLINE.EQ.0) THEN 186 CALL GSCOL(ICOLAX) 187 NPREC = 0 188 DO I=1,6 189 IF (IFBON(I)) THEN 190 NPREC = NPREC+1 191 XPREC(1,NPREC) = XBOITE(IPERM(1,I)) 192 XPREC(2,NPREC) = XBOITE(IPERM(2,I)) 193 XPREC(3,NPREC) = XBOITE(IPERM(3,I)) 194 XPREC(4,NPREC) = XBOITE(IPERM(4,I)) 195 YPREC(1,NPREC) = YBOITE(IPERM(1,I)) 196 YPREC(2,NPREC) = YBOITE(IPERM(2,I)) 197 YPREC(3,NPREC) = YBOITE(IPERM(3,I)) 198 YPREC(4,NPREC) = YBOITE(IPERM(4,I)) 199 CALL GSPLNEC(4,XPREC(1,NPREC),YPREC(1,NPREC)) 200 ENDIF 201 ENDDO 202 CALL GSCOL(1) 203 IRESTE = 1 204 DO K=1,NOUTRANG 205 NN = IOUTRANG(K) 206 II = IRESTE+NN-1 207 DO I=IRESTE,II 208 CALL ROTATION(XOUT(1,I),YOUT(1,I),ZOUT(1,I),ROTA 209 & ,XR1,YR1,ZR1) 210 CALL PROJEC(XR1,YR1,ZR1,SENS,XXOUT(I,1),YYOUT(I,1),IPERSP 211 & ,XPUP,DIST) 212 ENDDO 213 CALL ROTATION(XOUT(2,II),YOUT(2,II),ZOUT(2,II) 214 & ,ROTA,XR2,YR2,ZR2) 215 CALL PROJEC(XR2,YR2,ZR2,SENS,XXOUT(II,2),YYOUT(II,2) 216 & ,IPERSP,XPUP,DIST) 217 IF (NN.GE.2) THEN 218 CALL GSPLNE_SPEED(NN,XXOUT(IRESTE,1),YYOUT(IRESTE,1)) 219 IRESTE = II 220 ENDIF 221 CALL GSSEG_SPEED(XXOUT(IRESTE,1),YYOUT(IRESTE,1) 222 & ,XXOUT(IRESTE,2),YYOUT(IRESTE,2)) 223 IRESTE = IRESTE+1 224 ENDDO 225 IF (IRESTE.LE.NOUTLINE) THEN 226 CALL ROTATION(XOUT(1,IRESTE),YOUT(1,IRESTE),ZOUT(1,IRESTE) 227 & ,ROTA,XR1,YR1,ZR1) 228 CALL ROTATION(XOUT(2,IRESTE),YOUT(2,IRESTE),ZOUT(2,IRESTE) 229 & ,ROTA,XR2,YR2,ZR2) 230 CALL PROJEC(XR1,YR1,ZR1,SENS,XXOUT(IRESTE,1),YYOUT(IRESTE,1) 231 & ,IPERSP,XPUP,DIST) 232 CALL PROJEC(XR2,YR2,ZR2,SENS,XXOUT(IRESTE,2),YYOUT(IRESTE,2) 233 & ,IPERSP,XPUP,DIST) 234 CALL GSSEG_SPEED(XXOUT(IRESTE,1),YYOUT(IRESTE,1) 235 & ,XXOUT(IRESTE,2),YYOUT(IRESTE,2)) 236 ENDIF 237 ENDIF 238 CALL GSCOL(ICOLAXB) 239 DO I=1,NCOTE 240 CALL GSPLNEC(4,XCOTE(1,I),YCOTE(1,I)) 241 ENDDO 242 CALL GSCOL(ICOLAX) 243 IF (IFOUTLINE.EQ.0) THEN 244 DO I=1,NPREC 245 CALL GSPLNEC(4,XPREC(1,I),YPREC(1,I)) 246 ENDDO 247 ELSE 248 NPREC = 0 249 DO I=1,6 250 IF (IFBON(I)) THEN 251 NPREC = NPREC+1 252 XPREC(1,NPREC) = XBOITE(IPERM(1,I)) 253 XPREC(2,NPREC) = XBOITE(IPERM(2,I)) 254 XPREC(3,NPREC) = XBOITE(IPERM(3,I)) 255 XPREC(4,NPREC) = XBOITE(IPERM(4,I)) 256 YPREC(1,NPREC) = YBOITE(IPERM(1,I)) 257 YPREC(2,NPREC) = YBOITE(IPERM(2,I)) 258 YPREC(3,NPREC) = YBOITE(IPERM(3,I)) 259 YPREC(4,NPREC) = YBOITE(IPERM(4,I)) 260 CALL GSPLNEC(4,XPREC(1,NPREC),YPREC(1,NPREC)) 261 ENDIF 262 ENDDO 263 ENDIF 264 ELSEIF(IOPT.EQ.-3) THEN 265 NCOTE = 0 266 DO I=1,6 267 IF (IFBON(I)) THEN 268 NCOTE = NCOTE+1 269 XCOTE(1,NCOTE) = XBOITE(IPERM(1,I)) 270 XCOTE(2,NCOTE) = XBOITE(IPERM(2,I)) 271 XCOTE(3,NCOTE) = XBOITE(IPERM(3,I)) 272 XCOTE(4,NCOTE) = XBOITE(IPERM(4,I)) 273 YCOTE(1,NCOTE) = YBOITE(IPERM(1,I)) 274 YCOTE(2,NCOTE) = YBOITE(IPERM(2,I)) 275 YCOTE(3,NCOTE) = YBOITE(IPERM(3,I)) 276 YCOTE(4,NCOTE) = YBOITE(IPERM(4,I)) 277 ENDIF 278 ENDDO 279 NPREC = NCOTE 280 DO I=1,NCOTE 281 XPREC(1,I) = XCOTE(1,I) 282 XPREC(2,I) = XCOTE(2,I) 283 XPREC(3,I) = XCOTE(3,I) 284 XPREC(4,I) = XCOTE(4,I) 285 YPREC(1,I) = YCOTE(1,I) 286 YPREC(2,I) = YCOTE(2,I) 287 YPREC(3,I) = YCOTE(3,I) 288 YPREC(4,I) = YCOTE(4,I) 289 ENDDO 290 IF (NOUTLINE.GT.0) THEN 291 DO I=1,NOUTLINE 292 CALL ROTATION(XOUT(1,I),YOUT(1,I),ZOUT(1,I),ROTA 293 & ,XR1,YR1,ZR1) 294 CALL ROTATION(XOUT(2,I),YOUT(2,I),ZOUT(2,I),ROTA 295 & ,XR2,YR2,ZR2) 296 CALL PROJEC(XR1,YR1,ZR1,SENS,XXOUT(I,1),YYOUT(I,1),IPERSP 297 & ,XPUP,DIST) 298 CALL PROJEC(XR2,YR2,ZR2,SENS,XXOUT(I,2),YYOUT(I,2),IPERSP 299 & ,XPUP,DIST) 300 ENDDO 301 ENDIF 302 IF (IBOITE.EQ.2) THEN 303 CALL GSCOL(ICOLAX) 304 DO I=1,NCOTE 305 CALL GSPLNEC(4,XCOTE(1,I),YCOTE(1,I)) 306 ENDDO 307cc IF (IECBOI.GE.3) THEN 308 IF (NOGRILLE.EQ.0) THEN 309 CALL GSLT(1) 310 CALL GSLW(-1) 311 DO I=1,6 312 IF (IFBON(I)) THEN 313 IF (I.EQ.1) THEN 314 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,8,5,4,1) 315 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,4,8,1,5) 316 ELSEIF(I.EQ.2) THEN 317 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,7,6,3,2) 318 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,3,7,2,6) 319 ELSEIF(I.EQ.3) THEN 320 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,2,6,1,5) 321 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,6,5,2,1) 322 ELSEIF(I.EQ.4) THEN 323 CALL GRILLE(PROPZ,NECHZ,XC,YC,ZC,4,8,3,7) 324 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,7,8,3,4) 325 ELSEIF(I.EQ.5) THEN 326 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,2,1,3,4) 327 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,3,2,4,1) 328 ELSE 329 CALL GRILLE(PROPX,NECHX,XC,YC,ZC,6,5,7,8) 330 CALL GRILLE(PROPY,NECHY,XC,YC,ZC,7,6,8,5) 331 ENDIF 332 ENDIF 333 ENDDO 334 CALL GSLT(0) 335 CALL GSLW(1) 336 ENDIF 337 ENDIF 338 ENDIF 339 END 340C----------------------------------------------------------------------- 341 SUBROUTINE ECHELTR 342C 343 INCLUDE 'com_options.f' 344 INCLUDE 'com_vieucu.f' 345C 346 DATA ZERO / 0. / 347C 348C Translation 349C 350 CALL GSCOL(ICTFON) 351 DO I=1,NPREC 352 CALL GSPLNECT(4,XPREC(1,I),YPREC(1,I),DXTRAN0,DYTRAN0) 353 ENDDO 354 CALL GSCOL(ICOLAXB) 355 DO I=1,NPREC 356 CALL GSPLNECT(4,XPREC(1,I),YPREC(1,I),ZERO,ZERO) 357 ENDDO 358 CALL GSCOL(ICOLAX) 359 DO I=1,NPREC 360 CALL GSPLNECT(4,XPREC(1,I),YPREC(1,I),DXTRANS,DYTRANS) 361 ENDDO 362 END 363C----------------------------------------------------------------------- 364 SUBROUTINE GRILLE(PROP,NECH,X,Y,Z,I1,I2,J1,J2) 365 INCLUDE 'com_options.f' 366 DIMENSION PROP(*),X(*),Y(*),Z(*) 367C 368 SENS = REAL(ISENS) 369 DO N=1,NECH 370 X1 = X(I1) + PROP(N)*(X(I2)-X(I1)) 371 X2 = X(J1) + PROP(N)*(X(J2)-X(J1)) 372 Y1 = Y(I1) + PROP(N)*(Y(I2)-Y(I1)) 373 Y2 = Y(J1) + PROP(N)*(Y(J2)-Y(J1)) 374 Z1 = Z(I1) + PROP(N)*(Z(I2)-Z(I1)) 375 Z2 = Z(J1) + PROP(N)*(Z(J2)-Z(J1)) 376 CALL PROJEC(X1,Y1,Z1,SENS,XX1,YY1,IPERSP,XPUP,DIST) 377 CALL PROJEC(X2,Y2,Z2,SENS,XX2,YY2,IPERSP,XPUP,DIST) 378 CALL GSMOVE(XX1,YY1) 379 CALL GSLINE(XX2,YY2) 380 ENDDO 381 END 382C----------------------------------------------------------------------- 383 SUBROUTINE PROPRO(I,XLOC,YLOC,ZLOC,ROTAINV,SENS,XP,YP) 384 INCLUDE 'com_faces.f' 385 INCLUDE 'com_options.f' 386C 387 CALL ROTATION(XLOC,YLOC,ZLOC,ROTAINV,XXX,YYY,ZZZ) 388 IF (I.EQ.1) THEN 389 CALL ROTATION(BX,YYY,ZZZ,ROTA,X,Y,Z) 390 ELSEIF(I.EQ.2) THEN 391 CALL ROTATION(-BX,YYY,ZZZ,ROTA,X,Y,Z) 392 ELSEIF(I.EQ.3) THEN 393 CALL ROTATION(XXX,BY,ZZZ,ROTA,X,Y,Z) 394 ELSEIF(I.EQ.4) THEN 395 CALL ROTATION(XXX,-BY,ZZZ,ROTA,X,Y,Z) 396 ELSEIF(I.EQ.5) THEN 397 CALL ROTATION(XXX,YYY,-BZ,ROTA,X,Y,Z) 398 ELSE 399 CALL ROTATION(XXX,YYY,BZ,ROTA,X,Y,Z) 400 ENDIF 401 CALL PROJEC(X,Y,Z,SENS,XP,YP,IPERSP,XPUP,DIST) 402 END 403 404