source: PSPA/parmelaPSPA/trunk/outlaldp.f @ 75

      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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*