1 logical*4 function ca_coupe_clip(x,y,xc,yc) 2 INCLUDE 'Parametres.f' 3 REAL*4 X,Y,XC,YC 4 logical*4 toto 5c 6 if ( (x.ge.x0_clip2.and.x.le.x1_clip2.and. 7 & y.ge.y0_clip2.and.y.le.y1_clip2) .or. 8 & (xc.ge.x0_clip2.and.xc.le.x1_clip2.and. 9 & yc.ge.y0_clip2.and.yc.le.y1_clip2) ) then 10 toto = .true. 11 else 12 toto = .false. 13 if (x.eq.xc) then 14 if (x.lt.x0_clip2.or.x.gt.x1_clip2) goto 10 15 if (y.le.y0_clip2.and.yc.ge.y0_clip2) then 16 toto=.true. 17 goto 10 18 endif 19 if (yc.le.y0_clip2.and.y.ge.y0_clip2) then 20 toto=.true. 21 goto 10 22 endif 23 if (y.le.y1_clip2.and.yc.ge.y1_clip2) then 24 toto=.true. 25 goto 10 26 endif 27 if (yc.le.y1_clip2.and.y.ge.y1_clip2) then 28 toto=.true. 29 goto 10 30 endif 31 else 32 a = (y-yc)/(x-xc) 33 b = y-a*x 34 yy = a*x0_clip2 + b 35 if (yy.ge.y0_clip2.and.yy.le.y1_clip2.and. 36 & ((x-x0_clip2)*(xc-x0_clip2)).le.0.) then 37 toto = .true. 38 goto 10 39 endif 40 yy = a*x1_clip2 + b 41 if (yy.ge.y0_clip2.and.yy.le.y1_clip2.and. 42 & ((x-x1_clip2)*(xc-x1_clip2)).le.0.) then 43 toto = .true. 44 goto 10 45 endif 46 if (a.eq.0.) goto 10 47 xx = (y0_clip2-b)/a 48 if (xx.ge.x0_clip2.and.xx.le.x1_clip2.and. 49 & ((y-y0_clip2)*(yc-y0_clip2)).le.0.) then 50 toto = .true. 51 goto 10 52 endif 53 xx = (y1_clip2-b)/a 54 if (xx.ge.x0_clip2.and.xx.le.x1_clip2.and. 55 & ((y-y1_clip2)*(yc-y1_clip2)).le.0.) then 56 toto = .true. 57 goto 10 58 endif 59 endif 60 endif 61c 62 10 ca_coupe_clip = toto 63 end 64