subroutine trxpl_imaswr2d_cdf(tpath,ztime0,ztavg,nbccw,npccw)

  !  write NetCDF file containing data for IMAS database, namely:
  ! 
  !   nR, nZ, & R & Z grids: Rr, Zz, [m]
  !   BR(R,Z), BZ(R,Z), Btor(R,Z), all in  [T]
  !   G(R,Z) - Gfun = R*Bt, [m*T]
  !   psi(R,Z) - poloidal flux, tflux(R,Z) - toroidal flux, in [Wb]
  !   theta(R,Z) - equilibrium poloidal angle, [rad]
  !   curt(R,Z) - total enclosed toroidal current(R,Z) density, [A/m**2]
  !   curpll(R,Z) -  parallel current(R,Z) density , ~<J.B>/|B|', [A/m**2] ...
  ! 

  implicit NONE

  character*(*), intent(in) :: tpath    ! TRANSP run specification
  real*8, intent(in) :: ztime0          ! time of interest
  real*8, intent(in) :: ztavg           ! +/- delta(t) time averaging
  integer, intent(in) :: nbccw          ! Btoroidal orientation
  integer, intent(in) :: npccw          ! Plasma current orientation
  ! convention is +1 "ccw" means "counter-clockwise looking down from above"
  !               -1  for clockwise orientation
  include 'trxpl.blk'  !... to communicate with trxpl_add_profile

  real*8 Rminx,Rmaxx,Zminx,Zmaxx      ! limits of xplasma grid
  real*8 Rminpl,Rmaxpl,Zminpl,Zmaxpl  ! limits of plasma boundary
  real*8 Rmin,Rmax,Zmin,Zmax          ! limits of grid for IMASWR2D

  real*8 dxtend                       ! amount of extension of grid beyond
                                      ! plasma bdy, subject to conditions

  integer :: nR,nZ                    ! gridsizes
  integer :: nbdy                     ! bdy contour size

  real*8, dimension(:), allocatable :: Rr,Zz  ! grids

  real*8, dimension(:), allocatable :: Rbdy,Zbdy    ! plasma bdy sequence

  !  (R,Z) variables, as described above:

  real*8, dimension(:,:), allocatable :: br,bz,bb,bt,psi,tflux,gfun,curt,curpll,theq

  !  constants, as described above, and...

  real*8, parameter :: ZERO = 0.0d0
  real*8, parameter :: ONE = 1.0d0
  real*8, parameter :: XPI = 3.1415926535897931D+00
  real*8, parameter :: TWOPI = 6.2831853071795862D+00   ! 2.0*PI

  !  additional items

  integer, parameter :: igmin = 10      ! sanity limits on gridsizes
  integer, parameter :: igmax = 2000

  integer ierr,lnout
  logical lxout,lchar,lyes
  character*120 zfile
  character*35 tlabel
  character*10 zname

  real*8 zrhomin,zrhomax
  integer :: idq
  real*8 r_mag_axis,z_mag_axis

  integer ingen

  !-------------------------------------------------------------------

  tlabel=' '
  write(tlabel,999) ztime0,ztavg
999 format('t = ',1pd11.4,' +/- ',1pd11.4,' s.')
  !-------------------------------------------------------------------
  !  xplasma has already been set up
  !-------------------------------------------------------------------

  !  get plasma & grid R,Z limits

  call eq_rholim(zrhomin,zrhomax)  ! axis & bdy rho

  call eq_rzlims(Rminx,Rmaxx,Zminx,Zmaxx,ierr)  ! xplasma grid limits
  if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eq_rzlims error.')

  call eq_glimrz(zrhomax,Rminpl,Rmaxpl,Zminpl,Zmaxpl,ierr)  ! plasma bdy limits
  if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eq_glimrz error.')

  !--------------------------------
  !  set default controls

  dxtend = 0.05d0     ! grid extension beyond plasma boundary, m
  nR = 101            ! number of R grid points
  nZ = 101            ! number of Z grid points

  !--------------------------------
  !  user specification of controls

  do

     Rmin=max(Rminx,Rminpl/2,Rminpl-dxtend)
     Rmax=min(Rmaxx,Rmaxpl+dxtend)
     Zmin=max(Zminx,Zminpl-dxtend)
     Zmax=min(Zmaxx,Zmaxpl+dxtend)

     if(lxout(0)) then
        write(lnout(0),1001) nR,Rmin,Rmax, &
             nZ,Zmin,Zmax,dxtend
