subroutine surfpl(lin,lu3) c dimension xx(150),yy(150),zz(150) COMMON /AUXI/ IANI(20),INTR,INT1,IOUT,KRE,IREFR,LAY,NDER,IPRINT, 1 MPRINT,NTR,ISQRT,NAUX,ISOUR,MAUX,MREG,MDIM,IPOL,MSCON,LOU, 2 IAMP,MTRNS,ICOEF,IAD,IRHO,ISHEAR,IAC,IRT,mori INTEGER CODE COMMON /COD/ CODE(50,2),KREF,KC,ITYPE COMMON /DIST/ XDST(200),NDSTX,XREPS,DST(2),NDST,REPS,LNDST, 1xprf,yprf COMPLEX PS COMMON /RAY/ AY(28,400),DS(20,20),KINT(20),HHH(3,3),tmax, 1 PS(3,7,20),IS(8,20),DINC,DTOLD,N,IREF,IND,IND1 COMMON /RAY2/ DRY(3,400) c dst(1)=0. mori=1 ndst=1 reps=.001 tmax=.01 ind=1 isour=1 read(lin,100)npar read(lin,102)x0,y0,z0,ddelta if(abs(x0).lt..0001.or.abs(y0).lt..0001.or.abs(z0).lt..0001)then x0=1. y0=1. z0=1. end if if(abs(ddelta).lt..000001)ddelta=.05 write(lou,100)npar write(lou,102)x0,y0,z0,ddelta xprf=x0 yprf=y0 kref=1 itype=0 code(1,1)=1 1 continue inum=0 delta=0. itype=itype+1 code(1,2)=itype if(npar.le.2)ndstx=0 if(npar.eq.3)then ndstx=1 nder=2 mdim=2 end if 2 continue inum=inum+1 if(npar.le.2)then call PROFIL(x0,y0,z0,0.,delta,PAZM,RANG, 1 X,Y,Z,T,.2,.0001,0.,.6,.4,10,3,1,0,12,0) xx(inum)=ay(5,1) yy(inum)=ay(6,1) zz(inum)=ay(7,1) end if if(npar.eq.3)then call PROFIL(x0,y0,z0,0.,delta,PAZM,RANG, 1 X,Y,Z,T,.004,.0001,-.5,1.,.6,10,3,1,0,12,0) if(ind.ne.0)then xx(inum)=dry(1,1) yy(inum)=dry(2,1) zz(inum)=dry(3,1) end if end if delta=delta+ddelta if(delta.lt.6.5)go to 2 write(lu3,100)itype,npar,inum delta=0. do 3 i=1,inum write(lu3,101)delta,xx(i),yy(i),zz(i) delta=delta+ddelta 3 continue if(itype.lt.3)go to 1 itype=0 write(lu3,100)itype c 100 format(16i5) 101 format(4e15.5) 102 format(4f10.5) return end