subroutine outlaldp c from SLAC modified LAL c type 2 plots x-xprime, y-yprime, x-y,x and y profiles c and prints normalized rms, 100% and 90% emittance for c x-xp and y-yp c xmax and ymax in cm c xpmax and ypmax in mrads. c------------------------------------------------------------------------- c include 'param_sz.h' include 'constcom.h' include 'ncordscom.h' include 'ucom.h' c double precision hor(imaa),vrt(imaa),x(imaa) double precision gam double precision xrms,yrms,x90,x100,y90,y100 double precision a,b common/cout7/corout7(6,imaa),spbgs,ne,nbufl,iout7 common/ct/var,rp,dzmin,dzmax,wrm,dwbm,xrmsbg,yrmsbg, 1xsmax,xpsmax,ysmax,ypsmax,istat,nebm c-------------------------------------------------------------------------- c* itest=0 if(iout7.eq.1) then write(nemit,*) ' ' if(itest.eq.1) then write(nemit,*)' units betagamma mm-mrad normalized emittance' write(nemit,*) ' ' itest=1 else write(nemit,*) ' units mm-mrad unormalized emittance' write(nemit,*)' ' endif write(nemit,370) write(nemit,330) else endif nbufe=nbufl c plot xprime vs x n=0 do 10 n10=1,nbufe gam=corout7(6,n10)/erest x(n10)=dsqrt(gam*(2.+gam)) if(x(n10).eq.0.) go to 10 n=n+1 hor(n)=corout7(1,n10) vrt(n)=corout7(2,n10)*1000. 10 continue if (n.lt.50) go to 30 c calculate rms,maxe,90%e and save all three. do 15 np=1,n vrt(np)=x(np)*vrt(np) 15 continue nt90=1 call emit90dp(nt90,n,hor,vrt,a,b,x90,x100,xrms) aax=a bbx=b c plot yprime vs y 30 continue do 40 np=1,n hor(np)=corout7(3,np) vrt(np)=corout7(4,np)*1000. 40 continue if (n.lt.50) go to 60 do 45 np=1,n vrt(np)=x(np)*vrt(np) 45 continue nt90=2 call emit90dp(nt90,n,hor,vrt,a,b,y90,y100,yrms) aay=a bby=b xrms=xrms*10. yrms=yrms*10. x90=x90*10. x100=x100*10. y90=y90*10. y100=y100*10. if(itest.eq.1) then write(nemit, 350) ne,npoints,n,xrms,x90,x100,yrms,y90,y100,spbgs else endif if(spbgs.eq.0) then write(nemit,*) 'Value of bgs in outlal',spbgs return else endif xrms=xrms/spbgs yrms=yrms/spbgs x90=x90/spbgs x100=x100/spbgs y90=y90/spbgs y100=y100/spbgs xrmsbg=4.*spbgs*xrms yrmsbg=4.*spbgs*yrms write(nemit, 350)ne,npoints,n,xrms,x90,x100,yrms,y90,y100,spbgs if(istat.eq.1.and.nebm.ne.0) then write(nstat)var,nebm,n,rp,dzmin,dzmax,wrm,dwbm,xrmsbg,yrmsbg, 1 xsmax,xpsmax,ysmax,ypsmax endif if(itest.eq.1) then write(nemit,*) *' Parametres des ellipses alpha sans unite beta cm/rad' write(nemit,*) ' alpha_x beta_x ',aax,bbx write(nemit,*) ' alpha_y beta_y ',aay,bby endif go to 99 60 continue write(nemit,*) ' ' write(nemit,9013) n,ne 9013 format(' Emittance not calculated np =',i3,' < 50 in element',i4) return 99 continue return c 370 format (/' Emittances are calculated in double precision'/) c change format 330 - 04/94 330 format (' nel part part rms,n emax,n emax,n', 1 ' rms,n emax,n emax,n bg'/ 2 ' no. in out x x,90% x,100%', 3 ' y y,90% y,100%') 350 format (i4,i6,i6,6f9.3,f7.4) 360 format (f9.2,i4,3f8.2,2f8.3,2f9.2) end c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*