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