1 SUBROUTINE PROJET(NBON,XMIN,XMAX,YMIN,YMAX) 2C 3 INCLUDE 'com_coor.f' 4 INCLUDE 'com_faces.f' 5 INCLUDE 'com_options.f' 6C 7 REAL*8 UU1,UU2,UU3,UU,UN,VN 8 LOGICAL*4 CACHPA 9 DATA US3 / 0.3333333333333333 / 10C 11 XMIN = BIG 12 XMAX = -BIG 13 YMIN = BIG 14 YMAX = -BIG 15C 16 NBON = 0 17 CACHPA = IFC.LT.0.OR.ISHRINK.LT.0 18 & .OR.(ICOURB.LT.0.AND.ICOURXYZ.NE.2) 19 & .OR.I2D.NE.0.OR.IORIENT.LT.0.OR.IFC.EQ.2 20cc & .OR.IPREFC.LT.0.OR.IFC.EQ.2 21 SENS = REAL(ISENS) 22 IF (NDS.EQ.3) THEN 23 KMAX = 1 24 ELSE 25 KMAX = 4 26 ENDIF 27 IF (ICTFAC.EQ.97.OR.ICTFAC.EQ.96) THEN 28 DO I=1,3*NUMNP 29 PHONG(1,I) = 0. 30 PHONG(2,I) = 0. 31 PHONG(3,I) = 0. 32 ITOUCH(I) = 0 33 ENDDO 34 ENDIF 35 IF (NRECON.EQ.ISYM) THEN 36 NRECONCON = 0 37 ELSE 38 NRECONCON = ISYM+1-NRECON 39 ENDIF 40 DO 50 N=1,NFACE 41 IF (IFPLAN(N).LE.NRECONCON.OR.ISHRINK.LE.0) THEN 42 U1 = XF(3,N)-XF(1,N) 43 U2 = YF(3,N)-YF(1,N) 44 U3 = ZF(3,N)-ZF(1,N) 45 V1 = XF(KMAX,N)-XF(2,N) 46 V2 = YF(KMAX,N)-YF(2,N) 47 V3 = ZF(KMAX,N)-ZF(2,N) 48 IF (IPERSP.NE.1) THEN 49 IF (NDS.EQ.3) THEN 50 OBS1 = XPUP(1) - US3*(XF(1,N) + XF(2,N) + XF(3,N)) 51 OBS2 = XPUP(2) - US3*(YF(1,N) + YF(2,N) + YF(3,N)) 52 OBS3 = XPUP(3) - US3*(ZF(1,N) + ZF(2,N) + ZF(3,N)) 53 ELSE 54 OBS1 = XPUP(1) - 0.25*(XF(1,N)+XF(2,N)+XF(3,N)+XF(4,N)) 55 OBS2 = XPUP(2) - 0.25*(YF(1,N)+YF(2,N)+YF(3,N)+YF(4,N)) 56 OBS3 = XPUP(3) - 0.25*(ZF(1,N)+ZF(2,N)+ZF(3,N)+ZF(4,N)) 57 ENDIF 58 PMIXT = ( (U2*V3-U3*V2)*OBS1 59 & + (U3*V1-U1*V3)*OBS2 60 & + (U1*V2-U2*V1)*OBS3 )*SENS 61 ELSE 62 PMIXT = ( U2*V3+U3*V1+U1*V2 - (U3*V2+U1*V3+U2*V1) )*SENS 63 ENDIF 64 IF (PMIXT.GT.0..OR.CACHPA) THEN 65 NBON = NBON + 1 66 DO I=1,NDS 67 CALL PROJEC(XF(I,N),YF(I,N),ZF(I,N),SENS 68 & ,XX(I,NBON),YY(I,NBON),IPERSP,XPUP,DIST) 69 ENDDO 70 ISD(NBON) = ISD2(N) 71 NPROJE(NBON) = N 72 IF (PMIXT.GT.0.) THEN 73 NSENS(NBON) = NNUMFA(N) 74 ELSE 75 NSENS(NBON) = -NNUMFA(N) 76 ENDIF 77 IF (ICTFAC.GT.15) THEN 78 UU1 = U2*V3-V2*U3 79 UU2 = U3*V1-V3*U1 80 UU3 = U1*V2-V1*U2 81 UU = UU1**2+UU2**2+UU3**2 82 UN = U1**2 + U2**2 + U3**2 83 VN = V1**2 + V2**2 + V3**2 84 IF (UN*VN.GT.0.) THEN 85 IF (UU**2.LE.1.D-30*UN*VN) UU = 1. 86 ELSE 87 UU = 1. 88 ENDIF 89 IF (ICTFAC.EQ.99) THEN 90CCCC REFLEC(NBON) = .15+.85*ABS( DIRLUM(1)*UU1 + 91 REFLEC(NBON) = ABS( DIRLUM(1)*UU1 + 92 & DIRLUM(2)*UU2 + 93 & DIRLUM(3)*UU3 ) / SQRT(UU) 94 ELSEIF(ICTFAC.EQ.98) THEN 95 TOTO = ABS( DIRLUM(1)*UU1 + 96 & DIRLUM(2)*UU2 + 97 & DIRLUM(3)*UU3 ) / SQRT(UU) 98ccc TOTO = 2.5*TOTO*TOTO*(TOTO-1.)+TOTO 99ccc TOTO = TOTO*(4.*TOTO*TOTO-6.*TOTO+3.) 100 TOTO = TOTO*(3.*TOTO*TOTO-4.5*TOTO+2.5) 101 REFLEC(NBON) = MIN(1.,MAX(0.,TOTO)) 102Cfj REFLEC(NBON) = .1 + .9*(( DIRLUM(1)*UU1 + 103Cfj & DIRLUM(2)*UU2 + 104Cfj & DIRLUM(3)*UU3 )**2 / UU )**2 105 ELSEIF(N.LE.NF) THEN 106 USQU = 1./SQRT(UU) 107 DO I=1,NDS 108 PHONG(1,NFAC(I,N)) = PHONG(1,NFAC(I,N)) + UU1*USQU 109 PHONG(2,NFAC(I,N)) = PHONG(2,NFAC(I,N)) + UU2*USQU 110 PHONG(3,NFAC(I,N)) = PHONG(3,NFAC(I,N)) + UU3*USQU 111 ITOUCH(NFAC(I,N)) = 1 112 ENDDO 113 ENDIF 114 ENDIF 115 ELSEIF(ICTFAC.GT.15.AND.ICTFAC.LT.98) THEN 116 IF (N.LE.NF) THEN 117 UU1 = U2*V3-V2*U3 118 UU2 = U3*V1-V3*U1 119 UU3 = U1*V2-V1*U2 120 UU = UU1**2+UU2**2 +UU3**2 121 UN = U1**2 + U2**2 + U3**2 122 VN = V1**2 + V2**2 + V3**2 123 IF (UN*VN.GT.0.) THEN 124 IF (UU**2.LE.1.D-30*UN*VN) UU = 1. 125 ELSE 126 UU = 1. 127 ENDIF 128 USQU = 1./SQRT(UU) 129 DO I=1,NDS 130 PHONG(1,NFAC(I,N)) = PHONG(1,NFAC(I,N)) + UU1*USQU 131 PHONG(2,NFAC(I,N)) = PHONG(2,NFAC(I,N)) + UU2*USQU 132 PHONG(3,NFAC(I,N)) = PHONG(3,NFAC(I,N)) + UU3*USQU 133 ITOUCH(NFAC(I,N)) = 1 134 ENDDO 135 ENDIF 136 ENDIF 137 ENDIF 138 50 CONTINUE 139 IF (ICTFAC.GT.15.AND.ICTFAC.LT.98) THEN 140 DO I=1,3*NUMNP 141 IF (ITOUCH(I).NE.0) THEN 142 UU = PHONG(1,I)**2 + PHONG(2,I)**2 + PHONG(3,I)**2 143 IF (UU.LT.1.D-30) UU = 1. 144 USQU = 1./SQRT(UU) 145 DO K=1,3 146 PHONG(K,I) = PHONG(K,I)*USQU 147 ENDDO 148 ENDIF 149 ENDDO 150 ENDIF 151C 152 IF (NBON.EQ.0) THEN 153 XMIN = -1. 154 XMAX = 1. 155 YMIN = -1. 156 YMAX = 1. 157 ELSE 158 CMINI = BIG 159 CMAXI = -BIG 160 IF (NDS.EQ.3) THEN 161 IF (IPERSP.EQ.1) THEN 162 DO N=1,NBON 163 NN = NPROJE(N) 164 C1 = (XF(1,NN)+YF(1,NN)+ZF(1,NN))*SENS 165 C2 = (XF(2,NN)+YF(2,NN)+ZF(2,NN))*SENS 166 C3 = (XF(3,NN)+YF(3,NN)+ZF(3,NN))*SENS 167 CENTRMI(N) = MIN(C1,C2,C3) 168 CENTRMA(N) = MAX(C1,C2,C3) 169 CENTR(N) = (C1+C2+C3)*US3 170Cfj CENTR(N) = (XF(1,NN) + XF(2,NN) + XF(3,NN) 171Cfj & + YF(1,NN) + YF(2,NN) + YF(3,NN) 172Cfj & + ZF(1,NN) + ZF(2,NN) + ZF(3,NN))*SENS3 173 XMIN = MIN(XMIN,XX(1,N),XX(2,N),XX(3,N)) 174 XMAX = MAX(XMAX,XX(1,N),XX(2,N),XX(3,N)) 175 YMIN = MIN(YMIN,YY(1,N),YY(2,N),YY(3,N)) 176 YMAX = MAX(YMAX,YY(1,N),YY(2,N),YY(3,N)) 177 CMINI = MIN(CMINI,CENTR(N)) 178 CMAXI = MAX(CMAXI,CENTR(N)) 179 ENDDO 180 ELSE 181 DO N=1,NBON 182 NN = NPROJE(N) 183 NN = NPROJE(N) 184 C1 =-((XF(1,NN)-XPUP(1))**2 185 & +(YF(1,NN)-XPUP(2))**2 186 & +(ZF(1,NN)-XPUP(3))**2)*SENS 187 C2 =-((XF(2,NN)-XPUP(1))**2 188 & +(YF(2,NN)-XPUP(2))**2 189 & +(ZF(2,NN)-XPUP(3))**2)*SENS 190 C3 =-((XF(3,NN)-XPUP(1))**2 191 & +(YF(3,NN)-XPUP(2))**2 192 & +(ZF(3,NN)-XPUP(3))**2)*SENS 193 CENTRMI(N) = MIN(C1,C2,C3) 194 CENTRMA(N) = MAX(C1,C2,C3) 195 CENTR(N) =-((US3*(XF(1,NN)+XF(2,NN)+XF(3,NN))-XPUP(1))**2 196 & + (US3*(YF(1,NN)+YF(2,NN)+YF(3,NN))-XPUP(2))**2 197 & + (US3*(ZF(1,NN)+ZF(2,NN)+ZF(3,NN))-XPUP(3))**2 198 & )*SENS 199 XMIN = MIN(XMIN,XX(1,N),XX(2,N),XX(3,N)) 200 XMAX = MAX(XMAX,XX(1,N),XX(2,N),XX(3,N)) 201 YMIN = MIN(YMIN,YY(1,N),YY(2,N),YY(3,N)) 202 YMAX = MAX(YMAX,YY(1,N),YY(2,N),YY(3,N)) 203 CMINI = MIN(CMINI,CENTR(N)) 204 CMAXI = MAX(CMAXI,CENTR(N)) 205 ENDDO 206 ENDIF 207 ELSE 208 IF (IPERSP.EQ.1) THEN 209 DO N=1,NBON 210 NN = NPROJE(N) 211 C1 = (XF(1,NN)+YF(1,NN)+ZF(1,NN))*SENS 212 C2 = (XF(2,NN)+YF(2,NN)+ZF(2,NN))*SENS 213 C3 = (XF(3,NN)+YF(3,NN)+ZF(3,NN))*SENS 214 C4 = (XF(4,NN)+YF(4,NN)+ZF(4,NN))*SENS 215 CENTRMI(N) = MIN(C1,C2,C3,C4) 216 CENTRMA(N) = MAX(C1,C2,C3,C4) 217 CENTR(N) = (C1+C2+C3+C4)*0.25 218Cfj CENTR(N) = (XF(1,NN)+XF(2,NN)+XF(3,NN)+XF(4,NN) 219Cfj & + YF(1,NN)+YF(2,NN)+YF(3,NN)+YF(4,NN) 220Cfj & + ZF(1,NN)+ZF(2,NN)+ZF(3,NN)+ZF(4,NN))*SENS4 221 XMIN = MIN(XMIN,XX(1,N),XX(2,N),XX(3,N),XX(4,N)) 222 XMAX = MAX(XMAX,XX(1,N),XX(2,N),XX(3,N),XX(4,N)) 223 YMIN = MIN(YMIN,YY(1,N),YY(2,N),YY(3,N),YY(4,N)) 224 YMAX = MAX(YMAX,YY(1,N),YY(2,N),YY(3,N),YY(4,N)) 225 CMINI = MIN(CMINI,CENTR(N)) 226 CMAXI = MAX(CMAXI,CENTR(N)) 227 ENDDO 228 ELSE 229 DO N=1,NBON 230 NN = NPROJE(N) 231 C1 =-((XF(1,NN)-XPUP(1))**2 232 & +(YF(1,NN)-XPUP(2))**2 233 & +(ZF(1,NN)-XPUP(3))**2)*SENS 234 C2 =-((XF(2,NN)-XPUP(1))**2 235 & +(YF(2,NN)-XPUP(2))**2 236 & +(ZF(2,NN)-XPUP(3))**2)*SENS 237 C3 =-((XF(3,NN)-XPUP(1))**2 238 & +(YF(3,NN)-XPUP(2))**2 239 & +(ZF(3,NN)-XPUP(3))**2)*SENS 240 C4 =-((XF(4,NN)-XPUP(1))**2 241 & +(YF(4,NN)-XPUP(2))**2 242 & +(ZF(4,NN)-XPUP(3))**2)*SENS 243 CENTRMI(N) = MIN(C1,C2,C3,C4) 244 CENTRMA(N) = MAX(C1,C2,C3,C4) 245 CENTR(N) =-( (.25*(XF(1,NN)+XF(2,NN)+XF(3,NN)+XF(4,NN)) 246 & -XPUP(1))**2 247 & + (.25*(YF(1,NN)+YF(2,NN)+YF(3,NN)+YF(4,NN)) 248 & -XPUP(2))**2 249 & + (.25*(ZF(1,NN)+ZF(2,NN)+ZF(3,NN)+ZF(4,NN)) 250 & -XPUP(3))**2 251 & )*SENS 252 XMIN = MIN(XMIN,XX(1,N),XX(2,N),XX(3,N),XX(4,N)) 253 XMAX = MAX(XMAX,XX(1,N),XX(2,N),XX(3,N),XX(4,N)) 254 YMIN = MIN(YMIN,YY(1,N),YY(2,N),YY(3,N),YY(4,N)) 255 YMAX = MAX(YMAX,YY(1,N),YY(2,N),YY(3,N),YY(4,N)) 256 CMINI = MIN(CMINI,CENTR(N)) 257 CMAXI = MAX(CMAXI,CENTR(N)) 258 ENDDO 259 ENDIF 260 ENDIF 261 ENDIF 262C 263 ITOUS = 0 264 DO I=1,NUMSD 265 IF (ISDVU(I).EQ.0) ITOUS = ITOUS+1 266 ENDDO 267 IF (ITOUS.NE.0) THEN 268 NBON2 = 0 269 CMINI = BIG 270 CMAXI = -BIG 271 DO N=1,NBON 272 NSD = MOD(ISD(N),1000) 273 IF (ISDVU(NSD).GT.0) THEN 274 NBON2 = NBON2+1 275 DO I=1,NDS 276 XX(I,NBON2) = XX(I,N) 277 YY(I,NBON2) = YY(I,N) 278 ENDDO 279 ISD(NBON2) = ISD(N) 280 NPROJE(NBON2) = NPROJE(N) 281 CENTRMI(NBON2)= CENTRMI(N) 282 CENTRMA(NBON2)= CENTRMA(N) 283 CENTR(NBON2) = CENTR(N) 284 REFLEC(NBON2) = REFLEC(N) 285 NSENS(NBON2) = NSENS(N) 286 CMINI = MIN(CMINI,CENTR(NBON2)) 287 CMAXI = MAX(CMAXI,CENTR(NBON2)) 288 ENDIF 289 ENDDO 290 NBON = NBON2 291 ENDIF 292C 293 IF (CMINI.EQ.CMAXI) THEN 294 USDC = 1. 295 ELSE 296 USDC = 1./(CMAXI-CMINI) 297 ENDIF 298C 299 END 300C======================================================================= 301 SUBROUTINE PROJEC(X,Y,Z,SENS,XX,YY,IPERSP,XPUP,DIST) 302 DIMENSION XPUP(3) 303ctrans common / dirobs / obsobs(3),uuuu(3),vvvv(3) 304 DATA R3Q2 / .866025403784439 / 305 DATA SQR2 / 1.41421356237310 / 306 DATA SQR6 / 2.44948974278318 / 307C 308 IF (IPERSP.EQ.1) THEN 309 XX = R3Q2*(Y-X)*SENS 310 YY = -.5*(Y+X) + Z 311 ELSE 312 XL = DIST/(X+Y+Z-XPUP(1)-XPUP(2)-XPUP(3)) 313 XX = XL*SQR6*(X-Y)*SENS 314 YY = XL*SQR2*(X+Y-2.*Z) 315ctrans xl = 2.*dist/((x-xpup(1))*obsobs(1) 316ctrans & +(y-xpup(2))*obsobs(2) 317ctrans & +(z-xpup(3))*obsobs(3)) 318ctrans xx = xl*(x*uuuu(1)+y*uuuu(2))*sens 319ctrans yy = xl*(x*vvvv(1)+y*vvvv(2)+z*vvvv(3))*sens 320 ENDIF 321 END 322C======================================================================= 323Cfj SUBROUTINE ZFICTIF(X,Y,Z,YY,ZFIC,IPERSP) 324CfjC 325Cfj IF (IPERSP.EQ.1) THEN 326Cfj ZFIC = Z 327Cfj ELSE 328Cfj ZFIC = YY+.5*(Y+X) 329Cfj ENDIF 330Cfj END 331C======================================================================= 332 SUBROUTINE PROSUR(NBON) 333C 334 INCLUDE 'com_coor.f' 335 INCLUDE 'com_faces.f' 336 INCLUDE 'com_options.f' 337 DATA US3 / .3333333333333333 / 338C 339 SENS = REAL(ISENS) 340Cfj SENS3 = SENS*US3 341Cfj SENS4 = SENS*.25 342 DO I=1,NSURF 343 N = I+NBON 344 NPROJE(N) = NCMAX 345 IF (IPERSP.EQ.1) THEN 346 IF (XIS(3,I).EQ.XIS(4,I).AND.YIS(3,I).EQ.YIS(4,I) 347 & .AND.ZIS(3,I).EQ.ZIS(4,I)) THEN 348 C1 = (XIS(1,I)+YIS(1,I)+ZIS(1,I))*SENS 349 C2 = (XIS(2,I)+YIS(2,I)+ZIS(2,I))*SENS 350 C3 = (XIS(3,I)+YIS(3,I)+ZIS(3,I))*SENS 351 CENTRMI(N) = MIN(C1,C2,C3) 352 CENTRMA(N) = MAX(C1,C2,C3) 353 CENTR(N) = (C1+C2+C3)*US3 354Cfj CENTR(N) = (XIS(1,I) + XIS(2,I) + XIS(3,I) 355Cfj & + YIS(1,I) + YIS(2,I) + YIS(3,I) 356Cfj & + ZIS(1,I) + ZIS(2,I) + ZIS(3,I))*SENS3 357 ELSE 358 C1 = (XIS(1,I)+YIS(1,I)+ZIS(1,I))*SENS 359 C2 = (XIS(2,I)+YIS(2,I)+ZIS(2,I))*SENS 360 C3 = (XIS(3,I)+YIS(3,I)+ZIS(3,I))*SENS 361 C4 = (XIS(4,I)+YIS(4,I)+ZIS(4,I))*SENS 362 CENTRMI(N) = MIN(C1,C2,C3,C4) 363 CENTRMA(N) = MAX(C1,C2,C3,C4) 364 CENTR(N) = (C1+C2+C3+C4)*0.25 365Cfj CENTR(N) = (XIS(1,I) + XIS(2,I) + XIS(3,I) + XIS(4,I) 366Cfj & + YIS(1,I) + YIS(2,I) + YIS(3,I) + YIS(4,I) 367Cfj & + ZIS(1,I) + ZIS(2,I) + ZIS(3,I) + ZIS(4,I) 368Cfj & )*SENS4 369 ENDIF 370 ELSE 371 IF (XIS(3,I).EQ.XIS(4,I).AND.YIS(3,I).EQ.YIS(4,I) 372 & .AND.ZIS(3,I).EQ.ZIS(4,I)) THEN 373 C1 =-((XIS(1,I)-XPUP(1))**2 374 & +(YIS(1,I)-XPUP(2))**2 375 & +(ZIS(1,I)-XPUP(3))**2)*SENS 376 C2 =-((XIS(2,I)-XPUP(1))**2 377 & +(YIS(2,I)-XPUP(2))**2 378 & +(ZIS(2,I)-XPUP(3))**2)*SENS 379 C3 =-((XIS(3,I)-XPUP(1))**2 380 & +(YIS(3,I)-XPUP(2))**2 381 & +(ZIS(3,I)-XPUP(3))**2)*SENS 382 CENTRMI(N) = MIN(C1,C2,C3) 383 CENTRMA(N) = MAX(C1,C2,C3) 384 CENTR(N) =-((US3*(XIS(1,I)+XIS(2,I)+XIS(3,I))-XPUP(1))**2 385 & + (US3*(YIS(1,I)+YIS(2,I)+YIS(3,I))-XPUP(2))**2 386 & + (US3*(ZIS(1,I)+ZIS(2,I)+ZIS(3,I))-XPUP(3))**2 387 & )*SENS 388 ELSE 389 C1 =-((XIS(1,I)-XPUP(1))**2 390 & +(YIS(1,I)-XPUP(2))**2 391 & +(ZIS(1,I)-XPUP(3))**2)*SENS 392 C2 =-((XIS(2,I)-XPUP(1))**2 393 & +(YIS(2,I)-XPUP(2))**2 394 & +(ZIS(2,I)-XPUP(3))**2)*SENS 395 C3 =-((XIS(3,I)-XPUP(1))**2 396 & +(YIS(3,I)-XPUP(2))**2 397 & +(ZIS(3,I)-XPUP(3))**2)*SENS 398 C4 =-((XIS(4,I)-XPUP(1))**2 399 & +(YIS(4,I)-XPUP(2))**2 400 & +(ZIS(4,I)-XPUP(3))**2)*SENS 401 CENTRMI(N) = MIN(C1,C2,C3,C4) 402 CENTRMA(N) = MAX(C1,C2,C3,C4) 403 CENTR(N) =-((.25*(XIS(1,I)+XIS(2,I)+XIS(3,I)+XIS(4,I)) 404 & -XPUP(1))**2 405 & + (.25*(YIS(1,I)+YIS(2,I)+YIS(3,I)+YIS(4,I)) 406 & -XPUP(2))**2 407 & + (.25*(ZIS(1,I)+ZIS(2,I)+ZIS(3,I)+ZIS(4,I)) 408 & -XPUP(3))**2 409 & )*SENS 410 ENDIF 411 ENDIF 412 ENDDO 413 END 414C======================================================================= 415 SUBROUTINE PROFLE(VIVI,N,NN,I) 416 DIMENSION VIVI(2) 417C 418 INCLUDE 'com_coor.f' 419 INCLUDE 'com_faces.f' 420 INCLUDE 'com_options.f' 421 DATA US3 / .3333333333333333 / 422C 423 SENS = REAL(ISENS) 424 FACFAC = (BX+BY+BZ)*.2 425 VX = VITF(1,I,NN) 426 VY = VITF(2,I,NN) 427 VZ = VITF(3,I,NN) 428 VINOR = SQRT(VX**2+VY**2+VZ**2) 429 IF (VINOR.NE.0.) THEN 430 RENOR = FACFAC/VINOR 431 USREN = VINOR/FACFAC 432 IF (IVIT.EQ.-1) THEN 433 APX = XF(I,NN) 434 APY = YF(I,NN) 435 APZ = ZF(I,NN) 436 APXP = XX(I,N) 437 APYP = YY(I,N) 438 ELSE 439 IF (NDS.EQ.3) THEN 440 APX = (XF(1,NN)+XF(2,NN)+XF(3,NN))*US3 441 APY = (YF(1,NN)+YF(2,NN)+YF(3,NN))*US3 442 APZ = (ZF(1,NN)+ZF(2,NN)+ZF(3,NN))*US3 443 ELSE 444 APX = (XF(1,NN)+XF(2,NN)+XF(3,NN)+XF(4,NN))*.25 445 APY = (YF(1,NN)+YF(2,NN)+YF(3,NN)+YF(4,NN))*.25 446 APZ = (ZF(1,NN)+ZF(2,NN)+ZF(3,NN)+ZF(4,NN))*.25 447 ENDIF 448 CALL PROJEC(APX,APY,APZ,SENS,APXP,APYP,IPERSP,XPUP,DIST) 449 ENDIF 450 VVX = APX+(ROTA(1,1)*VX+ROTA(1,2)*VY+ROTA(1,3)*VZ)*RENOR 451 VVY = APY+(ROTA(2,1)*VX+ROTA(2,2)*VY+ROTA(2,3)*VZ)*RENOR 452 VVZ = APZ+(ROTA(3,1)*VX+ROTA(3,2)*VY+ROTA(3,3)*VZ)*RENOR 453 CALL PROJEC(VVX,VVY,VVZ,SENS,VIVI(1),VIVI(2),IPERSP,XPUP,DIST) 454 VIVI(1) = (VIVI(1)-APXP)*USREN 455 VIVI(2) = (VIVI(2)-APYP)*USREN 456 ELSE 457 VIVI(1) = 0. 458 VIVI(2) = 0. 459 ENDIF 460 END 461C======================================================================= 462 SUBROUTINE PROBOI(XC,YC,ZC) 463C 464 INCLUDE 'com_coor.f' 465 INCLUDE 'com_faces.f' 466 INCLUDE 'com_options.f' 467 REAL*4 XC(8),YC(8),ZC(8) 468C 469C Boite 470C 471 CALL ROTATION( BX, BY,-BZ,ROTA,XC(1),YC(1),ZC(1)) 472 CALL ROTATION(-BX, BY,-BZ,ROTA,XC(2),YC(2),ZC(2)) 473 CALL ROTATION(-BX,-BY,-BZ,ROTA,XC(3),YC(3),ZC(3)) 474 CALL ROTATION( BX,-BY,-BZ,ROTA,XC(4),YC(4),ZC(4)) 475 CALL ROTATION( BX, BY, BZ,ROTA,XC(5),YC(5),ZC(5)) 476 CALL ROTATION(-BX, BY, BZ,ROTA,XC(6),YC(6),ZC(6)) 477 CALL ROTATION(-BX,-BY, BZ,ROTA,XC(7),YC(7),ZC(7)) 478 CALL ROTATION( BX,-BY, BZ,ROTA,XC(8),YC(8),ZC(8)) 479C 480 SENS = REAL(ISENS) 481 DO I=1,8 482 CALL PROJEC(XC(I),YC(I),ZC(I),SENS,XBOITE(I),YBOITE(I) 483 & ,IPERSP,XPUP,DIST) 484 ENDDO 485 END 486C======================================================================= 487 SUBROUTINE METLAPERSP 488 INCLUDE 'com_options.f' 489C 490 IF (IPERSP.EQ.-1) THEN 491 DIST = 2.*DIST0 492 ELSEIF(IPERSP.EQ.-2) THEN 493 DIST = DIST0 494 ELSEIF(IPERSP.EQ.-3) THEN 495 DIST = .6*DIST0 496 ENDIF 497 IF (IPERSP.LT.0) THEN 498 XPUP(1) = DIST 499 XPUP(2) = DIST 500 XPUP(3) = DIST 501 ENDIF 502 END 503C======================================================================= 504 SUBROUTINE METLALIGHT 505 INCLUDE 'com_faces.f' 506 INCLUDE 'com_options.f' 507 DATA USR2 / 0.707106781186548 / 508 DATA USR3 / 0.577350269189626 / 509C 510 IF (IDIRL.EQ.0) THEN 511 DIRLUM(1) = USR2 512 DIRLUM(2) = 0. 513 DIRLUM(3) = USR2 514 ELSEIF(IDIRL.EQ.1) THEN 515 DIRLUM(1) = 0. 516 DIRLUM(2) = USR2 517 DIRLUM(3) = USR2 518 ELSEIF(IDIRL.EQ.2) THEN 519 DIRLUM(1) = USR2 520 DIRLUM(2) = USR2 521 DIRLUM(3) = 0. 522 ELSEIF(IDIRL.EQ.3) THEN 523 DIRLUM(1) = 0. 524 DIRLUM(2) = 1. 525 DIRLUM(3) = 0. 526 ELSEIF(IDIRL.EQ.4) THEN 527 DIRLUM(1) = 0. 528 DIRLUM(2) = 0. 529 DIRLUM(3) = 1. 530 ELSEIF(IDIRL.EQ.5) THEN 531 DIRLUM(1) = 1. 532 DIRLUM(2) = 0. 533 DIRLUM(3) = 0. 534 ELSE 535 DIRLUM(1) = USR3 536 DIRLUM(2) = USR3 537 DIRLUM(3) = USR3 538 ENDIF 539 END 540