1001    format(/' IMASWR2D grid (meters):'/ &
             5x,i4,' R points with Rmin=',1pd11.4,' & Rmax=',1pd11.4/ &
             5x,i4,' Z points with Zmin=',1pd11.4,' & Zmax=',1pd11.4/ &
             ' based on nominal extension of ',1pd11.4,' m beyond plasma bdy.'/ &
             /'trxpl_imaswr2d options:'/ &
             ' "R" -- change number of R grid points'/ &
             ' "Z" -- change number of Z grid points'/ &
             ' "X" -- change extension distance beyond plasma boundary'/ &
             '        (extension constrained by xplasma grid limits)'/ &
             ' "A" -- accept parameters and proceed'/ &
             ' "Q" -- quit (without writing data).'/)
     endif

     call uread('trxpl_imaswr2d: choose option:$')

     if(lchar('Q')) then
        return   ! do not write data

     else if(lchar('A')) then
        exit     ! proceed with parameters as selected

     else if(lchar('R')) then
        ! set nR
        if(lxout(0)) write(lnout(0),1004) igmin,igmax
        call ureadi('number of R grid points (nR):$',nR)
        nR=max(igmin,min(igmax,nR))

     else if(lchar('Z')) then
        ! set nZ
        if(lxout(0)) write(lnout(0),1004) igmin,igmax
        call ureadi('number of Z grid points (nZ):$',nZ)
        nZ=max(igmin,min(igmax,nZ))

     else if(lchar('X')) then
        ! set dxtend
        call ureadr8('grid extension beyond plasma bdy (m):$',dxtend)
        dxtend=abs(dxtend)

     else
        call uermsg('?trxpl_imaswr2d: unrecognized option code.',' ',0)
     endif

1004    format(' minimum gridsize: ',i4,' maximum gridsize: ',i4)
  enddo
  ixtnd=1
  iordr=1
  zlamda=1.0d30

  zname='CUR'
  call trxpl_add_profile(zname)
  if(numpro.ne.1) return
  
  zname='PLJB'
  call trxpl_add_profile(zname)
  if(numpro.ne.2) return

  zname='PLFLX2PI'
  call trxpl_add_profile(zname)
  if(numpro.ne.3) return

  zname='TRFLX'
  call trxpl_add_profile(zname)
  if(numpro.ne.4) return

  !----------------------------------
  !  allocate local arrays

  nbdy=2*(nR+nZ)
  allocate(Rr(nR),Zz(nZ))
  allocate(Rbdy(nbdy),Zbdy(nbdy))
  allocate(br(nR,nZ),bz(nR,nZ),bb(nR,nZ),bt(nR,nZ),psi(nR,nZ),tflux(nR,nZ),curt(nR,nZ))
  allocate(curpll(nR,nZ),theq(nR,nZ),gfun(nR,nZ))
  call calculate

  call display

  call uread(' write NetCDF file for IMASWR2D? (Y/N):$')

  if(lyes(0)) then
     zfile=' '
     call unixfile('trxpl_imaswr2d',zfile)
     call write_cdf
!     call trxpl_imasrd2d_cdf(zfile)
  endif

  deallocate(Rr,Zz)
  deallocate(Rbdy,Zbdy)
  deallocate(br,bz,bb,bt,psi,tflux,curt,curpll,theq,gfun)

