c-----------------------------------------------------------------------
      subroutine trxpl_wrtreq(lun,id_psi,id_pmhd,id_qmhd,id_gmhd,ierr)
c
c  write "Alan Glasser" style TREQ (transp equilibrium) ascii file.
c  these files also used by "test_xplasma" and see xplasma/rdtreq.f90.
c  (dmc June 2002)
c
c--------------------------------------------------------
      implicit NONE
      integer, intent(in) :: lun        ! Fortran LUN of file open for write
      integer, intent(in) :: id_psi,id_pmhd,id_qmhd,id_gmhd
                                        ! xplasma id's of eq. profiles.
      integer, intent(out) :: ierr      ! output status code (0=OK)
c
c--------------------------------------------------------
c
      character*80 str
      integer ilen
c
      integer :: id_rho=0,id_theta=0,nrho,ntheta
      integer i,j,igot
c
      real*8 ztime,zdelta_t,zscval
c
      real*8, dimension(:), allocatable :: rhotmp,thtmp,ftmp,rhovec,
     >   phvec
      integer, dimension(:), allocatable :: nregion
      real*8, dimension(:,:), allocatable :: rr,zz
c--------------------------------------------------------
 1001 format(1x,a)
 1002 format(1x,1pd13.6)
 1003 format(1x,i6)
 1004 format(5(1x,1pd13.6))
c
c  label
c
      call trx_label(str)
      ilen=len_trim(str)
 
      write(lun,1001) 'TRANSP runid/path:'
      write(lun,1001) str(1:ilen)
c
c  times
c
      call trx_gtime(ztime,zdelta_t,ierr)
      if(ierr.ne.0) return
 
      write(lun,1001) 'time:  data time, seconds:'
      write(lun,1002) ztime
      write(lun,1001) 'tavg:  +/- averaging time, seconds:'
      write(lun,1002) zdelta_t
c
c  plasma current
c
      call trx_scal('PCUR',str,zscval,ierr)
      if(ierr.ne.0) return
 
      write(lun,1001) 'pcur:  plasma current, Amps:'
      write(lun,1002) zscval
c
c  enclosed toroidal flux
c
      call trx_scal('TFLUX',str,zscval,ierr)
      if(ierr.ne.0) return
 
      write(lun,1001) 'tflux:  enclosed toroidal flux, Webers:'
      write(lun,1002) zscval
c
c  grids
c
      call eq_ganum('__RHO',id_rho)
      call eq_ganum('__CHI',id_theta)
 
      call eq_ngrid(id_rho,nrho)
      call eq_ngrid(id_theta,ntheta)
 
      write(lun,1001) 'ntheta:  theta grid size:'
      write(lun,1003) ntheta
 
      write(lun,1001) 'nsurf:  no. of flux surfaces:'
      write(lun,1003) nrho
c
      allocate(rhotmp(nrho),thtmp(ntheta))
 
      call eq_grid(id_rho,rhotmp,nrho,igot,ierr)
      if(ierr.ne.0) go to 999
 
      call eq_grid(id_theta,thtmp,ntheta,igot,ierr)
      if(ierr.ne.0) go to 999
 
c  put theta in positive range [0,2pi]
      zscval=thtmp(1)
      thtmp(1)=0.0
      do j=2,ntheta
         thtmp(j)=thtmp(j)-zscval
      enddo
 
c  write the grid values:
      write(lun,1001) 'theta:  theta grid, radians:'
      write(lun,1004) (thtmp(j),j=1,ntheta)
 
      write(lun,1001)
     >   'rho:  flux surface label, normalized sqrt(tor. flux):'
      write(lun,1004) (rhotmp(j),j=1,nrho)
c
c  write profiles
c
      allocate(ftmp(nrho))
c
c  psi
c
      call eq_rgetf(nrho,rhotmp,id_psi,0,ftmp,ierr)
      if(ierr.ne.0) go to 999
c
      write(lun,1001) 'psi:  poloidal flux, Webers/radian:'
      write(lun,1004) (ftmp(j),j=1,nrho)
c
c  pmhd
c
      call eq_rgetf(nrho,rhotmp,id_pmhd,0,ftmp,ierr)
      if(ierr.ne.0) go to 999
c
      write(lun,1001) 'pmhd:  pressure, Pascals:'
      write(lun,1004) (ftmp(j),j=1,nrho)
c
c  qmhd
c
      call eq_rgetf(nrho,rhotmp,id_qmhd,0,ftmp,ierr)
      if(ierr.ne.0) go to 999
c
      write(lun,1001) 'qmhd:  q profile:'
      write(lun,1004) (ftmp(j),j=1,nrho)
c
c  gmhd
c
      call eq_rgetf(nrho,rhotmp,id_gmhd,0,ftmp,ierr)
      if(ierr.ne.0) go to 999
c
      write(lun,1001) 'gmhd:  g profile (R*Bt), m*Tesla:'
      write(lun,1004) (ftmp(j),j=1,nrho)
c
c  (R,Z)
c
      allocate(nregion(ntheta))
      allocate(rhovec(ntheta),phvec(ntheta))
      allocate(rr(ntheta,nrho),zz(ntheta,nrho))
c
      phvec=0
c
      do j=1,nrho
         rhovec=rhotmp(j)
         call eq_rzget(ntheta,rhovec,thtmp,phvec,
     >      rr(1:ntheta,j),zz(1:ntheta,j),nregion,ierr)
         if(ierr.ne.0) go to 999
      enddo
c
      write(lun,1001) 'R:  R, m:  ((R(i,j),i=1,ntheta),j=1,nsurf)'
      write(lun,1004) ((rr(i,j),i=1,ntheta),j=1,nrho)
 
      write(lun,1001) 'Z:  Z, m:  ((Z(i,j),i=1,ntheta),j=1,nsurf)'
      write(lun,1004) ((zz(i,j),i=1,ntheta),j=1,nrho)
c
 999  continue
c
      if(allocated(rhotmp)) deallocate(rhotmp)
      if(allocated(thtmp)) deallocate(thtmp)
      if(allocated(ftmp)) deallocate(ftmp)
 
      if(allocated(nregion)) deallocate(nregion)
      if(allocated(rhovec)) deallocate(rhovec,phvec)
      if(allocated(rr)) deallocate(rr,zz)
 
      return
      end
