subroutine refx(eve,rot,x0,z0,thx0,Rad,Rz,z1,x1,thc,thx1) implicit none integer j, kk, m, count, eve, setup, depth parameter(m=90) integer trig, trigger(m),rot,SMtrig, j2 double precision dtrig, dtrigger(m) double precision z1p,z1n,x1p,x1n,d1p(m),d1n(m),d1(m),min,max double precision x0,z0,thx0,Rad,Rz,slope,inter,z1,x1,thx1 double precision dx(m),thc,sqm(m),aa(m),RRx,Rx(m),mum(m), dis(m) double precision mumtrig(m), aa_p(m), ztest(m), xtest(m), dtest(m) double precision RRxtest(m), degtopi, pi, zconst, thick, space double precision tmpth parameter(zconst=28.0) parameter(degtopi=0.017453292) !? parameter(pi=3.141592654) c this is sampling thrue x each 1mm start from 1mm end on 54mm : data dx/0.10, 0.12, 0.22, 0.24, 0.34, 0.36, 0.46, 0.48, 0.58, !? & 0.60, 0.70, 0.72, 0.82, 0.84, 0.94, 0.96, 1.06, 1.08, 1.18, & 1.20, 1.30, 1.32, 1.42, 1.44, 1.54, 1.56, 1.66, 1.68, 1.78, & 1.80, 1.90, 1.92, 2.02, 2.04, 2.14, 2.16, 2.26, 2.28, 2.38, & 2.40, 2.50, 2.52, 2.62, 2.64, 2.74, 2.76, 2.86, 2.88, 2.98, & 3.00, 3.10, 3.12, 3.22, 3.24, 3.34, 3.36, 3.46, 3.48, 3.58, & 3.60, 3.70, 3.72, 3.82, 3.84, 3.94, 3.96, 4.06, 4.08, 4.18, & 4.20, 4.30, 4.32, 4.42, 4.44, 4.54, 4.56, 4.66, 4.68, 4.78, & 4.80, 4.90, 4.92, 5.02, 5.04, 5.14, 5.16, 5.26, 5.28, 5.38, & 5.40/ c c-------------------------------------------------------------------------- c slope=dtan(thx0) ! in radian ? inter=x0-z0*dtan(thx0) c c-------------------------------------------------------------------------- c 99 format(f5.2) c c Skip the mirror's width c depth=1 ! ? do j=45,1,-1 c R of curvature =10m (1000cm) min=sqrt(Rad**2-Rz**2)+((5.5-((12+(j-1)*12)/100.))-1000) !curvature ? max=sqrt(Rad**2-Rz**2)+((5.5-((10+(j-1)*12)/100.))-1000) if((x0.ge.min.and.x0.le.max)) depth=0 enddo if(depth.eq.1) then do j=1, m sqm(j)=0 aa(j)=0 ztest(j)=0 enddo c----------------- 19 format(i2,2x,f6.2,2x,f8.2,2x,f12.2) 20 format(i2,2x,f6.2,2x,f8.2,2x,f12.2,2x,f8.2,2x,f8.2) count=0 do 101 j=1, m Rx(j)=-1.*Rad+(5.5-dx(j)) aa(j) = inter - Rx(j) mum(j) = 4*((slope**2+1)*Rad**2-(slope*Rz+aa(j))**2) if(mum(j).lt.0) goto 101 z1n = (-2.*(slope*aa(j)-Rz) - sqrt(mum(j)))/ & (2.*(slope**2+1)) z1p = (-2.*(slope*aa(j)-Rz) + sqrt(mum(j)))/ & (2.*(slope**2+1)) if((z1n.le.z0*1.01.or.z1n.gt.zconst) .and. & (z1p.le.z0*1.01.or.z1p.gt.zconst) ) goto 101 count = count + 1 d1n(count) = (z1n-z0)/dcos(thx0) d1p(count) = (z1p-z0)/dcos(thx0) if( (z1n.gt.z0*1.01.and.z1n.lt.zconst) .and. & (z1p.gt.z0*1.01.and.z1p.lt.zconst) ) then if(d1n(count).lt.d1p(count)) then ztest(count)=z1n else ztest(count)=z1p endif elseif((z1n.gt.z0*1.01.and.z1n.lt.zconst) .and. & (z1p.lt.z0*1.01.or.z1p.gt.zconst) ) then ztest(count)=z1n elseif((z1n.lt.z0*1.01.or.z1n.gt.zconst) .and. & (z1p.gt.z0*1.01.and.z1p.lt.zconst) ) then ztest(count)=z1p endif if(d1p(count).lt.0..and.d1n(count).ge.0) then d1(count)=d1n(count) elseif(d1n(count).lt.0..and.d1p(count).ge.0) then d1(count)=d1p(count) elseif(d1n(count)