contains

  !====================================================================
  subroutine calculate

    !  compute 2d profiles wanted by imaswr2d

    real*8 rhovec(nbdy),thvec(nbdy),phivec(nbdy)
    real*8 zwk(nR,8)
    integer i,j,k
    integer :: iregion(nbdy) !region for xplasma calls
    integer :: id_BR=0,id_BZ=0,id_Bphi=0,id_g=0,ids(8)
    integer :: id_psi=0,id_tflux=0,id_curt=0,id_curpll=0
    real*8 ztmp(nr)
    real*8, parameter :: tol=1.e-8
    real*8 zrho(1),zth(1),th1(1) ! for xplasma call
 
    !  mag axis...

    rhovec(1)=zrhomin
    thvec(1)=ZERO
    phivec(1)=ZERO
    call eq_rzget(1,rhovec(1:1),thvec(1:1),phivec(1:1),rbdy(1:1),zbdy(1:1), &
         iregion(1:1),ierr)
    if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eq_rzget error @axis.')
    r_mag_axis=rbdy(1)
    z_mag_axis=zbdy(1)

    !  ids ...

    call eq_gfnum('BR',id_br); ids(1)=id_br
    call eq_gfnum('BZ',id_bz); ids(2)=id_bz
    call eq_gfnum('Bphi',id_bphi); ids(3)=id_bphi
    ! psi:  poloidal flux, Webers   
    call eq_gfnum('PLFLX2PI',id_psi); ids(4)=id_psi
    ! plasma total toroidal current density A/m**2
    call eq_gfnum('CUR', id_curt); ids(5)=id_curt
    ! <j.B> current density A*T/m**2
    call eq_gfnum('PLJB', id_curpll); ids(6)=id_curpll
    ! toroidal flux (Webers)
    call eq_gfnum('TRFLX', id_tflux); ids(7)=id_tflux

    ! R*Bt (T*m)
    call eq_gfnum('G', id_g)
    if(id_g.gt.0) then
       call eqm_rzfun(id_g,zlamda,1,ZERO,ierr)
       if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eqm_rzfun error.')
    else
       call errmsg_exit('?trxpl_imaswr2d: no G profile data.')
    endif
    ids(8)=id_g
    

    rhovec = zrhomax
    phivec = 0
    do i=1,nbdy
       thvec(i) = (i-1)*twopi/(nbdy-1)
    enddo

    call eq_rzget(nbdy,rhovec,thvec,phivec,rbdy,zbdy,iregion,ierr)
    if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eq_rzget error.')

    rbdy(nbdy)=rbdy(1)  ! guarantee exact closure of the bdy contour
    zbdy(nbdy)=zbdy(1)

    !  form R & Z grids

    do i=1,nR
       Rr(i)=(Rmin*(nR-i)+Rmax*(i-1))/(nR-1)
    enddo

    do i=1,nZ
       Zz(i)=(Zmin*(nZ-i)+Zmax*(i-1))/(nZ-1)
    enddo

    theq=ZERO
    zrho=ZERO
    zth=ZERO
    do i=1,nR
       do j=1,nZ
          call eq_inv(1,Rr(i),Zz(j),zth(1),tol,zrho(1),th1(1),iregion(1:1),ierr)
          do while(th1(1) < -xpi)
             th1(1) = th1(1) + twopi
          enddo
          do while(th1(1) > xpi)
             th1(1) = th1(1) - twopi
          enddo
          theq(i,j)=th1(1)
       enddo
    enddo
    !  interpolate B field data ... 1 row at a time

    do i=1,nZ
       ztmp=Zz(i)
       call eq_frz(nR,Rr,ztmp,8,ids,nR,zwk,ierr)
       if(ierr.ne.0) call errmsg_exit('?trxpl_imaswr2d: eq_frz error.')

       br(1:nr,i)=zwk(1:nR,1)
       bz(1:nr,i)=zwk(1:nR,2)
       bb(1:nr,i)=sqrt( zwk(1:nR,1)**2 + zwk(1:nR,2)**2 + zwk(1:nR,3)**2 ) !Bmod
       psi(1:nr,i)=zwk(1:nR,4)
       tflux(1:nr,i)=zwk(1:nR,7)
       gfun(1:nr,i)=zwk(1:nR,8)
       bt(1:nR,i)=zwk(1:nR,8)/Rr(1:nR)
       curt(1:nR,i)=zwk(1:nR,5)
       curpll(1:nR,i)=zwk(1:nR,6)/bb(1:nr,i)

    enddo


  end subroutine calculate

  !====================================================================
  subroutine display

    real*8 wk(max(nR,nZ))

    wk = 0

    do
 
       if(lxout(0)) then
          write(lnout(0),1001) r_mag_axis,z_mag_axis
