prbpush2lib.f

c-----------------------------------------------------------------------
c 2d parallel PIC library for pushing relativistic particles with
c magnetic field and depositing current
c prbpush2lib.f contains procedures to process relativistic particles
c               with and without magnetic fields:
c PGRJPOST2 deposits 3 component current density, quadratic
c           interpolation, STANDARD optimization, for relativistic
c           particles, and distributed data.
c PGSRJPOST2 deposits 3 component current density, quadratic
c            interpolation, LOOKAHEAD optimization, for relativistic
c            particles, and distributed data.
c PGSRJOST2X deposits 3 component current density, quadratic
c            interpolation, VECTOR optimization, for relativistic
c            particles, and distributed data.
c PGRJPOST2L deposits 3 component current density, linear interpolation,
c            STANDARD optimization, for relativistic particles, and
c            distributed data.
c PGSRJPOST2L deposits 3 component current density, linear
c             interpolation, LOOKAHEAD optimization, for relativistic
c             particles, and distributed data.
c PGSRJOST2XL deposits 3 component current density, linear
c             interpolation, VECTOR optimization, for relativistic
c             particles, and distributed data.
c PGRJPOST22 deposits 2 component current density, quadratic
c            interpolation, STANDARD optimization, for relativistic
c            particles, and distributed data.
c PGSRJPOST22 deposits 2 component current density, quadratic
c             interpolation, LOOKAHEAD optimization, for relativistic
c             particles, and distributed data.
c PGSRJOST22X deposits 2 component current density, quadratic
c             interpolation, VECTOR optimization, for relativistic
c             particles, and distributed data.
c PGRJPOST22L deposits 2 component current density, linear
c             interpolation, STANDARD optimization, for relativistic
c             particles, and distributed data.
c PGSRJPOST22L deposits 2 component current density, linear
c              interpolation, LOOKAHEAD optimization, for relativistic
c              particles, and distributed data.
c PGSRJOST22XL deposits 2 component current density, linear
c              interpolation, VECTOR optimization, for relativistic
c              particles, and distributed data.
c PGRPUSH2 push particles with 2 component electric field, quadratic
c          interpolation, STANDARD optimization, for relativistic
c          particles, and distributed data.
c PGSRPUSH2 push particles with 2 component electric field, quadratic
c           interpolation, LOOKAHEAD optimization, for relativistic
c           particles, and distributed data.
c PGRPUSH2L push particles with 2 component electric field, linear
c           interpolation, STANDARD optimization, for relativistic
c           particles, and distributed data.
c PGSRPUSH2L push particles with 2 component electric field, linear
c            interpolation, LOOKAHEAD optimization, for relativistic
c            particles, and distributed data.
c PGRBPUSH2 push particles with 3 component magnetic field, 2 component
c           electric field, quadratic interpolation, STANDARD
c           optimization, for relativistic particles, and distributed
c           data.
c PGSRBPUSH2 push particles with 3 component magnetic field, 2 component
c            electric field, quadratic interpolation, LOOKAHEAD
c            optimization, for relativistic particles, and distributed
c            data.
c PGRBPUSH2L push particles with 3 component magnetic field, 2 component
c            electric field, linear interpolation, STANDARD optimization,
c            for relativistic particles, and distributed data.
c PGSRBPUSH2L push particles with 3 component magnetic field, 2 component
c             electric field, linear interpolation, LOOKAHEAD
c             optimization, for relativistic particles, and distributed
c             data.
c PGRBPUSH23 push particles with 3 component magnetic field, 3 component
c            electric field, quadratic interpolation, STANDARD
c            optimization, for relativistic particles, and distributed
c            data.
c PGSRBPUSH23 push particles with 3 component magnetic field, 3 component
c             electric field, quadratic interpolation, LOOKAHEAD
c             optimization, for relativistic particles, and distributed
c             data.
c PGRBPUSH23L push particles with 3 component magnetic field, 3 component
c             electric field, linear interpolation, STANDARD
c             optimization, for relativistic particles, and distributed
c             data.
c PGSRBPUSH23L push particles with 3 component magnetic field,
c              3 component electric field, linear interpolation,
c              LOOKAHEAD optimization, for relativistic particles, and
c              distributed data.
c PGRBPUSH22 push particles with 1 component magnetic field, 2 component
c            electric field, quadratic interpolation, STANDARD
c            optimization, for relativistic particles, and distributed
c            data.
c PGSRBPUSH22 push particles with 1 component magnetic field,
c             2 component electric field, quadratic interpolation,
c             LOOKAHEAD optimization, for relativistic particles, and
c             distributed data.
c PGRBPUSH22L push particles with 1 component magnetic field,
c             2 component electric field, linear interpolation, STANDARD
c             optimization, for relativistic particles, and distributed
c             data.
c PGSRBPUSH22L push particles with 1 component magnetic field,
c              2 component electric field, linear interpolation,
c              LOOKAHEAD optimization, for relativistic particles, and
c              distributed data.
c PRRETARD2 retard particle position a half time-step for 2-1/2d code,
c           and relativistic particles, and distributed data.
c PRRETARD22 retard particle position a half time-step for 2d code,
c            and relativistic particles, and distributed data.
c PCPTOV2 converts momentum to velocity for relativistic particles for
c         2-1/2d code, and distributed data.
c PCPTOV22 converts momentum to velocity for relativistic particles for
c          2d code, and distributed data.
c PRPUSH2ZF update particle co-ordinates for particles with fixed
c           velocities, for 2d code, and relativistic particles, and
c           distributed data.
c PRPUSH23ZF update particle co-ordinates for particles with fixed
c            velocities, for 2-1/2d code, and relativistic particles,
c            and distributed data.
c PGRCJPOST2 deposits time-centered particle current density, quadratic
c            interpolation, for relativistic particles, and distributed
c            data.
c PGRCJPOST2L deposits time-centered particle current density, linear
c             interpolation, for relativistic particles, and distributed
c             data.
c written by viktor k. decyk, ucla
c copyright 1999, regents of the university of california
c update: august 29, 2009
c-----------------------------------------------------------------------
      subroutine PGRJPOST2(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax,n
     1blok,nxv,nypmx,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, for distributed data
c 86 flops/particle, 1 divide, 1 sqrt, 32 loads, 29 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,(n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,j+1,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      vz = part(5,j,l)
      p2 = vx*vx + vy*vy + vz*vz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      nl = nn + 1
      amx = qm*(.75 - dxp*dxp)
      ml = mm - mnoff
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = qmh*(.5 - dxp)**2
      np = nl + 2
      dxp = qmh*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c deposit current
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vx*gami
      vy = vy*gami
      vz = vz*gami
      cu(1,nl,mm,l) = cu(1,nl,mm,l) + vx*dx
      cu(2,nl,mm,l) = cu(2,nl,mm,l) + vy*dx
      cu(3,nl,mm,l) = cu(3,nl,mm,l) + vz*dx
      dx = dxl*dyl
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
      cu(3,nn,mm,l) = cu(3,nn,mm,l) + vz*dy
      dy = amx*dyl
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dz
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dz
      cu(3,np,mm,l) = cu(3,np,mm,l) + vz*dz
      dz = dxp*dyl
      cu(1,nl,ml,l) = cu(1,nl,ml,l) + vx*dx
      cu(2,nl,ml,l) = cu(2,nl,ml,l) + vy*dx
      cu(3,nl,ml,l) = cu(3,nl,ml,l) + vz*dx
      dx = dxl*dyp
      cu(1,nn,ml,l) = cu(1,nn,ml,l) + vx*dy
      cu(2,nn,ml,l) = cu(2,nn,ml,l) + vy*dy
      cu(3,nn,ml,l) = cu(3,nn,ml,l) + vz*dy
      dy = amx*dyp
      cu(1,np,ml,l) = cu(1,np,ml,l) + vx*dz
      cu(2,np,ml,l) = cu(2,np,ml,l) + vy*dz
      cu(3,np,ml,l) = cu(3,np,ml,l) + vz*dz
      dz = dxp*dyp
      cu(1,nl,mp,l) = cu(1,nl,mp,l) + vx*dx
      cu(2,nl,mp,l) = cu(2,nl,mp,l) + vy*dx
      cu(3,nl,mp,l) = cu(3,nl,mp,l) + vz*dx
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      cu(3,nn,mp,l) = cu(3,nn,mp,l) + vz*dy
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dz
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dz
      cu(3,np,mp,l) = cu(3,np,mp,l) + vz*dz
c advance position half a time-step
      dx = part(1,j,l) + vx*dt
      dy = part(2,j,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJPOST2(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax,
     1nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996).
c 86 flops/particle, 1 divide, 1 sqrt, 32 loads, 29 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,j+1,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of current array, must be >= nx+3
c nxyp = first actual dimension of current array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
c find inverse gamma
      vxn = part(3,1,l)
      vyn = part(4,1,l)
      vzn = part(5,1,l)
      p2 = vxn*vxn + vyn*vyn + vzn*vzn
      gami = 1.0/sqrt(1.0 + p2*ci2)
      mmn = mmn - mnoff
      do 10 j = 2, npp(l)
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j,l) + .5
      mmn = part(2,j,l) + .5
      dxp = dxn
      dyp = dyn
      dxn = part(1,j,l) - float(nnn)
      dyn = part(2,j,l) - float(mmn)
      ml = mm + nn
      amx = qm*(.75 - dxp*dxp)
      amy = .75 - dyp*dyp
      mn = ml + nxv
      dxl = qmh*(.5 - dxp)**2
      dxp = qmh*(.5 + dxp)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyp)**2
      dyp = .5*(.5 + dyp)**2
      mmn = mmn - mnoff
c calculate weights
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vxn*gami
      vy = vyn*gami
      vz = vzn*gami
c get momentum for next particle
      vxn = part(3,j,l)
      vyn = part(4,j,l)
      vzn = part(5,j,l)
      p2 = vxn*vxn + vyn*vyn + vzn*vzn
c deposit current
      dx1 = cu(1,mn,l) + vx*dx
      dy1 = cu(2,mn,l) + vy*dx
      amy = cu(3,mn,l) + vz*dx
      dx2 = cu(1,mn+1,l) + vx*dy
      dy2 = cu(2,mn+1,l) + vy*dy
      dx3 = cu(3,mn+1,l) + vz*dy
      dx = cu(1,mn+2,l) + vx*dz
      dy = cu(2,mn+2,l) + vy*dz
      dz = cu(3,mn+2,l) + vz*dz
      cu(1,mn,l) = dx1
      cu(2,mn,l) = dy1
      cu(3,mn,l) = amy
      cu(1,mn+1,l) = dx2
      cu(2,mn+1,l) = dy2
      cu(3,mn+1,l) = dx3
      cu(1,mn+2,l) = dx
      cu(2,mn+2,l) = dy
      cu(3,mn+2,l) = dz
      dx = dxl*dyl
      dy = amx*dyl
      dz = dxp*dyl
      dx1 = cu(1,ml,l) + vx*dx
      dy1 = cu(2,ml,l) + vy*dx
      amy = cu(3,ml,l) + vz*dx
      dx2 = cu(1,ml+1,l) + vx*dy
      dy2 = cu(2,ml+1,l) + vy*dy
      dyl = cu(3,ml+1,l) + vz*dy
      dx = cu(1,ml+2,l) + vx*dz
      dy = cu(2,ml+2,l) + vy*dz
      dz = cu(3,ml+2,l) + vz*dz
      cu(1,ml,l) = dx1
      cu(2,ml,l) = dy1
      cu(3,ml,l) = amy
      cu(1,ml+1,l) = dx2
      cu(2,ml+1,l) = dy2
      cu(3,ml+1,l) = dyl
      cu(1,ml+2,l) = dx
      cu(2,ml+2,l) = dy
      cu(3,ml+2,l) = dz
      dx = dxl*dyp
      dy = amx*dyp
      dz = dxp*dyp
      dx1 = cu(1,mp,l) + vx*dx
      dy1 = cu(2,mp,l) + vy*dx
      amy = cu(3,mp,l) + vz*dx
      dxl = cu(1,mp+1,l) + vx*dy
      amx = cu(2,mp+1,l) + vy*dy
      dxp = cu(3,mp+1,l) + vz*dy
      dx = cu(1,mp+2,l) + vx*dz
      dy = cu(2,mp+2,l) + vy*dz
      dz = cu(3,mp+2,l) + vz*dz
      cu(1,mp,l) = dx1
      cu(2,mp,l) = dy1
      cu(3,mp,l) = amy
      cu(1,mp+1,l) = dxl
      cu(2,mp+1,l) = amx
      cu(3,mp+1,l) = dxp
      cu(1,mp+2,l) = dx
      cu(2,mp+2,l) = dy
      cu(3,mp+2,l) = dz
c find inverse gamma for next particle
      gami = 1.0/sqrt(1.0 + p2*ci2)
c advance position half a time-step
      dx = part(1,j-1,l) + vx*dt
      dy = part(2,j-1,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j-1,l)
            part(4,j-1,l) = -part(4,j-1,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
      endif
c set new position
      part(1,j-1,l) = dx
      part(2,j-1,l) = dy
   10 continue
      nop = npp(l)
c deposit current for last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = qm*(.75 - dxn*dxn)
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = qmh*(.5 - dxn)**2
      dxp = qmh*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c deposit current
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vxn*gami
      vy = vyn*gami
      vz = vzn*gami
      cu(1,mn,l) = cu(1,mn,l) + vx*dx
      cu(2,mn,l) = cu(2,mn,l) + vy*dx
      cu(3,mn,l) = cu(3,mn,l) + vz*dx
      cu(1,mn+1,l) = cu(1,mn+1,l) + vx*dy
      cu(2,mn+1,l) = cu(2,mn+1,l) + vy*dy
      cu(3,mn+1,l) = cu(3,mn+1,l) + vz*dy
      cu(1,mn+2,l) = cu(1,mn+2,l) + vx*dz
      cu(2,mn+2,l) = cu(2,mn+2,l) + vy*dz
      cu(3,mn+2,l) = cu(3,mn+2,l) + vz*dz
      dx = dxl*dyl
      dy = amx*dyl
      dz = dxp*dyl
      cu(1,ml,l) = cu(1,ml,l) + vx*dx
      cu(2,ml,l) = cu(2,ml,l) + vy*dx
      cu(3,ml,l) = cu(3,ml,l) + vz*dx
      cu(1,ml+1,l) = cu(1,ml+1,l) + vx*dy
      cu(2,ml+1,l) = cu(2,ml+1,l) + vy*dy
      cu(3,ml+1,l) = cu(3,ml+1,l) + vz*dy
      cu(1,ml+2,l) = cu(1,ml+2,l) + vx*dz
      cu(2,ml+2,l) = cu(2,ml+2,l) + vy*dz
      cu(3,ml+2,l) = cu(3,ml+2,l) + vz*dz
      dx = dxl*dyp
      dy = amx*dyp
      dz = dxp*dyp
      cu(1,mp,l) = cu(1,mp,l) + vx*dx
      cu(2,mp,l) = cu(2,mp,l) + vy*dx
      cu(3,mp,l) = cu(3,mp,l) + vz*dx
      cu(1,mp+1,l) = cu(1,mp+1,l) + vx*dy
      cu(2,mp+1,l) = cu(2,mp+1,l) + vy*dy
      cu(3,mp+1,l) = cu(3,mp+1,l) + vz*dy
      cu(1,mp+2,l) = cu(1,mp+2,l) + vx*dz
      cu(2,mp+2,l) = cu(2,mp+2,l) + vy*dz
      cu(3,mp+2,l) = cu(3,mp+2,l) + vz*dz
c advance position half a time-step
      dx = part(1,nop,l) + vx*dt
      dy = part(2,nop,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJOST2X(part,cu,npp,noff,nn,amxy,qm,dt,ci,nx,ny,idim
     1p,npmax,nblok,nxv,nxvyp,npd,n27,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c with short vectors over independent weights, and distributed data,
c as in j. schwartzmeier and t. hewitt, proc. 12th conf. on numerical
c simulation of plasmas, san francisco, ca, 1987.
c in addition, particle positions are advanced a half time-step
c vectorized version with guard cells and 1d addressing
c 86 flops/particle, 1 divide, 1 sqrt, 87 loads, 83 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,n,l) = ith component of current density at grid point (j,kk),
c where n = j + nxv*kk + 1 and kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c nn = scratch address array for vectorized charge deposition
c amxy = scratch weight array for vectorized charge deposition
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of current array, must be >= nx
c nxvyp = nxv*nypmx, first actual dimension of current array
c npd = size of scratch buffers for vectorized current deposition
c n27 = number of independent weights
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3*nxvyp,nblok)
      dimension npp(nblok), noff(nblok)
      dimension nn(n27,npd,nblok), amxy(n27,npd,nblok)
      nxv3 = 3*nxv
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
c parallel loop
      do 50 l = 1, nblok
      mnoff = noff(l)
      npb = npd
      if (npp(l).gt.npd) then
         ipp = float(npp(l) - 1)/float(npd) + 1.
      else
         ipp = 1
      endif
c outer loop over blocks of particles
      do 40 j = 1, ipp
      jb = (j - 1)*npd
      if (j.ge.ipp) npb = npp(l) - (ipp - 1)*npd
      do 10 i = 1, npb
c find interpolation weights
      n = part(1,i+jb,l) + .5
      m = part(2,i+jb,l) + .5
      dxp = part(1,i+jb,l) - float(n)
      dyp = part(2,i+jb,l) - float(m)
c find inverse gamma
      vx = part(3,i+jb,l)
      vy = part(4,i+jb,l)
      vz = part(5,i+jb,l)
      p2 = vx*vx + vy*vy + vz*vz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      n3 = 3*n + 1
      m = nxv3*(m - mnoff)
      amx = qm*(.75 - dxp*dxp)
      amy = .75 - dyp*dyp
      ml = m + n3
      dxl = qmh*(.5 - dxp)**2
      dxp = qmh*(.5 + dxp)**2
      mn = ml + nxv3
      dyl = .5*(.5 - dyp)**2
      dyp = .5*(.5 + dyp)**2
      mp = mn + nxv3
      nn(1,i,l) = mn
      nn(2,i,l) = mn + 1
      nn(3,i,l) = mn + 2
      nn(4,i,l) = mn + 3
      nn(5,i,l) = mn + 4
      nn(6,i,l) = mn + 5
      nn(7,i,l) = mn + 6
      nn(8,i,l) = mn + 7
      nn(9,i,l) = mn + 8
      nn(10,i,l) = ml
      nn(11,i,l) = ml + 1
      nn(12,i,l) = ml + 2
      nn(13,i,l) = ml + 3
      nn(14,i,l) = ml + 4
      nn(15,i,l) = ml + 5
      nn(16,i,l) = ml + 6
      nn(17,i,l) = ml + 7
      nn(18,i,l) = ml + 8
      nn(19,i,l) = mp
      nn(20,i,l) = mp + 1
      nn(21,i,l) = mp + 2
      nn(22,i,l) = mp + 3
      nn(23,i,l) = mp + 4
      nn(24,i,l) = mp + 5
      nn(25,i,l) = mp + 6
      nn(26,i,l) = mp + 7
      nn(27,i,l) = mp + 8
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vx*gami
      vy = vy*gami
      vz = vz*gami
      amxy(1,i,l) = vx*dx
      amxy(2,i,l) = vy*dx
      amxy(3,i,l) = vz*dx
      dx = dxl*dyl
      amxy(4,i,l) = vx*dy
      amxy(5,i,l) = vy*dy
      amxy(6,i,l) = vz*dy
      dy = amx*dyl
      amxy(7,i,l) = vx*dz
      amxy(8,i,l) = vy*dz
      amxy(9,i,l) = vz*dz
      dz = dxp*dyl
      amxy(10,i,l) = vx*dx
      amxy(11,i,l) = vy*dx
      amxy(12,i,l) = vz*dx
      dx = dxl*dyp
      amxy(13,i,l) = vx*dy
      amxy(14,i,l) = vy*dy
      amxy(15,i,l) = vz*dy
      dy = amx*dyp
      amxy(16,i,l) = vx*dz
      amxy(17,i,l) = vy*dz
      amxy(18,i,l) = vz*dz
      dz = dxp*dyp
      amxy(19,i,l) = vx*dx
      amxy(20,i,l) = vy*dx
      amxy(21,i,l) = vz*dx
      amxy(22,i,l) = vx*dy
      amxy(23,i,l) = vy*dy
      amxy(24,i,l) = vz*dy
      amxy(25,i,l) = vx*dz
      amxy(26,i,l) = vy*dz
      amxy(27,i,l) = vz*dz
c advance position half a time-step
      dx = part(1,i+jb,l) + vx*dt
      dy = part(2,i+jb,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,i+jb,l)
            part(4,i+jb,l) = -part(4,i+jb,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
      endif
c set new position
      part(1,i+jb,l) = dx
      part(2,i+jb,l) = dy
   10 continue
c deposit charge
      do 30 i = 1, npb
cdir$ ivdep
      do 20 k = 1, 27
      cu(nn(k,i,l),l) = cu(nn(k,i,l),l) + amxy(k,i,l)
   20 continue
   30 continue
   40 continue
   50 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRJPOST2L(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax,
     1nblok,nxv,nypmx,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, for distributed data
c 45 flops/particle, 1 divide, 1 sqrt, 17 loads, 14 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qci*dx*(1.-dy)
c cu(i,n,m+1)=qci*(1.-dx)*dy
c cu(i,n+1,m+1)=qci*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,j,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = qm*(part(1,j,l) - float(nn))
      dyp = part(2,j,l) - float(mm)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      vz = part(5,j,l)
      p2 = vx*vx + vy*vy + vz*vz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      nn = nn + 1
      mm = mm - mnoff
      amx = qm - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c deposit current
      dx = dxp*dyp
      dy = amx*dyp
      vx = vx*gami
      vy = vy*gami
      vz = vz*gami
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dx
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dx
      cu(3,np,mp,l) = cu(3,np,mp,l) + vz*dx
      dx = dxp*amy
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      cu(3,nn,mp,l) = cu(3,nn,mp,l) + vz*dy
      dy = amx*amy
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dx
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dx
      cu(3,np,mm,l) = cu(3,np,mm,l) + vz*dx
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
      cu(3,nn,mm,l) = cu(3,nn,mm,l) + vz*dy
c advance position half a time-step
      dx = part(1,j,l) + vx*dt
      dy = part(2,j,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJPOST2L(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax
     1,nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996).
c 45 flops/particle, 1 divide, 1 sqrt, 17 loads, 14 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qm*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qm*dx*(1.-dy)
c cu(i,n,m+1)=qm*(1.-dx)*dy
c cu(i,n+1,m+1)=qm*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,j,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+1
c nxyp = actual first dimension of current array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
c find inverse gamma
      vxn = part(3,1,l)
      vyn = part(4,1,l)
      vzn = part(5,1,l)
      p2 = vxn*vxn + vyn*vyn + vzn*vzn
      gami = 1.0/sqrt(1.0 + p2*ci2)
      mmn = mmn - mnoff
      do 10 j = 2, npp(l)
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j,l)
      mmn = part(2,j,l)
      dxp = qm*dxn
      dyp = dyn
      dxn = part(1,j,l) - float(nnn)
      dyn = part(2,j,l) - float(mmn)
      mm = mm + nn
      amx = qm - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c calculate weights
      dx = dxp*dyp
      dz = amx*dyp
      vx = vxn*gami
      vy = vyn*gami
      vz = vzn*gami
c get momentum for next particle
      vxn = part(3,j,l)
      vyn = part(4,j,l)
      vzn = part(5,j,l)
      p2 = vxn*vxn + vyn*vyn + vzn*vzn
c deposit current
      dx1 = cu(1,mp+1,l) + vx*dx
      dy1 = cu(2,mp+1,l) + vy*dx
      dyp = cu(3,mp+1,l) + vz*dx
      dx = cu(1,mp,l) + vx*dz
      dy = cu(2,mp,l) + vy*dz
      dz = cu(3,mp,l) + vz*dz
      cu(1,mp+1,l) = dx1
      cu(2,mp+1,l) = dy1
      cu(3,mp+1,l) = dyp
      cu(1,mp,l) = dx
      cu(2,mp,l) = dy
      cu(3,mp,l) = dz
      dx = dxp*amy
      dz = amx*amy
      dxp = cu(1,mm+1,l) + vx*dx
      amx = cu(2,mm+1,l) + vy*dx
      dyp = cu(3,mm+1,l) + vz*dx
      dx = cu(1,mm,l) + vx*dz
      dy = cu(2,mm,l) + vy*dz
      dz = cu(3,mm,l) + vz*dz
      cu(1,mm+1,l) = dxp
      cu(2,mm+1,l) = amx
      cu(3,mm+1,l) = dyp
      cu(1,mm,l) = dx
      cu(2,mm,l) = dy
      cu(3,mm,l) = dz
c find inverse gamma for next particle
      gami = 1.0/sqrt(1.0 + p2*ci2)
c advance position half a time-step
      dx = part(1,j-1,l) + vx*dt
      dy = part(2,j-1,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j-1,l)
            part(4,j-1,l) = -part(4,j-1,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
      endif
c set new position
      part(1,j-1,l) = dx
      part(2,j-1,l) = dy
   10 continue
      nop = npp(l)
c deposit current for last particle
      nn = nnn + 1
      mm = nxv*mmn
      dxp = qm*dxn
      mm = mm + nn
      amx = qm - dxp
      mp = mm + nxv
      amy = 1. - dyn
c deposit current
      dx = dxp*dyn
      dy = amx*dyn
      vx = vxn*gami
      vy = vyn*gami
      vz = vzn*gami
      cu(1,mp+1,l) = cu(1,mp+1,l) + vx*dx
      cu(2,mp+1,l) = cu(2,mp+1,l) + vy*dx
      cu(3,mp+1,l) = cu(3,mp+1,l) + vz*dx
      cu(1,mp,l) = cu(1,mp,l) + vx*dy
      cu(2,mp,l) = cu(2,mp,l) + vy*dy
      cu(3,mp,l) = cu(3,mp,l) + vz*dy
      dx = dxp*amy
      dy = amx*amy
      cu(1,mm+1,l) = cu(1,mm+1,l) + vx*dx
      cu(2,mm+1,l) = cu(2,mm+1,l) + vy*dx
      cu(3,mm+1,l) = cu(3,mm+1,l) + vz*dx
      cu(1,mm,l) = cu(1,mm,l) + vx*dy
      cu(2,mm,l) = cu(2,mm,l) + vy*dy
      cu(3,mm,l) = cu(3,mm,l) + vz*dy
c advance position half a time-step
      dx = part(1,nop,l) + vx*dt
      dy = part(2,nop,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJOST2XL(part,cu,npp,noff,nn,amxy,qm,dt,ci,nx,ny,idi
     1mp,npmax,nblok,nxv,nxvyp,npd,n12,ipbc)
c for 2-1/2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c with short vectors over independent weights, and distributed data,
c as in j. schwartzmeier and t. hewitt, proc. 12th conf. on numerical
c simulation of plasmas, san francisco, ca, 1987.
c in addition, particle positions are advanced a half time-step
c vectorized distributed version with guard cells and 1d addressing
c 45 flops/particle, 1 divide, 1 sqrt, 41 loads, 38 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qci*dx*(1.-dy)
c cu(i,n,m+1)=qci*(1.-dx)*dy
c cu(i,n+1,m+1)=qci*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y,z
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c cu(i,n,l) = charge density at grid point (j,kk),
c where n = j + nxv*(kk - 1) and  kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c nn = scratch address array for vectorized charge deposition
c amxy = scratch weight array for vectorized charge deposition
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of charge array, must be >= nx+1
c nxvyp = nxv*nypmx, first actual dimension of charge array
c npd = size of scratch buffers for vectorized charge deposition
c n12 = number of independent weights
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(3*nxvyp,nblok)
      dimension npp(nblok), noff(nblok)
      dimension nn(n12,npd,nblok), amxy(n12,npd,nblok)
      nxv3 = 3*nxv
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
c parallel loop
      do 50 l = 1, nblok
      mnoff = noff(l)
      npb = npd
      if (npp(l).gt.npd) then
         ipp = float(npp(l) - 1)/float(npd) + 1.
      else
         ipp = 1
      endif
c outer loop over blocks of particles
      do 40 j = 1, ipp
      jb = (j - 1)*npd
      if (j.ge.ipp) npb = npp(l) - (ipp - 1)*npd
      do 10 i = 1, npb
c find interpolation weights
      n = part(1,i+jb,l)
      m = part(2,i+jb,l)
      dxp = qm*(part(1,i+jb,l) - float(n))
      dyp = part(2,i+jb,l) - float(m)
c find inverse gamma
      vx = part(3,i+jb,l)
      vy = part(4,i+jb,l)
      vz = part(5,i+jb,l)
      p2 = vx*vx + vy*vy + vz*vz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      n3 = 3*n + 1
      mm = nxv3*(m - mnoff)
      amx = qm - dxp
      mm = mm + n3
      amy = 1. - dyp
      mp = mm + nxv3
      nn(10,i,l) = mm
      nn(11,i,l) = mm + 1
      nn(12,i,l) = mm + 2
      nn(7,i,l) = mm + 3
      nn(8,i,l) = mm + 4
      nn(9,i,l) = mm + 5
      nn(4,i,l) = mp
      nn(5,i,l) = mp + 1
      nn(6,i,l) = mp + 2
      nn(1,i,l) = mp + 3
      nn(2,i,l) = mp + 4
      nn(3,i,l) = mp + 5
      dx = dxp*dyp
      dy = amx*dyp
      vx = vx*gami
      vy = vy*gami
      vz = vz*gami
      amxy(1,i,l) = vx*dx
      amxy(2,i,l) = vy*dx
      amxy(3,i,l) = vz*dx
      amxy(4,i,l) = vx*dy
      amxy(5,i,l) = vy*dy
      amxy(6,i,l) = vz*dy
      dx = dxp*amy
      dy = amx*amy
      amxy(7,i,l) = vx*dx
      amxy(8,i,l) = vy*dx
      amxy(9,i,l) = vz*dx
      amxy(10,i,l) = vx*dy
      amxy(11,i,l) = vy*dy
      amxy(12,i,l) = vz*dy
c advance position half a time-step
      dx = part(1,i+jb,l) + vx*dt
      dy = part(2,i+jb,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,i+jb,l)
            part(4,i+jb,l) = -part(4,i+jb,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
      endif
c set new position
      part(1,i+jb,l) = dx
      part(2,i+jb,l) = dy
   10 continue
c deposit charge
      do 30 i = 1, npb
cdir$ ivdep
      do 20 k = 1, 12
      cu(nn(k,i,l),l) = cu(nn(k,i,l),l) + amxy(k,i,l)
   20 continue
   30 continue
   40 continue
   50 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRJPOST22(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax,
     1nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, for distributed data
c 65 flops/particle, 1 divide, 1 sqrt, 22 loads, 20 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,(n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,j+1,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      nl = nn + 1
      amx = qm*(.75 - dxp*dxp)
      ml = mm - mnoff
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = qmh*(.5 - dxp)**2
      np = nl + 2
      dxp = qmh*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c deposit current
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vx*gami
      vy = vy*gami
      cu(1,nl,mm,l) = cu(1,nl,mm,l) + vx*dx
      cu(2,nl,mm,l) = cu(2,nl,mm,l) + vy*dx
      dx = dxl*dyl
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
      dy = amx*dyl
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dz
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dz
      dz = dxp*dyl
      cu(1,nl,ml,l) = cu(1,nl,ml,l) + vx*dx
      cu(2,nl,ml,l) = cu(2,nl,ml,l) + vy*dx
      dx = dxl*dyp
      cu(1,nn,ml,l) = cu(1,nn,ml,l) + vx*dy
      cu(2,nn,ml,l) = cu(2,nn,ml,l) + vy*dy
      dy = amx*dyp
      cu(1,np,ml,l) = cu(1,np,ml,l) + vx*dz
      cu(2,np,ml,l) = cu(2,np,ml,l) + vy*dz
      dz = dxp*dyp
      cu(1,nl,mp,l) = cu(1,nl,mp,l) + vx*dx
      cu(2,nl,mp,l) = cu(2,nl,mp,l) + vy*dx
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dz
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dz
c advance position half a time-step
      dx = part(1,j,l) + vx*dt
      dy = part(2,j,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJPOST22(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax
     1,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996).
c 65 flops/particle, 1 divide, 1 sqrt, 22 loads, 20 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,j+1,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of current array, must be >= nx+3
c nxyp = first actual dimension of current array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
c find inverse gamma
      vxn = part(3,1,l)
      vyn = part(4,1,l)
      p2 = vxn*vxn + vyn*vyn
      gami = 1.0/sqrt(1.0 + p2*ci2)
      mmn = mmn - mnoff
      do 10 j = 2, npp(l)
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j,l) + .5
      mmn = part(2,j,l) + .5
      dxp = dxn
      dyp = dyn
      dxn = part(1,j,l) - float(nnn)
      dyn = part(2,j,l) - float(mmn)
      ml = mm + nn
      amx = qm*(.75 - dxp*dxp)
      amy = .75 - dyp*dyp
      mn = ml + nxv
      dxl = qmh*(.5 - dxp)**2
      dxp = qmh*(.5 + dxp)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyp)**2
      dyp = .5*(.5 + dyp)**2
      mmn = mmn - mnoff
c calculate weights
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vxn*gami
      vy = vyn*gami
c get momentum for next particle
      vxn = part(3,j,l)
      vyn = part(4,j,l)
      p2 = vxn*vxn + vyn*vyn
c deposit current
      dx1 = cu(1,mn,l) + vx*dx
      dy1 = cu(2,mn,l) + vy*dx
      dx2 = cu(1,mn+1,l) + vx*dy
      dy2 = cu(2,mn+1,l) + vy*dy
      dx = cu(1,mn+2,l) + vx*dz
      dy = cu(2,mn+2,l) + vy*dz
      cu(1,mn,l) = dx1
      cu(2,mn,l) = dy1
      cu(1,mn+1,l) = dx2
      cu(2,mn+1,l) = dy2
      cu(1,mn+2,l) = dx
      cu(2,mn+2,l) = dy
      dx = dxl*dyl
      dy = amx*dyl
      dz = dxp*dyl
      dx1 = cu(1,ml,l) + vx*dx
      dy1 = cu(2,ml,l) + vy*dx
      dx2 = cu(1,ml+1,l) + vx*dy
      dy2 = cu(2,ml+1,l) + vy*dy
      dx = cu(1,ml+2,l) + vx*dz
      dy = cu(2,ml+2,l) + vy*dz
      cu(1,ml,l) = dx1
      cu(2,ml,l) = dy1
      cu(1,ml+1,l) = dx2
      cu(2,ml+1,l) = dy2
      cu(1,ml+2,l) = dx
      cu(2,ml+2,l) = dy
      dx = dxl*dyp
      dy = amx*dyp
      dz = dxp*dyp
      dx1 = cu(1,mp,l) + vx*dx
      dy1 = cu(2,mp,l) + vy*dx
      dxl = cu(1,mp+1,l) + vx*dy
      amx = cu(2,mp+1,l) + vy*dy
      dx = cu(1,mp+2,l) + vx*dz
      dy = cu(2,mp+2,l) + vy*dz
      cu(1,mp,l) = dx1
      cu(2,mp,l) = dy1
      cu(1,mp+1,l) = dxl
      cu(2,mp+1,l) = amx
      cu(1,mp+2,l) = dx
      cu(2,mp+2,l) = dy
c find inverse gamma for next particle
      gami = 1.0/sqrt(1.0 + p2*ci2)
c advance position half a time-step
      dx = part(1,j-1,l) + vx*dt
      dy = part(2,j-1,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j-1,l)
            part(4,j-1,l) = -part(4,j-1,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
      endif
c set new position
      part(1,j-1,l) = dx
      part(2,j-1,l) = dy
   10 continue
      nop = npp(l)
c deposit current for last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = qm*(.75 - dxn*dxn)
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = qmh*(.5 - dxn)**2
      dxp = qmh*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c deposit current
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vxn*gami
      vy = vyn*gami
      cu(1,mn,l) = cu(1,mn,l) + vx*dx
      cu(2,mn,l) = cu(2,mn,l) + vy*dx
      cu(1,mn+1,l) = cu(1,mn+1,l) + vx*dy
      cu(2,mn+1,l) = cu(2,mn+1,l) + vy*dy
      cu(1,mn+2,l) = cu(1,mn+2,l) + vx*dz
      cu(2,mn+2,l) = cu(2,mn+2,l) + vy*dz
      dx = dxl*dyl
      dy = amx*dyl
      dz = dxp*dyl
      cu(1,ml,l) = cu(1,ml,l) + vx*dx
      cu(2,ml,l) = cu(2,ml,l) + vy*dx
      cu(1,ml+1,l) = cu(1,ml+1,l) + vx*dy
      cu(2,ml+1,l) = cu(2,ml+1,l) + vy*dy
      cu(1,ml+2,l) = cu(1,ml+2,l) + vx*dz
      cu(2,ml+2,l) = cu(2,ml+2,l) + vy*dz
      dx = dxl*dyp
      dy = amx*dyp
      dz = dxp*dyp
      cu(1,mp,l) = cu(1,mp,l) + vx*dx
      cu(2,mp,l) = cu(2,mp,l) + vy*dx
      cu(1,mp+1,l) = cu(1,mp+1,l) + vx*dy
      cu(2,mp+1,l) = cu(2,mp+1,l) + vy*dy
      cu(1,mp+2,l) = cu(1,mp+2,l) + vx*dz
      cu(2,mp+2,l) = cu(2,mp+2,l) + vy*dz
c advance position half a time-step
      dx = part(1,nop,l) + vx*dt
      dy = part(2,nop,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJOST22X(part,cu,npp,noff,nn,amxy,qm,dt,ci,nx,ny,idi
     1mp,npmax,nblok,nxv,nxvyp,npd,n18,ipbc)
c for 2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles,
c with short vectors over independent weights, and distributed data,
c as in j. schwartzmeier and t. hewitt, proc. 12th conf. on numerical
c simulation of plasmas, san francisco, ca, 1987.
c in addition, particle positions are advanced a half time-step
c vectorized version with guard cells and 1d addressing
c 65 flops/particle, 1 divide, 1 sqrt, 58 loads, 56 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c where n,m = nearest grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,n,l) = ith component of current density at grid point (j,kk),
c where n = j + nxv*kk + 1 and kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c nn = scratch address array for vectorized charge deposition
c amxy = scratch weight array for vectorized charge deposition
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of current array, must be >= nx
c nxvyp = nxv*nypmx, first actual dimension of current array
c npd = size of scratch buffers for vectorized current deposition
c n18 = number of independent weights
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2*nxvyp,nblok)
      dimension npp(nblok), noff(nblok)
      dimension nn(n18,npd,nblok), amxy(n18,npd,nblok)
      nxv2 = 2*nxv
      qmh = .5*qm
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
c parallel loop
      do 50 l = 1, nblok
      mnoff = noff(l)
      npb = npd
      if (npp(l).gt.npd) then
         ipp = float(npp(l) - 1)/float(npd) + 1.
      else
         ipp = 1
      endif
c outer loop over blocks of particles
      do 40 j = 1, ipp
      jb = (j - 1)*npd
      if (j.ge.ipp) npb = npp(l) - (ipp - 1)*npd
      do 10 i = 1, npb
c find interpolation weights
      n = part(1,i+jb,l) + .5
      m = part(2,i+jb,l) + .5
      dxp = part(1,i+jb,l) - float(n)
      dyp = part(2,i+jb,l) - float(m)
c find inverse gamma
      vx = part(3,i+jb,l)
      vy = part(4,i+jb,l)
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      n2 = 2*n + 1
      m = nxv2*(m - mnoff)
      amx = qm*(.75 - dxp*dxp)
      amy = .75 - dyp*dyp
      ml = m + n2
      dxl = qmh*(.5 - dxp)**2
      dxp = qmh*(.5 + dxp)**2
      mn = ml + nxv2
      dyl = .5*(.5 - dyp)**2
      dyp = .5*(.5 + dyp)**2
      mp = mn + nxv2
      nn(1,i,l) = mn
      nn(2,i,l) = mn + 1
      nn(3,i,l) = mn + 2
      nn(4,i,l) = mn + 3
      nn(5,i,l) = mn + 4
      nn(6,i,l) = mn + 5
      nn(7,i,l) = ml
      nn(8,i,l) = ml + 1
      nn(9,i,l) = ml + 2
      nn(10,i,l) = ml + 3
      nn(11,i,l) = ml + 4
      nn(12,i,l) = ml + 5
      nn(13,i,l) = mp
      nn(14,i,l) = mp + 1
      nn(15,i,l) = mp + 2
      nn(16,i,l) = mp + 3
      nn(17,i,l) = mp + 4
      nn(18,i,l) = mp + 5
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      vx = vx*gami
      vy = vy*gami
      amxy(1,i,l) = vx*dx
      amxy(2,i,l) = vy*dx
      dx = dxl*dyl
      amxy(3,i,l) = vx*dy
      amxy(4,i,l) = vy*dy
      dy = amx*dyl
      amxy(5,i,l) = vx*dz
      amxy(6,i,l) = vy*dz
      dz = dxp*dyl
      amxy(7,i,l) = vx*dx
      amxy(8,i,l) = vy*dx
      dx = dxl*dyp
      amxy(9,i,l) = vx*dy
      amxy(10,i,l) = vy*dy
      dy = amx*dyp
      amxy(11,i,l) = vx*dz
      amxy(12,i,l) = vy*dz
      dz = dxp*dyp
      amxy(13,i,l) = vx*dx
      amxy(14,i,l) = vy*dx
      amxy(15,i,l) = vx*dy
      amxy(16,i,l) = vy*dy
      amxy(17,i,l) = vx*dz
      amxy(18,i,l) = vy*dz
c advance position half a time-step
      dx = part(1,i+jb,l) + vx*dt
      dy = part(2,i+jb,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,i+jb,l)
            part(4,i+jb,l) = -part(4,i+jb,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
      endif
c set new position
      part(1,i+jb,l) = dx
      part(2,i+jb,l) = dy
   10 continue
c deposit charge
      do 30 i = 1, npb
cdir$ ivdep
      do 20 k = 1, 18
      cu(nn(k,i,l),l) = cu(nn(k,i,l),l) + amxy(k,i,l)
   20 continue
   30 continue
   40 continue
   50 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRJPOST22L(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npmax
     1,nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, for distributed data
c 34 flops/particle, 1 divide, 1 sqrt, 12 loads, 10 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qci*dx*(1.-dy)
c cu(i,n,m+1)=qci*(1.-dx)*dy
c cu(i,n+1,m+1)=qci*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,j,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = qm*(part(1,j,l) - float(nn))
      dyp = part(2,j,l) - float(mm)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      nn = nn + 1
      mm = mm - mnoff
      amx = qm - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c deposit current
      dx = dxp*dyp
      dy = amx*dyp
      vx = vx*gami
      vy = vy*gami
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dx
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dx
      dx = dxp*amy
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      dy = amx*amy
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dx
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dx
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
c advance position half a time-step
      dx = part(1,j,l) + vx*dt
      dy = part(2,j,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJPOST22L(part,cu,npp,noff,qm,dt,ci,nx,ny,idimp,npma
     1x,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c and distributed data.
c in addition, particle positions are advanced a half time-step
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996).
c 34 flops/particle, 1 divide, 1 sqrt, 12 loads, 10 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qm*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qm*dx*(1.-dy)
c cu(i,n,m+1)=qm*(1.-dx)*dy
c cu(i,n+1,m+1)=qm*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,j,k,l) = ith component of current density at grid point (j,kk),
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current array, must be >= nx+1
c nxyp = actual first dimension of current array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
c find inverse gamma
      vxn = part(3,1,l)
      vyn = part(4,1,l)
      p2 = vxn*vxn + vyn*vyn
      gami = 1.0/sqrt(1.0 + p2*ci2)
      mmn = mmn - mnoff
      do 10 j = 2, npp(l)
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j,l)
      mmn = part(2,j,l)
      dxp = qm*dxn
      dyp = dyn
      dxn = part(1,j,l) - float(nnn)
      dyn = part(2,j,l) - float(mmn)
      mm = mm + nn
      amx = qm - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c calculate weights
      dx = dxp*dyp
      dz = amx*dyp
      vx = vxn*gami
      vy = vyn*gami
c get momentum for next particle
      vxn = part(3,j,l)
      vyn = part(4,j,l)
      p2 = vxn*vxn + vyn*vyn
c deposit current
      dx1 = cu(1,mp+1,l) + vx*dx
      dy1 = cu(2,mp+1,l) + vy*dx
      dx = cu(1,mp,l) + vx*dz
      dy = cu(2,mp,l) + vy*dz
      cu(1,mp+1,l) = dx1
      cu(2,mp+1,l) = dy1
      cu(1,mp,l) = dx
      cu(2,mp,l) = dy
      dx = dxp*amy
      dz = amx*amy
      dxp = cu(1,mm+1,l) + vx*dx
      amx = cu(2,mm+1,l) + vy*dx
      dx = cu(1,mm,l) + vx*dz
      dy = cu(2,mm,l) + vy*dz
      cu(1,mm+1,l) = dxp
      cu(2,mm+1,l) = amx
      cu(1,mm,l) = dx
      cu(2,mm,l) = dy
c find inverse gamma for next particle
      gami = 1.0/sqrt(1.0 + p2*ci2)
c advance position half a time-step
      dx = part(1,j-1,l) + vx*dt
      dy = part(2,j-1,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j-1,l)
            part(4,j-1,l) = -part(4,j-1,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j-1,l)
            part(3,j-1,l) = -part(3,j-1,l)
         endif
      endif
c set new position
      part(1,j-1,l) = dx
      part(2,j-1,l) = dy
   10 continue
      nop = npp(l)
c deposit current for last particle
      nn = nnn + 1
      mm = nxv*mmn
      dxp = qm*dxn
      mm = mm + nn
      amx = qm - dxp
      mp = mm + nxv
      amy = 1. - dyn
c deposit current
      dx = dxp*dyn
      dy = amx*dyn
      vx = vxn*gami
      vy = vyn*gami
      cu(1,mp+1,l) = cu(1,mp+1,l) + vx*dx
      cu(2,mp+1,l) = cu(2,mp+1,l) + vy*dx
      cu(1,mp,l) = cu(1,mp,l) + vx*dy
      cu(2,mp,l) = cu(2,mp,l) + vy*dy
      dx = dxp*amy
      dy = amx*amy
      cu(1,mm+1,l) = cu(1,mm+1,l) + vx*dx
      cu(2,mm+1,l) = cu(2,mm+1,l) + vy*dx
      cu(1,mm,l) = cu(1,mm,l) + vx*dy
      cu(2,mm,l) = cu(2,mm,l) + vy*dy
c advance position half a time-step
      dx = part(1,nop,l) + vx*dt
      dy = part(2,nop,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRJOST22XL(part,cu,npp,noff,nn,amxy,qm,dt,ci,nx,ny,id
     1imp,npmax,nblok,nxv,nxvyp,npd,n8,ipbc)
c for 2d code, this subroutine calculates particle current density
c using first-order linear interpolation for relativistic particles,
c with short vectors over independent weights, and distributed data,
c as in j. schwartzmeier and t. hewitt, proc. 12th conf. on numerical
c simulation of plasmas, san francisco, ca, 1987.
c in addition, particle positions are advanced a half time-step
c vectorized distributed version with guard cells and 1d addressing
c 34 flops/particle, 1 divide, 1 sqrt, 29 loads, 26 stores
c input: all, output: part, cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qci*dx*(1.-dy)
c cu(i,n,m+1)=qci*(1.-dx)*dy
c cu(i,n+1,m+1)=qci*dx*dy
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c and qci = qm*pi*gami, where i = x,y
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c cu(i,n,l) = charge density at grid point (j,kk),
c where n = j + nxv*(kk - 1) and  kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c nn = scratch address array for vectorized charge deposition
c amxy = scratch weight array for vectorized charge deposition
c qm = charge on particle, in units of e
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first virtual dimension of charge array, must be >= nx+1
c nxvyp = nxv*nypmx, first actual dimension of charge array
c npd = size of scratch buffers for vectorized charge deposition
c n8 = number of independent weights
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok), cu(2*nxvyp,nblok)
      dimension npp(nblok), noff(nblok)
      dimension nn(n8,npd,nblok), amxy(n8,npd,nblok)
      nxv2 = 2*nxv
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
c parallel loop
      do 50 l = 1, nblok
      mnoff = noff(l)
      npb = npd
      if (npp(l).gt.npd) then
         ipp = float(npp(l) - 1)/float(npd) + 1.
      else
         ipp = 1
      endif
c outer loop over blocks of particles
      do 40 j = 1, ipp
      jb = (j - 1)*npd
      if (j.ge.ipp) npb = npp(l) - (ipp - 1)*npd
      do 10 i = 1, npb
c find interpolation weights
      n = part(1,i+jb,l)
      m = part(2,i+jb,l)
      dxp = qm*(part(1,i+jb,l) - float(n))
      dyp = part(2,i+jb,l) - float(m)
c find inverse gamma
      vx = part(3,i+jb,l)
      vy = part(4,i+jb,l)
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c calculate weights
      n2 = 2*n + 1
      mm = nxv2*(m - mnoff)
      amx = qm - dxp
      mm = mm + n2
      amy = 1. - dyp
      mp = mm + nxv2
      nn(7,i,l) = mm
      nn(8,i,l) = mm + 1
      nn(5,i,l) = mm + 2
      nn(6,i,l) = mm + 3
      nn(3,i,l) = mp
      nn(4,i,l) = mp + 1
      nn(1,i,l) = mp + 2
      nn(2,i,l) = mp + 3
      dx = dxp*dyp
      dy = amx*dyp
      vx = vx*gami
      vy = vy*gami
      amxy(1,i,l) = vx*dx
      amxy(2,i,l) = vy*dx
      amxy(3,i,l) = vx*dy
      amxy(4,i,l) = vy*dy
      dx = dxp*amy
      dy = amx*amy
      amxy(5,i,l) = vx*dx
      amxy(6,i,l) = vy*dx
      amxy(7,i,l) = vx*dy
      amxy(8,i,l) = vy*dy
c advance position half a time-step
      dx = part(1,i+jb,l) + vx*dt
      dy = part(2,i+jb,l) + vy*dt
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,i+jb,l)
            part(4,i+jb,l) = -part(4,i+jb,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,i+jb,l)
            part(3,i+jb,l) = -part(3,i+jb,l)
         endif
      endif
c set new position
      part(1,i+jb,l) = dx
      part(2,i+jb,l) = dy
   10 continue
c deposit charge
      do 30 i = 1, npb
cdir$ ivdep
      do 20 k = 1, 8
      cu(nn(k,i,l),l) = cu(nn(k,i,l),l) + amxy(k,i,l)
   20 continue
   30 continue
   40 continue
   50 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRPUSH2(part,fxy,npp,noff,qbm,dt,ci,ek,nx,ny,idimp,npm
     1ax,nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles
c with various boundary conditions.
c scalar version using guard cells, for distributed data
c 88 flops/particle, 2 divides, 2 sqrts, 22 loads, 4 stores
c input: all, output: part, ek
c equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c fy(x,y) = (.75-dy**2)*((.75-dx**2)*fy(n,m)+(.5*(.5+dx)**2)*fy(n+1,m)+
c (.5*(.5-dx)**2)*fy(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fy(n,m+1)+
c (.5*(.5+dx)**2)*fy(n+1,m+1)+(.5*(.5-dx)**2)*fy(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fy(n,m-1)+(.5*(.5+dx)**2)*fy(n+1,m-1)+
c (.5*(.5-dx)**2)*fy(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c in other words, fxy are the convolutions of the electric field
c over the particle shape, where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gamma)
c where gamma = sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field array, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nl = nn + 1
      ml = mm - mnoff
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = .5*(.5 - dxp)**2
      np = nl + 2
      dxp = .5*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c find acceleration
      dx = amy*(dxl*fxy(1,nl,mm,l) + amx*fxy(1,nn,mm,l) + dxp*fxy(1,np,m
     1m,l)) + dyl*(dxl*fxy(1,nl,ml,l) + amx*fxy(1,nn,ml,l) + dxp*fxy(1,n
     2p,ml,l)) + dyp*(dxl*fxy(1,nl,mp,l) + amx*fxy(1,nn,mp,l) + dxp*fxy(
     31,np,mp,l))
      dy = amy*(dxl*fxy(2,nl,mm,l) + amx*fxy(2,nn,mm,l) + dxp*fxy(2,np,m
     1m,l)) + dyl*(dxl*fxy(2,nl,ml,l) + amx*fxy(2,nn,ml,l) + dxp*fxy(2,n
     2p,ml,l)) + dyp*(dxl*fxy(2,nl,mp,l) + amx*fxy(2,nn,mp,l) + dxp*fxy(
     32,np,mp,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRPUSH2(part,fxy,npp,noff,qbm,dt,ci,ek,nx,ny,idimp,np
     1max,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles
c with various boundary conditions.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996).
c 88 flops/particle, 2 divides, 2 sqrts, 22 loads, 4 stores
c input: all, output: part, ek
c equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c fy(x,y) = (.75-dy**2)*((.75-dx**2)*fy(n,m)+(.5*(.5+dx)**2)*fy(n+1,m)+
c (.5*(.5-dx)**2)*fy(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fy(n,m+1)+
c (.5*(.5+dx)**2)*fy(n+1,m+1)+(.5*(.5-dx)**2)*fy(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fy(n,m-1)+(.5*(.5+dx)**2)*fy(n+1,m-1)+
c (.5*(.5-dx)**2)*fy(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c in other words, fxy are the convolutions of the electric field
c over the particle shape, where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gamma)
c where gamma = sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = second virtual dimension of field array, must be >= nx+3
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l) + .5
      mmn = part(2,j+1,l) + .5
      dxp = dxn
      dyp = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      ml = mm + nn
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      mn = ml + nxv
      dxl = .5*(.5 - dxp)**2
      dxp = .5*(.5 + dxp)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyp)**2
      dyp = .5*(.5 + dyp)**2
      mmn = mmn - mnoff
c find acceleration
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1+ dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) + 
     2dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l))
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1+ dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) + 
     2dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = .75 - dxn*dxn
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = .5*(.5 - dxn)**2
      dxp = .5*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c find acceleration
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1+ dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) + 
     2dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l))
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1+ dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) + 
     2dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,nop,l) = dx
      part(4,nop,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRPUSH2L(part,fxy,npp,noff,qbm,dt,ci,ek,nx,ny,idimp,np
     1max,nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles
c with various boundary conditions.
c scalar version using guard cells, for distributed data
c 50 flops/particle, 2 divides, 2 sqrts, 12 loads, 4 stores
c input: all, output: part, ek
c equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c fy(x,y) = (1-dy)*((1-dx)*fy(n,m)+dx*fy(n+1,m)) + dy*((1-dx)*fy(n,m+1)
c    + dx*fy(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c in other words, fxy are the convolutions of the electric field
c over the particle shape, where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gamma)
c where gamma = sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field array, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nn = nn + 1
      mm = mm - mnoff
      amx = 1. - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c find acceleration
      dx = dyp*(dxp*fxy(1,np,mp,l) + amx*fxy(1,nn,mp,l)) + amy*(dxp*fxy(
     11,np,mm,l) + amx*fxy(1,nn,mm,l))
      dy = dyp*(dxp*fxy(2,np,mp,l) + amx*fxy(2,nn,mp,l)) + amy*(dxp*fxy(
     12,np,mm,l) + amx*fxy(2,nn,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRPUSH2L(part,fxy,npp,noff,qbm,dt,ci,ek,nx,ny,idimp,n
     1pmax,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles
c with various boundary conditions.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c cases 9-10 in v.k.decyk et al, computers in physics 10, 290 (1996)
c 50 flops/particle, 2 divides, 2 sqrts, 12 loads, 4 stores
c input: all, output: part, ek
c equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c fy(x,y) = (1-dy)*((1-dx)*fy(n,m)+dx*fy(n+1,m)) + dy*((1-dx)*fy(n,m+1)
c    + dx*fy(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c in other words, fxy are the convolutions of the electric field
c over the particle shape, where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gamma)
c where gamma = sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = second virtual dimension of field array, must be >= nx+1
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l)
      mmn = part(2,j+1,l)
      dxp = dxn
      dyp = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      mm = mm + nn
      amx = 1. - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c find acceleration
      dx = dyp*(dxp*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxp*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyp*(dxp*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxp*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      mm = mm + nn
      amx = 1. - dxn
      mp = mm + nxv
      amy = 1. - dyn
c find acceleration
      dx = dyn*(dxn*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxn*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyn*(dxn*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxn*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
c time-centered kinetic energy
      p2 = acx*acx + acy*acy
      sum1 = sum1 + p2/(1.0 + sqrt(1.0 + p2*ci2))
c new velocity
      dx = acx + dx
      dy = acy + dy
      part(3,nop,l) = dx
      part(4,nop,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dt/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH2(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,ny,
     1idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, for distributed data
c 198 flops/particle, 4 divides, 2 sqrts, 50 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2)) +.5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2)) + .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2))
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)),
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j+1,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j+1,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 + (pz(t-dt/2)**2)/
c      (1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), bxy(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nl = nn + 1
      ml = mm - mnoff
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = .5*(.5 - dxp)**2
      np = nl + 2
      dxp = .5*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c find electric field
      dx = amy*(dxl*fxy(1,nl,mm,l) + amx*fxy(1,nn,mm,l) + dxp*fxy(1,np,m
     1m,l)) + dyl*(dxl*fxy(1,nl,ml,l) + amx*fxy(1,nn,ml,l) + dxp*fxy(1,n
     2p,ml,l)) + dyp*(dxl*fxy(1,nl,mp,l) + amx*fxy(1,nn,mp,l) + dxp*fxy(
     31,np,mp,l))
      dy = amy*(dxl*fxy(2,nl,mm,l) + amx*fxy(2,nn,mm,l) + dxp*fxy(2,np,m
     1m,l)) + dyl*(dxl*fxy(2,nl,ml,l) + amx*fxy(2,nn,ml,l) + dxp*fxy(2,n
     2p,ml,l)) + dyp*(dxl*fxy(2,nl,mp,l) + amx*fxy(2,nn,mp,l) + dxp*fxy(
     32,np,mp,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,nl,mm,l) + amx*bxy(1,nn,mm,l) + dxp*bxy(1,np,m
     1m,l)) + dyl*(dxl*bxy(1,nl,ml,l) + amx*bxy(1,nn,ml,l) + dxp*bxy(1,n
     2p,ml,l)) + dyp*(dxl*bxy(1,nl,mp,l) + amx*bxy(1,nn,mp,l) + dxp*bxy(
     31,np,mp,l))
      oy = amy*(dxl*bxy(2,nl,mm,l) + amx*bxy(2,nn,mm,l) + dxp*bxy(2,np,m
     1m,l)) + dyl*(dxl*bxy(2,nl,ml,l) + amx*bxy(2,nn,ml,l) + dxp*bxy(2,n
     2p,ml,l)) + dyp*(dxl*bxy(2,nl,mp,l) + amx*bxy(2,nn,mp,l) + dxp*bxy(
     32,np,mp,l))
      oz = amy*(dxl*bxy(3,nl,mm,l) + amx*bxy(3,nn,mm,l) + dxp*bxy(3,np,m
     1m,l)) + dyl*(dxl*bxy(3,nl,ml,l) + amx*bxy(3,nn,ml,l) + dxp*bxy(3,n
     2p,ml,l)) + dyp*(dxl*bxy(3,nl,mp,l) + amx*bxy(3,nn,mp,l) + dxp*bxy(
     33,np,mp,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH2(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,ny
     1,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 198 flops/particle, 4 divides, 2 sqrts, 50 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2)) +.5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2)) + .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2))
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)),
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j+1,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j+1,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 + (pz(t-dt/2)**2)/
c      (1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok), bxy(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l) + .5
      mmn = part(2,j+1,l) + .5
      dx = dxn
      dy = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      ml = mm + nn
      amx = .75 - dx*dx
      amy = .75 - dy*dy
      mn = ml + nxv
      dxl = .5*(.5 - dx)**2
      dxp = .5*(.5 + dx)**2
      mp = mn + nxv
      dyl = .5*(.5 - dy)**2
      dyp = .5*(.5 + dy)**2
      mmn = mmn - mnoff
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,mn,l) + amx*bxy(1,mn+1,l) + dxp*bxy(1,mn+2,l))
     1 + dyl*(dxl*bxy(1,ml,l) + amx*bxy(1,ml+1,l) + dxp*bxy(1,ml+2,l)) +
     2 dyp*(dxl*bxy(1,mp,l) + amx*bxy(1,mp+1,l) + dxp*bxy(1,mp+2,l)) 
      oy = amy*(dxl*bxy(2,mn,l) + amx*bxy(2,mn+1,l) + dxp*bxy(2,mn+2,l))
     1 + dyl*(dxl*bxy(2,ml,l) + amx*bxy(2,ml+1,l) + dxp*bxy(2,ml+2,l)) +
     2 dyp*(dxl*bxy(2,mp,l) + amx*bxy(2,mp+1,l) + dxp*bxy(2,mp+2,l)) 
      oz = amy*(dxl*bxy(3,mn,l) + amx*bxy(3,mn+1,l) + dxp*bxy(3,mn+2,l))
     1 + dyl*(dxl*bxy(3,ml,l) + amx*bxy(3,ml+1,l) + dxp*bxy(3,ml+2,l)) +
     2 dyp*(dxl*bxy(3,mp,l) + amx*bxy(3,mp+1,l) + dxp*bxy(3,mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = .75 - dxn*dxn
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = .5*(.5 - dxn)**2
      dxp = .5*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l)) 
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
      acz = part(5,nop,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,mn,l) + amx*bxy(1,mn+1,l) + dxp*bxy(1,mn+2,l))
     1 + dyl*(dxl*bxy(1,ml,l) + amx*bxy(1,ml+1,l) + dxp*bxy(1,ml+2,l)) +
     2 dyp*(dxl*bxy(1,mp,l) + amx*bxy(1,mp+1,l) + dxp*bxy(1,mp+2,l)) 
      oy = amy*(dxl*bxy(2,mn,l) + amx*bxy(2,mn+1,l) + dxp*bxy(2,mn+2,l))
     1 + dyl*(dxl*bxy(2,ml,l) + amx*bxy(2,ml+1,l) + dxp*bxy(2,ml+2,l)) +
     2 dyp*(dxl*bxy(2,mp,l) + amx*bxy(2,mp+1,l) + dxp*bxy(2,mp+2,l)) 
      oz = amy*(dxl*bxy(3,mn,l) + amx*bxy(3,mn+1,l) + dxp*bxy(3,mn+2,l))
     1 + dyl*(dxl*bxy(3,ml,l) + amx*bxy(3,ml+1,l) + dxp*bxy(3,ml+2,l)) +
     2 dyp*(dxl*bxy(3,mp,l) + amx*bxy(3,mp+1,l) + dxp*bxy(3,mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,nop,l) = dx
      part(4,nop,l) = dy
      part(5,nop,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH2L(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,ny
     1,idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, for distributed data
c 117 flops/particle, 4 divides, 2 sqrts, 25 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2)) +.5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2)) + .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2))
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)),
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 + (pz(t-dt/2)**2)/
c      (1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), bxy(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nn = nn + 1
      mm = mm - mnoff
      amx = 1. - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c find electric field
      dx = dyp*(dxp*fxy(1,np,mp,l) + amx*fxy(1,nn,mp,l)) + amy*(dxp*fxy(
     11,np,mm,l) + amx*fxy(1,nn,mm,l))
      dy = dyp*(dxp*fxy(2,np,mp,l) + amx*fxy(2,nn,mp,l)) + amy*(dxp*fxy(
     12,np,mm,l) + amx*fxy(2,nn,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyp*(dxp*bxy(1,np,mp,l) + amx*bxy(1,nn,mp,l)) + amy*(dxp*bxy(
     11,np,mm,l) + amx*bxy(1,nn,mm,l))
      oy = dyp*(dxp*bxy(2,np,mp,l) + amx*bxy(2,nn,mp,l)) + amy*(dxp*bxy(
     12,np,mm,l) + amx*bxy(2,nn,mm,l))
      oz = dyp*(dxp*bxy(3,np,mp,l) + amx*bxy(3,nn,mp,l)) + amy*(dxp*bxy(
     13,np,mm,l) + amx*bxy(3,nn,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH2L(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,n
     1y,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 117 flops/particle, 4 divides, 2 sqrts, 25 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2)) +.5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2)) + .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2))
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)),
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c qbm = particle charge/mass ratio
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 + (pz(t-dt/2)**2)/
c      (1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok), bxy(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l)
      mmn = part(2,j+1,l)
      dxp = dxn
      dyp = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      mm = mm + nn
      amx = 1. - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c find electric field
      dx = dyp*(dxp*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxp*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyp*(dxp*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxp*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyp*(dxp*bxy(1,mp+1,l) + amx*bxy(1,mp,l)) + amy*(dxp*bxy(1,mm
     1+1,l) + amx*bxy(1,mm,l))
      oy = dyp*(dxp*bxy(2,mp+1,l) + amx*bxy(2,mp,l)) + amy*(dxp*bxy(2,mm
     1+1,l) + amx*bxy(2,mm,l))
      oz = dyp*(dxp*bxy(3,mp+1,l) + amx*bxy(3,mp,l)) + amy*(dxp*bxy(3,mm
     1+1,l) + amx*bxy(3,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      mm = mm + nn
      amx = 1. - dxn
      mp = mm + nxv
      amy = 1. - dyn
c find electric field
      dx = dyn*(dxn*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxn*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyn*(dxn*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxn*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
      acz = part(5,nop,l)
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyn*(dxn*bxy(1,mp+1,l) + amx*bxy(1,mp,l)) + amy*(dxn*bxy(1,mm
     1+1,l) + amx*bxy(1,mm,l))
      oy = dyn*(dxn*bxy(2,mp+1,l) + amx*bxy(2,mp,l)) + amy*(dxn*bxy(2,mm
     1+1,l) + amx*bxy(2,mm,l))
      oz = dyn*(dxn*bxy(3,mp+1,l) + amx*bxy(3,mp,l)) + amy*(dxn*bxy(3,mm
     1+1,l) + amx*bxy(3,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm
      part(3,nop,l) = dx
      part(4,nop,l) = dy
      part(5,nop,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH23(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,ny
     1,idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2-1/2d code, thisssubroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, for distributed data
c 221 flops/particle, 4 divides, 2 sqrts, 50 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fz(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), fz(x(t),y(t))
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), fz(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c fxy(3,j+1,k,l) = z component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j+1,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j+1,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 +
c      (pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(3,nxv,nypmx,nblok), bxy(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nl = nn + 1
      ml = mm - mnoff
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = .5*(.5 - dxp)**2
      np = nl + 2
      dxp = .5*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c find electric field
      dx = amy*(dxl*fxy(1,nl,mm,l) + amx*fxy(1,nn,mm,l) + dxp*fxy(1,np,m
     1m,l)) + dyl*(dxl*fxy(1,nl,ml,l) + amx*fxy(1,nn,ml,l) + dxp*fxy(1,n
     2p,ml,l)) + dyp*(dxl*fxy(1,nl,mp,l) + amx*fxy(1,nn,mp,l) + dxp*fxy(
     31,np,mp,l))
      dy = amy*(dxl*fxy(2,nl,mm,l) + amx*fxy(2,nn,mm,l) + dxp*fxy(2,np,m
     1m,l)) + dyl*(dxl*fxy(2,nl,ml,l) + amx*fxy(2,nn,ml,l) + dxp*fxy(2,n
     2p,ml,l)) + dyp*(dxl*fxy(2,nl,mp,l) + amx*fxy(2,nn,mp,l) + dxp*fxy(
     32,np,mp,l))
      dz = amy*(dxl*fxy(3,nl,mm,l) + amx*fxy(3,nn,mm,l) + dxp*fxy(3,np,m
     1m,l)) + dyl*(dxl*fxy(3,nl,ml,l) + amx*fxy(3,nn,ml,l) + dxp*fxy(3,n
     2p,ml,l)) + dyp*(dxl*fxy(3,nl,mp,l) + amx*fxy(3,nn,mp,l) + dxp*fxy(
     33,np,mp,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,nl,mm,l) + amx*bxy(1,nn,mm,l) + dxp*bxy(1,np,m
     1m,l)) + dyl*(dxl*bxy(1,nl,ml,l) + amx*bxy(1,nn,ml,l) + dxp*bxy(1,n
     2p,ml,l)) + dyp*(dxl*bxy(1,nl,mp,l) + amx*bxy(1,nn,mp,l) + dxp*bxy(
     31,np,mp,l))
      oy = amy*(dxl*bxy(2,nl,mm,l) + amx*bxy(2,nn,mm,l) + dxp*bxy(2,np,m
     1m,l)) + dyl*(dxl*bxy(2,nl,ml,l) + amx*bxy(2,nn,ml,l) + dxp*bxy(2,n
     2p,ml,l)) + dyp*(dxl*bxy(2,nl,mp,l) + amx*bxy(2,nn,mp,l) + dxp*bxy(
     32,np,mp,l))
      oz = amy*(dxl*bxy(3,nl,mm,l) + amx*bxy(3,nn,mm,l) + dxp*bxy(3,np,m
     1m,l)) + dyl*(dxl*bxy(3,nl,ml,l) + amx*bxy(3,nn,ml,l) + dxp*bxy(3,n
     2p,ml,l)) + dyp*(dxl*bxy(3,nl,mp,l) + amx*bxy(3,nn,mp,l) + dxp*bxy(
     33,np,mp,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH23(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,n
     1y,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 221 flops/particle, 4 divides, 2 sqrts, 50 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fz(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), fz(x(t),y(t))
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), fz(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c fxy(3,j+1,k,l) = z component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j+1,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j+1,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 +
c      (pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(3,nxyp,nblok), bxy(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l) + .5
      mmn = part(2,j+1,l) + .5
      dx = dxn
      dy = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      ml = mm + nn
      amx = .75 - dx*dx
      amy = .75 - dy*dy
      mn = ml + nxv
      dxl = .5*(.5 - dx)**2
      dxp = .5*(.5 + dx)**2
      mp = mn + nxv
      dyl = .5*(.5 - dy)**2
      dyp = .5*(.5 + dy)**2
      mmn = mmn - mnoff
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
      dz = amy*(dxl*fxy(3,mn,l) + amx*fxy(3,mn+1,l) + dxp*fxy(3,mn+2,l))
     1 + dyl*(dxl*fxy(3,ml,l) + amx*fxy(3,ml+1,l) + dxp*fxy(3,ml+2,l)) +
     2 dyp*(dxl*fxy(3,mp,l) + amx*fxy(3,mp+1,l) + dxp*fxy(3,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,mn,l) + amx*bxy(1,mn+1,l) + dxp*bxy(1,mn+2,l))
     1 + dyl*(dxl*bxy(1,ml,l) + amx*bxy(1,ml+1,l) + dxp*bxy(1,ml+2,l)) +
     2 dyp*(dxl*bxy(1,mp,l) + amx*bxy(1,mp+1,l) + dxp*bxy(1,mp+2,l)) 
      oy = amy*(dxl*bxy(2,mn,l) + amx*bxy(2,mn+1,l) + dxp*bxy(2,mn+2,l))
     1 + dyl*(dxl*bxy(2,ml,l) + amx*bxy(2,ml+1,l) + dxp*bxy(2,ml+2,l)) +
     2 dyp*(dxl*bxy(2,mp,l) + amx*bxy(2,mp+1,l) + dxp*bxy(2,mp+2,l)) 
      oz = amy*(dxl*bxy(3,mn,l) + amx*bxy(3,mn+1,l) + dxp*bxy(3,mn+2,l))
     1 + dyl*(dxl*bxy(3,ml,l) + amx*bxy(3,ml+1,l) + dxp*bxy(3,ml+2,l)) +
     2 dyp*(dxl*bxy(3,mp,l) + amx*bxy(3,mp+1,l) + dxp*bxy(3,mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = .75 - dxn*dxn
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = .5*(.5 - dxn)**2
      dxp = .5*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
      dz = amy*(dxl*fxy(3,mn,l) + amx*fxy(3,mn+1,l) + dxp*fxy(3,mn+2,l))
     1 + dyl*(dxl*fxy(3,ml,l) + amx*fxy(3,ml+1,l) + dxp*fxy(3,ml+2,l)) +
     2 dyp*(dxl*fxy(3,mp,l) + amx*fxy(3,mp+1,l) + dxp*fxy(3,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
      acz = part(5,nop,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = amy*(dxl*bxy(1,mn,l) + amx*bxy(1,mn+1,l) + dxp*bxy(1,mn+2,l))
     1 + dyl*(dxl*bxy(1,ml,l) + amx*bxy(1,ml+1,l) + dxp*bxy(1,ml+2,l)) +
     2 dyp*(dxl*bxy(1,mp,l) + amx*bxy(1,mp+1,l) + dxp*bxy(1,mp+2,l)) 
      oy = amy*(dxl*bxy(2,mn,l) + amx*bxy(2,mn+1,l) + dxp*bxy(2,mn+2,l))
     1 + dyl*(dxl*bxy(2,ml,l) + amx*bxy(2,ml+1,l) + dxp*bxy(2,ml+2,l)) +
     2 dyp*(dxl*bxy(2,mp,l) + amx*bxy(2,mp+1,l) + dxp*bxy(2,mp+2,l)) 
      oz = amy*(dxl*bxy(3,mn,l) + amx*bxy(3,mn+1,l) + dxp*bxy(3,mn+2,l))
     1 + dyl*(dxl*bxy(3,ml,l) + amx*bxy(3,ml+1,l) + dxp*bxy(3,ml+2,l)) +
     2 dyp*(dxl*bxy(3,mp,l) + amx*bxy(3,mp+1,l) + dxp*bxy(3,mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,nop,l) = dx
      part(4,nop,l) = dy
      part(5,nop,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH23L(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,n
     1y,idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, for distributed data
c 129 flops/particle, 4 divides, 2 sqrts, 25 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fz(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), fz(x(t),y(t))
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), fz(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c fxy(3,j,k,l) = z component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 +
c      (pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(3,nxv,nypmx,nblok), bxy(3,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nn = nn + 1
      mm = mm - mnoff
      amx = 1. - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c find electric field
      dx = dyp*(dxp*fxy(1,np,mp,l) + amx*fxy(1,nn,mp,l)) + amy*(dxp*fxy(
     11,np,mm,l) + amx*fxy(1,nn,mm,l))
      dy = dyp*(dxp*fxy(2,np,mp,l) + amx*fxy(2,nn,mp,l)) + amy*(dxp*fxy(
     12,np,mm,l) + amx*fxy(2,nn,mm,l))
      dz = dyp*(dxp*fxy(3,np,mp,l) + amx*fxy(3,nn,mp,l)) + amy*(dxp*fxy(
     13,np,mm,l) + amx*fxy(3,nn,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyp*(dxp*bxy(1,np,mp,l) + amx*bxy(1,nn,mp,l)) + amy*(dxp*bxy(
     11,np,mm,l) + amx*bxy(1,nn,mm,l))
      oy = dyp*(dxp*bxy(2,np,mp,l) + amx*bxy(2,nn,mp,l)) + amy*(dxp*bxy(
     12,np,mm,l) + amx*bxy(2,nn,mm,l))
      oz = dyp*(dxp*bxy(3,np,mp,l) + amx*bxy(3,nn,mp,l)) + amy*(dxp*bxy(
     13,np,mm,l) + amx*bxy(3,nn,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH23L(part,fxy,bxy,npp,noff,qbm,dt,dtc,ci,ek,nx,
     1ny,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2-1/2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c Using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 129 flops/particle, 4 divides, 2 sqrts, 25 loads, 5 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(3)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = rot(4)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(5)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(6)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c pz(t+dt/2) = rot(7)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(8)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    rot(9)*(pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt) +
c    .5*(q/m)*fz(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (om*dt/2)**2 + 2*(omx*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(2) = 2*(omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(3) = 2*(-omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(4) = 2*(-omz*dt/2 + (omx*dt/2)*(omy*dt/2))/(1 + (om*dt/2)**2)
c    rot(5) = (1 - (om*dt/2)**2 + 2*(omy*dt/2)**2)/(1 + (om*dt/2)**2)
c    rot(6) = 2*(omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(7) = 2*(omy*dt/2 + (omx*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(8) = 2*(-omx*dt/2 + (omy*dt/2)*(omz*dt/2))/(1 + (om*dt/2)**2)
c    rot(9) = (1 - (om*dt/2)**2 + 2*(omz*dt/2)**2)/(1 + (om*dt/2)**2)
c and om**2 = omx**2 + omy**2 + omz**2
c the rotation matrix is determined by:
c omx = (q/m)*bx(x(t),y(t))*gami, omy = (q/m)*by(x(t),y(t))*gami, and
c omz = (q/m)*bz(x(t),y(t))*gami,
c where gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t)+pz(t)*pz(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), fz(x(t),y(t))
c bx(x(t),y(t)), by(x(t),y(t)), and bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), fz(x,y), bx(x,y), by(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c fxy(3,j,k,l) = z component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bxy(1,j,k,l) = x component of magnetic field at grid (j,kk)
c bxy(2,j,k,l) = y component of magnetic field at grid (j,kk)
c bxy(3,j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c qbm = particle charge/mass ratio
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2 +
c      (pz(t-dt/2) + .5*(q/m)*fz(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(3,nxyp,nblok), bxy(3,nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l)
      mmn = part(2,j+1,l)
      dxp = dxn
      dyp = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      mm = mm + nn
      amx = 1. - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c find electric field
      dx = dyp*(dxp*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxp*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyp*(dxp*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxp*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
      dz = dyp*(dxp*fxy(3,mp+1,l) + amx*fxy(3,mp,l)) + amy*(dxp*fxy(3,mm
     1+1,l) + amx*fxy(3,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
      acz = part(5,j,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyp*(dxp*bxy(1,mp+1,l) + amx*bxy(1,mp,l)) + amy*(dxp*bxy(1,mm
     1+1,l) + amx*bxy(1,mm,l))
      oy = dyp*(dxp*bxy(2,mp+1,l) + amx*bxy(2,mp,l)) + amy*(dxp*bxy(2,mm
     1+1,l) + amx*bxy(2,mm,l))
      oz = dyp*(dxp*bxy(3,mp+1,l) + amx*bxy(3,mp,l)) + amy*(dxp*bxy(3,mm
     1+1,l) + amx*bxy(3,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,j,l) = dx
      part(4,j,l) = dy
      part(5,j,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      mm = mm + nn
      amx = 1. - dxn
      mp = mm + nxv
      amy = 1. - dyn
c find electric field
      dx = dyn*(dxn*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxn*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyn*(dxn*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxn*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
      dz = dyn*(dxn*fxy(3,mp+1,l) + amx*fxy(3,mp,l)) + amy*(dxn*fxy(3,mm
     1+1,l) + amx*fxy(3,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
      dz = qtmh*dz
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
      acz = part(5,nop,l) + dz
c find inverse gamma
      p2 = acx*acx + acy*acy + acz*acz
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      ox = dyn*(dxn*bxy(1,mp+1,l) + amx*bxy(1,mp,l)) + amy*(dxn*bxy(1,mm
     1+1,l) + amx*bxy(1,mm,l))
      oy = dyn*(dxn*bxy(2,mp+1,l) + amx*bxy(2,mp,l)) + amy*(dxn*bxy(2,mm
     1+1,l) + amx*bxy(2,mm,l))
      oz = dyn*(dxn*bxy(3,mp+1,l) + amx*bxy(3,mp,l)) + amy*(dxn*bxy(3,mm
     1+1,l) + amx*bxy(3,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omxt = qtmg*ox
      omyt = qtmg*oy
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omxt*omxt + omyt*omyt + omzt*omzt
      anorm = 2./(1. + omt)
      omt = .5*(1. - omt)
      rot4 = omxt*omyt
      rot7 = omxt*omzt
      rot8 = omyt*omzt
      rot1 = omt + omxt*omxt
      rot5 = omt + omyt*omyt
      rot9 = omt + omzt*omzt
      rot2 = omzt + rot4
      rot4 = -omzt + rot4
      rot3 = -omyt + rot7
      rot7 = omyt + rot7
      rot6 = omxt + rot8
      rot8 = -omxt + rot8
c new velocity
      dx = (rot1*acx + rot2*acy + rot3*acz)*anorm + dx
      dy = (rot4*acx + rot5*acy + rot6*acz)*anorm + dy
      dz = (rot7*acx + rot8*acy + rot9*acz)*anorm + dz
      part(3,nop,l) = dx
      part(4,nop,l) = dy
      part(5,nop,l) = dz
c update inverse gamma
      p2 = dx*dx + dy*dy + dz*dz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH22(part,fxy,bz,npp,noff,qbm,dt,dtc,ci,ek,nx,ny,
     1idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c in z direction, using the Boris Mover.
c scalar version using guard cells, for distributed data
c 151 flops/particle, 4 divides, 2 sqrts, 31 loads, 4 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = -rot(2)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(1)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (omz*dt/2)**2/(1 + (omz*dt/2)**2)
c    rot(2) = 2*(omz*dt/2)/(1 + (omz*dt/2)**2)
c where omz = (q/m)*bz(x(t),y(t))*gami, and
c gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bz(j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), bz(nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nl = nn + 1
      ml = mm - mnoff
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = .5*(.5 - dxp)**2
      np = nl + 2
      dxp = .5*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c find electric field
      dx = amy*(dxl*fxy(1,nl,mm,l) + amx*fxy(1,nn,mm,l) + dxp*fxy(1,np,m
     1m,l)) + dyl*(dxl*fxy(1,nl,ml,l) + amx*fxy(1,nn,ml,l) + dxp*fxy(1,n
     2p,ml,l)) + dyp*(dxl*fxy(1,nl,mp,l) + amx*fxy(1,nn,mp,l) + dxp*fxy(
     31,np,mp,l))
      dy = amy*(dxl*fxy(2,nl,mm,l) + amx*fxy(2,nn,mm,l) + dxp*fxy(2,np,m
     1m,l)) + dyl*(dxl*fxy(2,nl,ml,l) + amx*fxy(2,nn,ml,l) + dxp*fxy(2,n
     2p,ml,l)) + dyp*(dxl*fxy(2,nl,mp,l) + amx*fxy(2,nn,mp,l) + dxp*fxy(
     32,np,mp,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      oz = amy*(dxl*bz(nl,mm,l) + amx*bz(nn,mm,l) + dxp*bz(np,mm,l)) + d
     1yl*(dxl*bz(nl,ml,l) + amx*bz(nn,ml,l) + dxp*bz(np,ml,l)) + dyp*(dx
     2l*bz(nl,mp,l) + amx*bz(nn,mp,l) + dxp*bz(np,mp,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH22(part,fxy,bz,npp,noff,qbm,dt,dtc,ci,ek,nx,ny
     1,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and second-order spline
c interpolation in space, for relativistic particles with magnetic field
c in z direction, using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 151 flops/particle, 4 divides, 2 sqrts, 31 loads, 4 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = -rot(2)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(1)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (omz*dt/2)**2/(1 + (omz*dt/2)**2)
c    rot(2) = 2*(omz*dt/2)/(1 + (omz*dt/2)**2)
c where omz = (q/m)*bz(x(t),y(t))*gami, and
c gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bz(j+1,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+3
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok), bz(nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l) + .5
      mmn = part(2,1,l) + .5
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l) + .5
      mmn = part(2,j+1,l) + .5
      dx = dxn
      dy = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      ml = mm + nn
      amx = .75 - dx*dx
      amy = .75 - dy*dy
      mn = ml + nxv
      dxl = .5*(.5 - dx)**2
      dxp = .5*(.5 + dx)**2
      mp = mn + nxv
      dyl = .5*(.5 - dy)**2
      dyp = .5*(.5 + dy)**2
      mmn = mmn - mnoff
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field 
      oz = amy*(dxl*bz(mn,l) + amx*bz(mn+1,l) + dxp*bz(mn+2,l)) + dyl*(d
     1xl*bz(ml,l) + amx*bz(ml+1,l) + dxp*bz(ml+2,l)) + dyp*(dxl*bz(mp,l)
     2 + amx*bz(mp+1,l) + dxp*bz(mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      ml = mm + nn
      amx = .75 - dxn*dxn
      amy = .75 - dyn*dyn
      mn = ml + nxv
      dxl = .5*(.5 - dxn)**2
      dxp = .5*(.5 + dxn)**2
      mp = mn + nxv
      dyl = .5*(.5 - dyn)**2
      dyp = .5*(.5 + dyn)**2
c find electric field
      dx = amy*(dxl*fxy(1,mn,l) + amx*fxy(1,mn+1,l) + dxp*fxy(1,mn+2,l))
     1 + dyl*(dxl*fxy(1,ml,l) + amx*fxy(1,ml+1,l) + dxp*fxy(1,ml+2,l)) +
     2 dyp*(dxl*fxy(1,mp,l) + amx*fxy(1,mp+1,l) + dxp*fxy(1,mp+2,l)) 
      dy = amy*(dxl*fxy(2,mn,l) + amx*fxy(2,mn+1,l) + dxp*fxy(2,mn+2,l))
     1 + dyl*(dxl*fxy(2,ml,l) + amx*fxy(2,ml+1,l) + dxp*fxy(2,ml+2,l)) +
     2 dyp*(dxl*fxy(2,mp,l) + amx*fxy(2,mp+1,l) + dxp*fxy(2,mp+2,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field 
      oz = amy*(dxl*bz(mn,l) + amx*bz(mn+1,l) + dxp*bz(mn+2,l)) + dyl*(d
     1xl*bz(ml,l) + amx*bz(ml+1,l) + dxp*bz(ml+2,l)) + dyp*(dxl*bz(mp,l)
     2 + amx*bz(mp+1,l) + dxp*bz(mp+2,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,nop,l) = dx
      part(4,nop,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRBPUSH22L(part,fxy,bz,npp,noff,qbm,dt,dtc,ci,ek,nx,ny
     1,idimp,npmax,nblok,nxv,nypmx,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c in z direction, using the Boris Mover.
c scalar version using guard cells, for distributed data
c 72 flops/particle, 4 divides, 2 sqrts, 16 loads, 4 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = -rot(2)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(1)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (omz*dt/2)**2/(1 + (omz*dt/2)**2)
c    rot(2) = 2*(omz*dt/2)/(1 + (omz*dt/2)**2)
c where omz = (q/m)*bz(x(t),y(t))*gami, and
c gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bz(j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), bz(nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nn = nn + 1
      mm = mm - mnoff
      amx = 1. - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c find electric field
      dx = dyp*(dxp*fxy(1,np,mp,l) + amx*fxy(1,nn,mp,l)) + amy*(dxp*fxy(
     11,np,mm,l) + amx*fxy(1,nn,mm,l))
      dy = dyp*(dxp*fxy(2,np,mp,l) + amx*fxy(2,nn,mp,l)) + amy*(dxp*fxy(
     12,np,mm,l) + amx*fxy(2,nn,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      oz = dyp*(dxp*bz(np,mp,l) + amx*bz(nn,mp,l)) + amy*(dxp*bz(np,mm,l
     1) + amx*bz(nn,mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGSRBPUSH22L(part,fxy,bz,npp,noff,qbm,dt,dtc,ci,ek,nx,n
     1y,idimp,npmax,nblok,nxv,nxyp,ipbc)
c for 2d code, this subroutine updates particle co-ordinates and
c velocities using leap-frog scheme in time and first-order linear
c interpolation in space, for relativistic particles with magnetic field
c in z direction, using the Boris Mover.
c scalar version using guard cells, integer conversion precalculation,
c and 1d addressing, for distributed data
c 72 flops/particle, 4 divides, 2 sqrts, 16 loads, 4 stores
c input: all, output: part, ek
c momentum equations used are:
c px(t+dt/2) = rot(1)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(2)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fx(x(t),y(t))*dt)
c py(t+dt/2) = -rot(2)*(px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt) +
c    rot(1)*(py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt) +
c    .5*(q/m)*fy(x(t),y(t))*dt)
c where q/m is charge/mass, and the rotation matrix is given by:
c    rot(1) = (1 - (omz*dt/2)**2/(1 + (omz*dt/2)**2)
c    rot(2) = 2*(omz*dt/2)/(1 + (omz*dt/2)**2)
c where omz = (q/m)*bz(x(t),y(t))*gami, and
c gami = 1./sqrt(1.+(px(t)*px(t)+py(t)*py(t))*ci*ci)
c position equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg
c y(t+dt) = y(t) + py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c fx(x(t),y(t)), fy(x(t),y(t)), bz(x(t),y(t))
c are approximated by interpolation from the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1,m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c similarly for fy(x,y), bz(x,y)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c bz(j,k,l) = z component of magnetic field at grid (j,kk)
c that is, the convolution of magnetic field over particle shape
c qbm = particle charge/mass ratio
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c dt = time interval between successive calculations
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = gami*sum((px(t-dt/2) + .5*(q/m)*fx(x(t),y(t))*dt)**2 +
c      (py(t-dt/2) + .5*(q/m)*fy(x(t),y(t))*dt)**2)/(1. + gami)
c nx/ny = system length in x/y direction
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of field arrays, must be >= nx+1
c nxyp = second actual dimension of field array, must be >= nxv*nypmx
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      double precision sum1
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxyp,nblok), bz(nxyp,nblok)
      dimension npp(nblok), noff(nblok)
      qtmh = .5*qbm*dt
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      if (npp(l).lt.1) go to 20
      mnoff = noff(l)
c begin first particle
      nnn = part(1,1,l)
      mmn = part(2,1,l)
      dxn = part(1,1,l) - float(nnn)
      dyn = part(2,1,l) - float(mmn)
      mmn = mmn - mnoff
      nop1 = npp(l) - 1
      do 10 j = 1, nop1
c find interpolation weights
      nn = nnn + 1
      mm = nxv*mmn
      nnn = part(1,j+1,l)
      mmn = part(2,j+1,l)
      dxp = dxn
      dyp = dyn
      dxn = part(1,j+1,l) - float(nnn)
      dyn = part(2,j+1,l) - float(mmn)
      mm = mm + nn
      amx = 1. - dxp
      mp = mm + nxv
      amy = 1. - dyp
      mmn = mmn - mnoff
c find electric field
      dx = dyp*(dxp*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxp*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyp*(dxp*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxp*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,j,l) + dx
      acy = part(4,j,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      oz = dyp*(dxp*bz(mp+1,l) + amx*bz(mp,l)) + amy*(dxp*bz(mm+1,l) + a
     1mx*bz(mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,j,l) = dx
      part(4,j,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
      nop = npp(l)
c push last particle
      nn = nnn + 1
      mm = nxv*mmn
      mm = mm + nn
      amx = 1. - dxn
      mp = mm + nxv
      amy = 1. - dyn
c find electric field
      dx = dyn*(dxn*fxy(1,mp+1,l) + amx*fxy(1,mp,l)) + amy*(dxn*fxy(1,mm
     1+1,l) + amx*fxy(1,mm,l))
      dy = dyn*(dxn*fxy(2,mp+1,l) + amx*fxy(2,mp,l)) + amy*(dxn*fxy(2,mm
     1+1,l) + amx*fxy(2,mm,l))
c calculate half impulse
      dx = qtmh*dx
      dy = qtmh*dy
c half acceleration
      acx = part(3,nop,l) + dx
      acy = part(4,nop,l) + dy
c find inverse gamma
      p2 = acx*acx + acy*acy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c find magnetic field
      oz = dyn*(dxn*bz(mp+1,l) + amx*bz(mp,l)) + amy*(dxn*bz(mm+1,l) + a
     1mx*bz(mm,l))
c renormalize magnetic field
      qtmg = qtmh*gami
c time-centered kinetic energy
      sum1 = sum1 + gami*p2/(1.0 + gami)
c calculate cyclotron frequency
      omzt = qtmg*oz
c calculate rotation matrix
      omt = omzt*omzt
      anorm = 2./(1. + omt)
      rot1 = .5*(1. - omt)
      rot2 = omzt
c new velocity
      dx = (rot1*acx + rot2*acy)*anorm + dx
      dy = (rot1*acy - rot2*acx)*anorm + dy
      part(3,nop,l) = dx
      part(4,nop,l) = dy
c update inverse gamma
      p2 = dx*dx + dy*dy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c new position
      dx = part(1,nop,l) + dx*dtg
      dy = part(2,nop,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,nop,l)
            part(4,nop,l) = -part(4,nop,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,nop,l)
            part(3,nop,l) = -part(3,nop,l)
         endif
      endif
c set new position
      part(1,nop,l) = dx
      part(2,nop,l) = dy
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PRRETARD2(part,npp,dtc,ci,nx,ny,idimp,npmax,nblok,ipbc)
c for 2-1/2d code, particle positions are retarded a half time-step
c input: all, output: part
c equations used are:
c x(t+dt) = x(t) - px(t+dt/2)*dtg
c y(t+dt) = y(t) - py(t+dt/2)*dtg
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c npp(l) = number of particles in partition l
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgely = 0.
         edgerx = float(nx)
         edgery = float(ny)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgely = 0.
         edgerx = float(nx-1)
         edgery = float(ny)
      endif
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      vz = part(5,j,l)
      p2 = vx*vx + vy*vy + vz*vz
      dtg = dtc/sqrt(1.0 + p2*ci2)
c retard position half a time-step for current deposit
      dx = part(1,j,l) - vx*dtg
      dy = part(2,j,l) - vy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PRRETARD22(part,npp,dtc,ci,nx,ny,idimp,npmax,nblok,ipbc
     1)
c for 2d code, particle positions are retarded a half time-step
c input: all, output: part
c equations used are:
c x(t+dt) = x(t) - px(t+dt/2)*dtg
c y(t+dt) = y(t) - py(t+dt/2)*dtg, where
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c npp(l) = number of particles in partition l
c dtc = time interval between successive co-ordinate calculations
c ci = reciprical of velocity of light
c nx/ny = system length in x/y direction
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      ci2 = ci*ci
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgely = 0.
         edgerx = float(nx)
         edgery = float(ny)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgely = 0.
         edgerx = float(nx-1)
         edgery = float(ny)
      endif
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
c find inverse gamma
      vx = part(3,j,l)
      vy = part(4,j,l)
      p2 = vx*vx + vy*vy
      dtg = dtc/sqrt(1.0 + p2*ci2)
c retard position half a time-step for current deposit
      dx = part(1,j,l) - vx*dtg
      dy = part(2,j,l) - vy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PCPTOV2(part,npp,ci,idimp,npmax,nblok)
c for 2-1/2d code, this subroutine converts momentum to velocity for
c relativistic particles, for distributed data
c part(i,n,l) = part(i,n)/sqrt(1.+sum(part(i,n)**2)*ci*ci)
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c part(5,n,l) = z momentum of particle n in partition l
c ci = reciprical of velocity of light
c nop = number of particles
c idimp = size of phase space = 5
      implicit none
      integer npp, idimp, npmax, nblok
      real part, ci
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      integer j, l
      real ci2, vx, vy, vz, p2, gami
      ci2 = ci*ci
c convert from momentum to velocity
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
      vx = part(3,j,l)
      vy = part(4,j,l)
      vz = part(5,j,l)
      p2 = vx*vx + vy*vy + vz*vz
      gami = 1.0/sqrt(1.0 + p2*ci2)
      part(3,j,l) = vx*gami
      part(4,j,l) = vy*gami
      part(5,j,l) = vz*gami
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PCPTOV22(part,npp,ci,idimp,npmax,nblok)
c for 2d code, this subroutine converts momentum to velocity for
c relativistic particles, for distributed data
c part(i,n,l) = part(i,n)/sqrt(1.+sum(part(i,n)**2)*ci*ci)
c part(3,n,l) = x momentum of particle n in partition l
c part(4,n,l) = y momentum of particle n in partition l
c ci = reciprical of velocity of light
c nop = number of particles
c idimp = size of phase space = 4
      implicit none
      integer npp, idimp ,npmax, nblok
      real part, ci
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      integer j, l
      real ci2, vx, vy, p2, gami
      ci2 = ci*ci
c convert from momentum to velocity
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
      vx = part(3,j,l)
      vy = part(4,j,l)
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
      part(3,j,l) = vx*gami
      part(4,j,l) = vy*gami
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PRPUSH2ZF(part,npp,dt,ci,ek,idimp,npmax,nblok,nx,ny,ipb
     1c)
c for 2d code, this subroutine updates particle co-ordinates for
c relativistic particles with fixed velocities,
c with various boundary conditions, for distributed data
c 11 flops/particle, 2 divides, 1 sqrts, 4 loads, 2 stores
c input: all, output: part, ek
c equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg, y(t+dt) = y(t) + py(t+dt/2)*dtg,
c dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2))*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c npp(l) = number of particles in partition l
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2))**2 + (py(t-dt/2))**2)/(1. + gamma)
c where gamma = sqrt(1.+(px(t+dt/2)**2+py(t+dt/2)**2)*ci*ci)
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nx/ny = system length in x/y direction
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      implicit none
      integer npp, idimp, npmax, nblok, nx, ny, ipbc
      real part, dt, ci, ek
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      integer j, l
      real ci2, edgelx, edgely, edgerx, edgery, dx, dy, p2, gam, dtg
      double precision sum1
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
c velocity
      dx = part(3,j,l)
      dy = part(4,j,l)
c kinetic energy
      p2 = dx*dx + dy*dy
      gam = sqrt(1.0 + p2*ci2)
      sum1 = sum1 + p2/(1.0 + gam)
      dtg = dt/gam
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PRPUSH23ZF(part,npp,dt,ci,ek,idimp,npmax,nblok,nx,ny,ip
     1bc)
c for 2-1/2d code, this subroutine updates particle co-ordinates for
c relativistic particles with fixed velocities,
c with various boundary conditions.
c 13 flops/particle, 2 divides, 1 sqrts, 5 loads, 2 stores
c input: all, output: part, ek
c equations used are:
c x(t+dt) = x(t) + px(t+dt/2)*dtg, y(t+dt) = y(t) + py(t+dt/2)*dtg,
c where dtg = dtc/sqrt(1.+(px(t+dt/2)*px(t+dt/2)+py(t+dt/2)*py(t+dt/2)+
c pz(t+dt/2)*pz(t+dt/2))*ci*ci)
c part(1,n,l) = position x of particle n in partition l
c part(2,n,l) = position y of particle n in partition l
c part(3,n,l) = momentum px of particle n in partition l
c part(4,n,l) = momentum py of particle n in partition l
c part(5,n,l) = momentum pz of particle n in partition l
c npp(l) = number of particles in partition l
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c kinetic energy/mass at time t is also calculated, using
c ek = sum((px(t-dt/2))**2+(py(t-dt/2))**2+(pz(t-dt/2))**2)/(1. + gamma)
c where gamma=sqrt(1.+(px(t+dt/2)**2+py(t+dt/2)**2+pz(t+dt/2)**2)*ci*ci)
c idimp = size of phase space = 5
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nx/ny = system length in x/y direction
c ipbc = particle boundary condition = (0,1,2,3) =
c (none,2d periodic,2d reflecting,mixed reflecting/periodic)
      implicit none
      integer npp, idimp, npmax, nblok, nx, ny, ipbc
      real part, dt, ci, ek
      dimension part(idimp,npmax,nblok)
      dimension npp(nblok)
      integer j, l
      real ci2, edgelx, edgely, edgerx, edgery, dx, dy, dz, p2, gam, dtg
      double precision sum1
      ci2 = ci*ci
      sum1 = 0.0d0
c set boundary values
      if (ipbc.eq.1) then
         edgelx = 0.
         edgerx = float(nx)
      else if (ipbc.eq.2) then
         edgelx = 1.
         edgely = 1.
         edgerx = float(nx-1)
         edgery = float(ny-1)
      else if (ipbc.eq.3) then
         edgelx = 1.
         edgerx = float(nx-1)
      endif
      do 20 l = 1, nblok
      do 10 j = 1, npp(l)
c velocity
      dx = part(3,j,l)
      dy = part(4,j,l)
      dz = part(5,j,l)
c kinetic energy
      p2 = dx*dx + dy*dy + dz*dz
      gam = sqrt(1.0 + p2*ci2)
      sum1 = sum1 + p2/(1.0 + gam)
      dtg = dt/gam
c new position
      dx = part(1,j,l) + dx*dtg
      dy = part(2,j,l) + dy*dtg
c periodic boundary conditions
      if (ipbc.eq.1) then
         if (dx.lt.edgelx) dx = dx + edgerx
         if (dx.ge.edgerx) dx = dx - edgerx
c reflecting boundary conditions
      else if (ipbc.eq.2) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
         if ((dy.lt.edgely).or.(dy.ge.edgery)) then
            dy = part(2,j,l)
            part(4,j,l) = -part(4,j,l)
         endif
c mixed reflecting/periodic boundary conditions
      else if (ipbc.eq.3) then
         if ((dx.lt.edgelx).or.(dx.ge.edgerx)) then
            dx = part(1,j,l)
            part(3,j,l) = -part(3,j,l)
         endif
      endif
c set new position
      part(1,j,l) = dx
      part(2,j,l) = dy
   10 continue
   20 continue
c normalize kinetic energy
      ek = ek + sum1
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRCJPOST2(part,fxy,npp,noff,cu,qm,qbm,dt,ci,idimp,npma
     1x,nblok,nxv,nypmx)
c for 2d code, this subroutine calculates particle current density
c using second-order spline interpolation for relativistic particles.
c scalar version using guard cells, for distributed data
c 103 flops/particle, 1 sqrt, 40 loads, 18 stores
c input: all, output: cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(.75-dx**2)*(.75-dy**2)
c cu(i,n+1,m)=.5*qci*((.5+dx)**2)*(.75-dy**2)
c cu(i,n-1,m)=.5*qci*((.5-dx)**2)*(.75-dy**2)
c cu(i,n,m+1)=.5*qci*(.75-dx**2)*(.5+dy)**2
c cu(i,n+1,m+1)=.25*qci*((.5+dx)**2)*(.5+dy)**2
c cu(i,n-1,m+1)=.25*qci*((.5-dx)**2)*(.5+dy)**2
c cu(i,n,m-1)=.5*qci*(.75-dx**2)*(.5-dy)**2
c cu(i,n+1,m-1)=.25*qci*((.5+dx)**2)*(.5-dy)**2
c cu(i,n-1,m-1)=.25*qci*((.5-dx)**2)*(.5-dy)**2
c and qci = qm*pj*gami, where j = x,y, for i = 1, 2
c where pj = .5*(pj(t+dt/2)+pj(t-dt/2))
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c where n,m = nearest grid points and dx = x-n, dy = y-m
c momentum equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (.75-dy**2)*((.75-dx**2)*fx(n,m)+(.5*(.5+dx)**2)*fx(n+1,m)+
c (.5*(.5-dx)**2)*fx(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fx(n,m+1)+
c (.5*(.5+dx)**2)*fx(n+1,m+1)+(.5*(.5-dx)**2)*fx(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fx(n,m-1)+(.5*(.5+dx)**2)*fx(n+1,m-1)+
c (.5*(.5-dx)**2)*fx(n-1,m-1))
c fy(x,y) = (.75-dy**2)*((.75-dx**2)*fy(n,m)+(.5*(.5+dx)**2)*fy(n+1,m)+
c (.5*(.5-dx)**2)*fy(n-1,m)) + (.5*(.5+dy)**2)*((.75-dx**2)*fy(n,m+1)+
c (.5*(.5+dx)**2)*fy(n+1,m+1)+(.5*(.5-dx)**2)*fy(n-1,m+1)) +
c (.5*(.5-dy)**2)*((.75-dx**2)*fy(n,m-1)+(.5*(.5+dx)**2)*fy(n+1,m-1)+
c (.5*(.5-dx)**2)*fy(n-1,m-1))
c where n,m = nearest grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n at t in partition l
c part(2,n,l) = position y of particle n at t in partition l
c part(3,n,l) = momentum px of particle n at t - dt/2 in partition l
c part(4,n,l) = momentum py of particle n at t - dt/2 in partition l
c fxy(1,j+1,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j+1,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c cu(i,j+1,k,l) = ith component of current density
c at grid point j,kk for i = 1, 2
c qm = charge on particle, in units of e
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current density array, must be >= nx+3
c nypmx = maximum size of particle partition, including guard cells.
      implicit none
      integer npp, noff, idimp, npmax, nblok, nxv, nypmx
      real part, fxy, cu, qm, qbm, dt, ci
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), cu(2,nxv,nypmx,nblok)
      integer j, l, mnoff, nn, mm, nl, np, ml, mp
      real qtmh, ci2, gami, dxp, dyp, amx, amy, dxl, dyl
      real dx, dy, dz, vx, vy, p2
      qtmh = 0.5*qbm*dt
      ci2 = ci*ci
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l) + .5
      mm = part(2,j,l) + .5
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nl = nn + 1
      ml = mm - mnoff
      amx = .75 - dxp*dxp
      amy = .75 - dyp*dyp
      nn = nl + 1
      dxl = .5*(.5 - dxp)**2
      np = nl + 2
      dxp = .5*(.5 + dxp)**2
      mm = ml + 1
      dyl = .5*(.5 - dyp)**2
      mp = ml + 2
      dyp = .5*(.5 + dyp)**2
c find electric field
      dx = amy*(dxl*fxy(1,nl,mm,l) + amx*fxy(1,nn,mm,l) + dxp*fxy(1,np,m
     1m,l)) + dyl*(dxl*fxy(1,nl,ml,l) + amx*fxy(1,nn,ml,l) + dxp*fxy(1,n
     2p,ml,l)) + dyp*(dxl*fxy(1,nl,mp,l) + amx*fxy(1,nn,mp,l) + dxp*fxy(
     31,np,mp,l))
      dy = amy*(dxl*fxy(2,nl,mm,l) + amx*fxy(2,nn,mm,l) + dxp*fxy(2,np,m
     1m,l)) + dyl*(dxl*fxy(2,nl,ml,l) + amx*fxy(2,nn,ml,l) + dxp*fxy(2,n
     2p,ml,l)) + dyp*(dxl*fxy(2,nl,mp,l) + amx*fxy(2,nn,mp,l) + dxp*fxy(
     32,np,mp,l))
c new momentum
      vx = part(3,j,l) + qtmh*dx
      vy = part(4,j,l) + qtmh*dy
c find inverse gamma
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c deposit current density
      amx = qm*amx
      dxl = qm*dxl
      dxp = qm*dxp
      vx = gami*vx
      vy = gami*vy
      dx = dxl*amy
      dy = amx*amy
      dz = dxp*amy
      cu(1,nl,mm,l) = cu(1,nl,mm,l) + vx*dx
      cu(2,nl,mm,l) = cu(2,nl,mm,l) + vy*dx
      dx = dxl*dyl
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
      dy = amx*dyl
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dz
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dz
      dz = dxp*dyl
      cu(1,nl,ml,l) = cu(1,nl,ml,l) + vx*dx
      cu(2,nl,ml,l) = cu(2,nl,ml,l) + vy*dx
      dx = dxl*dyp
      cu(1,nn,ml,l) = cu(1,nn,ml,l) + vx*dy
      cu(2,nn,ml,l) = cu(2,nn,ml,l) + vy*dy
      dy = amx*dyp
      cu(1,np,ml,l) = cu(1,np,ml,l) + vx*dz
      cu(2,np,ml,l) = cu(2,np,ml,l) + vy*dz
      dz = dxp*dyp
      cu(1,nl,mp,l) = cu(1,nl,mp,l) + vx*dx
      cu(2,nl,mp,l) = cu(2,nl,mp,l) + vy*dx
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dz
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dz
   10 continue
   20 continue
      return
      end
c-----------------------------------------------------------------------
      subroutine PGRCJPOST2L(part,fxy,npp,noff,cu,qm,qbm,dt,ci,idimp,npm
     1ax,nblok,nxv,nypmx)
c for 2d code, this subroutine calculates particle current density
c using first-order spline interpolation for relativistic particles.
c scalar version using guard cells, for distributed data
c 59 flops/particle, 1 sqrt, 20 loads, 0 stores
c input: all, output: cu
c current density is approximated by values at the nearest grid points
c cu(i,n,m)=qci*(1.-dx)*(1.-dy)
c cu(i,n+1,m)=qci*dx*(1.-dy)
c cu(i,n,m+1)=qci*(1.-dx)*dy
c cu(i,n+1,m+1)=qci*dx*dy
c and qci = qm*pj*gami, where j = x,y, for i = 1, 2
c where pj = .5*(pj(t+dt/2)+pj(t-dt/2))
c where gami = 1./sqrt(1.+sum(pi**2)*ci*ci)
c where n,m = nearest grid points and dx = x-n, dy = y-m
c momentum equations used are:
c px(t+dt/2) = px(t-dt/2) + (q/m)*fx(x(t),y(t))*dt,
c py(t+dt/2) = py(t-dt/2) + (q/m)*fy(x(t),y(t))*dt,
c where q/m is charge/mass, and
c fx(x(t),y(t)) and fy(x(t),y(t)) are approximated by interpolation from
c the nearest grid points:
c fx(x,y) = (1-dy)*((1-dx)*fx(n,m)+dx*fx(n+1,m)) + dy*((1-dx)*fx(n,m+1)
c    + dx*fx(n+1.m+1))
c fy(x,y) = (1-dy)*((1-dx)*fy(n,m)+dx*fy(n+1,m)) + dy*((1-dx)*fy(n,m+1)
c    + dx*fy(n+1.m+1))
c where n,m = leftmost grid points and dx = x-n, dy = y-m
c part(1,n,l) = position x of particle n at t in partition l
c part(2,n,l) = position y of particle n at t in partition l
c part(3,n,l) = momentum px of particle n at t - dt/2 in partition l
c part(4,n,l) = momentum py of particle n at t - dt/2 in partition l
c fxy(1,j,k,l) = x component of force/charge at grid (j,kk)
c fxy(2,j,k,l) = y component of force/charge at grid (j,kk)
c that is, convolution of electric field over particle shape
c where kk = k + noff(l) - 1
c npp(l) = number of particles in partition l
c noff(l) = lowermost global gridpoint in particle partition l.
c cu(i,j,k,l) = ith component of current density
c at grid point j,kk for i = 1, 2
c qm = charge on particle, in units of e
c qbm = particle charge/mass ratio
c dt = time interval between successive calculations
c ci = reciprical of velocity of light
c idimp = size of phase space = 4
c npmax = maximum number of particles in each partition
c nblok = number of particle partitions.
c nxv = first dimension of current density array, must be >= nx+1
c nypmx = maximum size of particle partition, including guard cells.
      implicit none
      integer npp, noff, idimp, npmax, nblok, nxv, nypmx
      real part, fxy, cu, qm, qbm, dt, ci
      dimension part(idimp,npmax,nblok)
      dimension fxy(2,nxv,nypmx,nblok), cu(2,nxv,nypmx,nblok)
      dimension npp(nblok), noff(nblok)
      integer j, l, mnoff, nn, mm, np, mp
      real qtmh, ci2, gami, dxp, dyp, amx, amy, dx, dy, vx, vy, p2
      qtmh = 0.5*qbm*dt
      ci2 = ci*ci
      do 20 l = 1, nblok
      mnoff = noff(l) - 1
      do 10 j = 1, npp(l)
c find interpolation weights
      nn = part(1,j,l)
      mm = part(2,j,l)
      dxp = part(1,j,l) - float(nn)
      dyp = part(2,j,l) - float(mm)
      nn = nn + 1
      mm = mm - mnoff
      amx = 1. - dxp
      mp = mm + 1
      amy = 1. - dyp
      np = nn + 1
c find electric field
      dx = dyp*(dxp*fxy(1,np,mp,l) + amx*fxy(1,nn,mp,l)) + amy*(dxp*fxy(
     11,np,mm,l) + amx*fxy(1,nn,mm,l))
      dy = dyp*(dxp*fxy(2,np,mp,l) + amx*fxy(2,nn,mp,l)) + amy*(dxp*fxy(
     12,np,mm,l) + amx*fxy(2,nn,mm,l))
c new momentum
      vx = part(3,j,l) + qtmh*dx
      vy = part(4,j,l) + qtmh*dy
c find inverse gamma
      p2 = vx*vx + vy*vy
      gami = 1.0/sqrt(1.0 + p2*ci2)
c deposit current density
      amx = qm*amx
      dxp = qm*dxp
      vx = gami*vx
      vy = gami*vy
      dx = dxp*dyp
      dy = amx*dyp
      cu(1,np,mp,l) = cu(1,np,mp,l) + vx*dx
      cu(2,np,mp,l) = cu(2,np,mp,l) + vy*dx
      dx = dxp*amy
      cu(1,nn,mp,l) = cu(1,nn,mp,l) + vx*dy
      cu(2,nn,mp,l) = cu(2,nn,mp,l) + vy*dy
      dy = amx*amy
      cu(1,np,mm,l) = cu(1,np,mm,l) + vx*dx
      cu(2,np,mm,l) = cu(2,np,mm,l) + vy*dx
      cu(1,nn,mm,l) = cu(1,nn,mm,l) + vx*dy
      cu(2,nn,mm,l) = cu(2,nn,mm,l) + vy*dy
   10 continue
   20 continue
      return
      end