1001      format(' (R,Z) of magnetic axis (m):',2(1x,1pe11.4)/ &
               /'display options:'/ &
               ' "A" -- Br(R,Z)'/ &
               ' "B" -- Bz(R,Z)'/ &
               ' "C" -- Bt(R,Z)'/ &
               ' "D" -- |B|(R,Z)'/ &
               ' "G" -- GFUN(R,Z)'/ &
               ' "T" -- Tflux(R,Z)'/ &
               ' "P" -- Polflux(R,Z)'/ &
               ' "H" -- ThetaT(R,Z)'/ &
               ' "J" -- CurT(R,Z)'/ &
               ' "L" -- CurPll(R,Z)'/ &
               ' "X" -- xplasma debug plots.'/ &
               ' "Q" -- quit plotting menu.'/ &
               )
       endif

       call uread('trxpl_imaswr2d(display): specify plotting option:$')

       if(lchar('A')) then
          call r8_grf3f1(Rr,br,Zz,wk,nR,nZ,nR, &
               'R','Br','Z', &
               'm','T','m', tpath,tlabel,0)

       else if(lchar('B')) then
          call r8_grf3f1(Rr,bz,Zz,wk,nR,nZ,nR, &
               'R','Bz','Z', &
               'm','T','m', tpath,tlabel,0)

       else if(lchar('C')) then
          call r8_grf3f1(Rr,bt,Zz,wk,nR,nZ,nR, &
               'R','Bt','Z', &
               'm','T','m', tpath,tlabel,0)

        else if(lchar('D')) then
          call r8_grf3f1(Rr,bb,Zz,wk,nR,nZ,nR, &
               'R','|B|','Z', &
               'm','T','m', tpath,tlabel,0)

      else if(lchar('G')) then
          call r8_grf3f1(Rr,gfun,Zz,wk,nR,nZ,nR, &
               'R','G','Z', &
               'm','T*m','m', tpath,tlabel,0)

       else if(lchar('T')) then
          call r8_grf3f1(Rr,tflux,Zz,wk,nR,nZ,nR, &
               'R','Trflux','Z', &
               'm','Wb','m', tpath,tlabel,0)

       else if(lchar('P')) then
          call r8_grf3f1(Rr,psi,Zz,wk,nR,nZ,nR, &
               'R','Plflux','Z', &
               'm','Wb','m', tpath,tlabel,0)

       else if(lchar('H')) then
          call r8_grf3f1(Rr,theq,Zz,wk,nR,nZ,nR, &
               'R','Theta','Z', &
               'm','rad','m', tpath,tlabel,0)

       else if(lchar('J')) then
          call r8_grf3f1(Rr,curt,Zz,wk,nR,nZ,nR, &
               'R','curt','Z', &
               'm','A/m2','m', tpath,tlabel,0)
 
       else if(lchar('L')) then
          call r8_grf3f1(Rr,curpll,Zz,wk,nR,nZ,nR, &
               'R','curPll','Z', &
               'm','A/m2','m', tpath,tlabel,0)
          
          
       else if(lchar('X')) then
          call eqdbg_plot

       else if(lchar('Q')) then
          exit
       else
          call uermsg('?trxpl_imaswr2d(display): unrecogized option.',' ',0)
       endif

    enddo

  end subroutine display

  subroutine write_cdf

    use ezcdf

    integer ncid,ierr,ilf

    !  write NetCDF file for IMASWR2D

    ilf=len_trim(zfile)

    call cdf_open(ncid,zfile(1:ilf),'w',ierr)
    if(ierr.ne.0) then
       write(lnout(0),*) ' ?trxpl_imaswr2d: NetCDF open failure: ',zfile(1:ilf)

    else

       !  ** NetCDF definitions **

       !  TRANSP data source info
       call cdf_define(ncid,'TRANSP_path',tpath)
       call cdf_define(ncid,'time',ztime0)
       call cdf_define(ncid,'avg_delta_t',ztavg)
       
       !  grids
       call cdf_define(ncid,'nr',nR)
       call cdf_define(ncid,'nz',nZ)
       call cdf_define(ncid,'rr',Rr)
       call cdf_define(ncid,'zz',Zz)

       !  main data
       call cdf_define(ncid,'nbccw',nbccw)
       call cdf_define(ncid,'npccw',npccw)
       call cdf_define(ncid,'br',br)
       call cdf_define(ncid,'bz',bz)
       call cdf_define(ncid,'bt',bt)
       call cdf_define(ncid,'gfun',gfun)
       call cdf_define(ncid,'theta',theq)
       call cdf_define(ncid,'psi',psi)
       call cdf_define(ncid,'tflux',tflux)
       call cdf_define(ncid,'curt',curt)
       call cdf_define(ncid,'curpll',curpll)
       !  plasma bdy & scrape-off information
       call cdf_define(ncid,'r_mag_axis',r_mag_axis)
       call cdf_define(ncid,'z_mag_axis',z_mag_axis)
       call cdf_define(ncid,'dxtend',dxtend)
       call cdf_define(ncid,'nbdy',nbdy)
       call cdf_define(ncid,'rbdy',Rbdy)
       call cdf_define(ncid,'zbdy',Zbdy)
       
       !  addl labeling/attributes
       call cdf_setatt(ncid,'time','time slice from TRANSP', 'sec')
       call cdf_setatt(ncid,'avg_delta_t','delta(time), +/- for averaging', 'sec')
       call cdf_setatt(ncid,'nz','grid size, Z')
       call cdf_setatt(ncid,'nr','grid size, R')
       call cdf_setatt(ncid,'nz','grid size, Z')
       call cdf_setatt(ncid,'rr','Cartesian grid, R major radius', 'm')
       call cdf_setatt(ncid,'zz','Cartesian grid, Z coordinate', 'm')
       call cdf_setatt(ncid,'nbccw','Btoroidal orientation; +1 ccw looking down from above; -1 clockwise')
       call cdf_setatt(ncid,'npccw','Plasma current orientation; +1 ccw looking down from above; -1 clockwise')
       call cdf_setatt(ncid,'br','magnetic field BR(R,Z) component', 'T')
       call cdf_setatt(ncid,'bz','magnetic field BZ(R,Z) component', 'T')
       call cdf_setatt(ncid,'bt','magnetic field Bt(R,Z) toroidal component', 'T')
       call cdf_setatt(ncid,'gfun','g-function,R*Bt(R,Z)', 'T*m')
       call cdf_setatt(ncid,'theta','equilibrium poloidal angle(R,Z)', 'rad')
       call cdf_setatt(ncid,'psi','poloidal flux(R,Z)', 'Wb')
       call cdf_setatt(ncid,'tflux','toroidal flux(R,Z)', 'Wb')
       call cdf_setatt(ncid,'curt','total enclosed toroidal current(R,Z) density', 'A/m**2')
       call cdf_setatt(ncid,'curpll','parallel current(R,Z) density , ~<J.B>/|B|', 'A/m**2')
       call cdf_setatt(ncid,'r_mag_axis','R magnetic axis', 'm')
       call cdf_setatt(ncid,'z_mag_axis','Z magnetic axis', 'm')
       call cdf_setatt(ncid,'dxtend','grid extension beyond plasma bdoundary','m')
       call cdf_setatt(ncid,'nbdy','bdy contour size')
       call cdf_setatt(ncid,'rbdy','R bdy, guarantee exact closure of the bdy contour', 'm')
       call cdf_setatt(ncid,'zbdy','Z bdy, guarantee exact closure of the bdy contour', 'm')
      !  ** NetCDF writes **

       !  TRANSP data source info
       call cdf_write(ncid,'TRANSP_path',tpath)
       call cdf_write(ncid,'time',ztime0)
       call cdf_write(ncid,'avg_delta_t',ztavg)

       !  grids
       call cdf_write(ncid,'nr',nR)
       call cdf_write(ncid,'nz',nZ)
       call cdf_write(ncid,'rr',Rr)
       call cdf_write(ncid,'zz',Zz)

       !  main data
       call cdf_write(ncid,'nbccw',nbccw)
       call cdf_write(ncid,'npccw',npccw)
       call cdf_write(ncid,'bz',bz)
       call cdf_write(ncid,'br',br)
       call cdf_write(ncid,'bz',bz)
       call cdf_write(ncid,'bt',bt)
       call cdf_write(ncid,'gfun',gfun)
       call cdf_write(ncid,'theta',theq)
       call cdf_write(ncid,'psi',psi)
       call cdf_write(ncid,'tflux',tflux)
       call cdf_write(ncid,'curt',curt)
       call cdf_write(ncid,'curpll',curpll)

       !  plasma bdy & scrape-off information
       call cdf_write(ncid,'r_mag_axis',r_mag_axis)
       call cdf_write(ncid,'z_mag_axis',z_mag_axis)
       call cdf_write(ncid,'dxtend',dxtend)
       call cdf_write(ncid,'nbdy',nbdy)
       call cdf_write(ncid,'rbdy',Rbdy)
       call cdf_write(ncid,'zbdy',Zbdy)

       !  ** all done **

       call cdf_close(ncid)

    endif

  end subroutine write_cdf

end subroutine trxpl_imaswr2d_cdf
