      subroutine ts_write_r8(out_file,cdf_file,rlabel,trpath,
     >     time_r8,deltat_r8,ierr_open)

c! R8 interface to ts_write_r4
c!    actual file write is in ascii, 5 decimal digit precision.

      implicit NONE

      character*(*), intent(in) :: out_file  ! ASCII output file
      character*(*), intent(in) :: cdf_file  ! NetCDF output file

      ! if both the above are blank this routine returns without writing
      ! any file, issuing a warning.

      ! if out_file is non-blank the named ascii file is written and saved.
      ! if cdf_file is non-blank the named NetCDF file is written and saved.
      ! if cdf_file is non-blank but out_file is blank, a temporary ascii
      ! file is used, but not saved.

      character*(*), intent(in) :: rlabel   ! run label
      character*(*), intent(in) :: trpath   ! file or MDS+ path to run

      real*8, intent(in) :: time_r8    ! time slice time in run
      real*8, intent(in) :: deltat_r8  ! +/- averaging time

      integer, intent(out) :: ierr_open  ! file open status code, 0=OK

c     
c-------------------------------
c
c  convert to real
c

      real :: time,deltat

c-------------------------------

      time = time_r8
      deltat = deltat_r8

      call ts_write_r4(out_file,cdf_file,rlabel,trpath, 
     >     time,deltat,ierr_open)

      return
      end

C---------------------------------------------------------------------------
      subroutine ts_write_r4(out_file,cdf_file,rlabel,trpath, 
     >     time,deltat,ierr_open)

C! write TIME_SLICES file of TRANSP data, ascii file, on unit (iu).
C! close the file when done.

C! file OPEN in calling program...
C!  this code was original in the codesys/source/time_slices/time_slices.for
C!  driver code; converted to subroutine DMC 7 Jan 2009

      implicit NONE

      character*(*), intent(in) :: out_file  ! ASCII output file
      character*(*), intent(in) :: cdf_file  ! NetCDF output file

      ! if both the above are blank this routine returns without writing
      ! any file, issuing a warning.

      ! if out_file is non-blank the named ascii file is written and saved.
      ! if cdf_file is non-blank the named NetCDF file is written and saved.
      ! if cdf_file is non-blank but out_file is blank, a temporary ascii
      ! file is used, but not saved.

      character*(*), intent(in) :: rlabel   ! run label
      character*(*), intent(in) :: trpath   ! file or MDS+ path to run

      real, intent(in) :: time    ! time slice time in run
      real, intent(in) :: deltat  ! +/- averaging time

      integer, intent(out) :: ierr_open  ! file open status code, 0=OK
C
C information messages written on stdout via fortran unit 6
C
      !-----------------------------------------
      ! local variables

      character*10 abrev,abrev2         ! symbol abbreviation
 
      real sdata                        ! for scalar data...

      integer :: ier                    ! status code

      integer nzones                    ! no. radial zones
 
      ! no. scalar time pts, no. profile time pts, size of largest
      ! non-temporal coordinate, size of largest f(x,t) object:
 
      integer nsctime,nprtime,nxmax,nmax

      real, dimension(:), allocatable :: pbuf  ! profile buffer
      integer :: igot                   ! return size
c
      real :: tsl_min,tsl_max  ! fast ion slowing down time min & max
c
      character*24 realtime
      character*60 hostname,username,zlabel,zunits
      integer ilhost,iluser
      integer itypex,itypexb
      integer :: ic,ii,iu,icdf,itmp,istat
c
      integer :: inumsc,inumpro
c
      integer, parameter :: imom_max = 64
      integer, parameter :: imom_min = 1
      integer :: imom,imom_save,imom_start
      character*53 :: mlabel

      character*120 :: zfile,zfile_nbstep

      character*20 :: nubeam_repeat
      integer :: idtms,idts,idt1,idt2,idt3,idtct

      !-----------------------------------------
      ! multi impurity upgrade DMC Jan 2009

      integer :: n_species,n_thi,n_thx,n_bi,n_rfi,n_fusi,idum

      character*10, dimension(:,:), allocatable :: abrev_imp
      real, dimension(:), allocatable :: zz_imp,aa_imp
      integer, dimension(:), allocatable :: izc_imp

      ! check for multiple RF minority also-- warn if more than 1

      character*10, dimension(:,:), allocatable :: abrev_rf
      real, dimension(:), allocatable :: zz_rf,aa_rf
      integer, dimension(:), allocatable :: izc_rf
      real :: xzmini,amini

      !-----------------------------------------
      ! up-down symmetry flag
      logical :: nlsym
      real :: plhgt

      !-----------------------------------------
      ! misc

      logical :: i_dravfac

      !-----------------------------------------
      ! function declaration


      !-----------------------------------------
      ! executable code

      ierr_open = 0
      if((out_file.eq.' ').and.(cdf_file.eq.' ')) then
         write(6,*) ' %ts_write_r4: no output file specified.'
         return
      endif

      if(out_file.ne.' ') then
         itmp=0
         zfile = out_file
         call nbstep_filename(zfile)
      else
         call tmpfile_d('ts_write_r4',zfile,itmp)
         if(itmp.eq.0) then
            write(6,*) ' %ts_write_r4: temporary file naming error.'
            ierr_open=1
            return
         endif
         call nbstep_filename(cdf_file)
      endif

      call find_io_unit(iu)
      open(unit=iu,file=trim(zfile),status='unknown',iostat=istat)

      if(istat.ne.0) then
         ierr_open = 2
         write(6,*) ' ?ts_write_r4: open failure: '//trim(zfile)
         return
      endif

      write(6,*) ' '
      write(6,*) ' TIME_SLICES I/O modified DMC Jan 2009: quieter...'
      write(6,*) ' since run contents vary, '//
     >     '"not found" warnings are expected.'
      write(6,*) ' '
c
c  species info -- only used for impurities at present
c
      call rd_nspecies(n_species,n_thi,n_thx,n_bi,n_rfi,n_fusi)
C
      if(n_thx.gt.1) then
         write(6,*) ' %note: multiple impurities detected.'
         write(6,*) ' '
         allocate(izc_imp(n_thx),aa_imp(n_thx),zz_imp(n_thx),
     >        abrev_imp(4,n_thx))
         call rd_thxspec(n_thx,abrev_imp,zz_imp,aa_imp,izc_imp,idum)
      else
         write(6,*) ' %note: single impurity: XZIMP, AIMP, NIMP used.'
         write(6,*) ' '
      endif
C
      if(n_rfi.gt.0) then
         write(6,*) ' %note: RF minority detected.'
         write(6,*) ' '
         if(n_rfi.gt.1) then
            write(6,*) 
     >         ' ?ts_write: of multiple RF species only one is written.'
            write(6,*) ' '
         endif
         allocate(izc_rf(n_rfi),aa_rf(n_rfi),zz_rf(n_rfi),
     >        abrev_rf(4,n_rfi))
         call rd_rfspec(n_rfi,abrev_rf,zz_rf,aa_rf,izc_rf,idum)
         xzmini = zz_rf(1)
         amini = aa_rf(1)
      else
         xzmini = 0.0
         amini = 0.0
      endif
C
C  run size stats
C
      call rpstats(nsctime,nprtime,nxmax,nmax)
c
c  get buffer for profile function data
c
      allocate(pbuf(nxmax))             ! profile buffers
      pbuf=0

C  read/write scalars
 
      inumsc = 0

      write(iu,10) trim(rlabel),trim(trpath),time,deltat,max(1,n_thx)
  10  format(' Run "',a,'" TRREAD path "',a,'"'/
     &  ' Scalars:  time = ',f10.4,' averaged +/- ',f10.4,' seconds.',
     &  '  #imp = ',i3)
 
      abrev='BZXR'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,40) sdata,abrev
  40  format('   vacuum BZ * major_radius =',f10.4,'    [Tesla*cm] ',
     &  'RPLOT abrev = ',a10)
 
      if(n_thx.le.1) then
         abrev='XZIMP'
         call get_scalar(abrev,time,deltat,sdata)
         write(iu,45) sdata,abrev
 45      format('   atomic charge of impurity=',f10.4,'    [no units] ',
     &        'RPLOT abrev = ',a10)
 
         abrev='AIMP'
         call get_scalar(abrev,time,deltat,sdata)
         write(iu,46) sdata,abrev
 46      format('   atomic mass of impurity  =',f10.4,'    [no units] ',
     &        'RPLOT abrev = ',a10)
      else
         do ii=1,n_thx
            inumsc=inumsc+1
            abrev=' '
            if(ii.lt.10) then
               write(abrev,'("ZIMP_",i1)') ii
            else
               write(abrev,'("ZIMP_",i2)') ii
            endif

            write(iu,1047) 
     >           '   atomic charge imp: '//abrev_imp(1,ii)(6:10)//' ',
     >           zz_imp(ii),abrev

            inumsc=inumsc+1
            abrev=' '
            if(ii.lt.10) then
               write(abrev,'("AIMP_",i1)') ii
            else
               write(abrev,'("AIMP_",i2)') ii
            endif

            write(iu,1047) 
     >           '   atomic mass   imp: '//abrev_imp(1,ii)(6:10)//' ',
     >           aa_imp(ii),abrev
         enddo
      endif

      inumsc = inumsc + 1
      abrev='XZMINI'
      write(iu,1046) '   atomic charge RF minority=',xzmini,abrev

      inumsc = inumsc + 1
      abrev='AMINI'
      write(iu,1046) '   atomic mass RF minority  =',amini,abrev

 1046 format(a,f10.4,'    [no units] ','RPLOT abrev = ',a10)
 1047 format(a,'=',f10.4,'    [no units] ','RPLOT abrev = ',a10)

      abrev='PCUR'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,797) sdata,abrev
 797  format('   plasma current           =',1pe11.4,'   [Amps]     ',
     &  'RPLOT abrev = ',a10)
 
      abrev='RAXIS'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,798) sdata,abrev
 798  format('   R of magnetic axis       =',f10.4,'    [cm]       ',
     &  'RPLOT abrev = ',a10)
 
      abrev='YAXIS'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,799) sdata,abrev
 799  format('   Z of magnetic axis       =',f10.4,'    [cm]       ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ_H'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,47) sdata,abrev
  47  format('   H-NBI power              =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ_D'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,49) sdata,abrev
  49  format('   D-NBI power              =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ_T'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,50) sdata,abrev
  50  format('   T-NBI power              =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ_3'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,800) sdata,abrev
 800  format('   He3-NBI power            =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ_4'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,801) sdata,abrev
 801  format('   He4-NBI power            =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PINJ'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,51) sdata,abrev
  51  format('   total-NBI power          =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC_H'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,52) sdata,abrev
  52  format('   co-H-NBI frac            =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC_D'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,53) sdata,abrev
  53  format('   co-D-NBI frac            =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC_T'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,54) sdata,abrev
  54  format('   co-T-NBI frac            =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC_3'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,802) sdata,abrev
 802  format('   co-He3-NBI frac          =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC_4'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,803) sdata,abrev
 803  format('   co-He4-NBI frac          =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='COFRC'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,56) sdata,abrev
  56  format('   co-NBI frac (all beams)  =',1pe11.4,'   [no units] ',
     &  'RPLOT abrev = ',a10)
 
      abrev='POHT'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,60) sdata,abrev
  60  format('   Ohmic power              =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PICHTOT'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,61) sdata,abrev
  61  format('   ICRF antenna power       =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PLH'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,62) sdata,abrev
  62  format('   LHCD power               =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
 
      abrev='PECIN'
      call get_scalar(abrev,time,deltat,sdata)
      write(iu,63) sdata,abrev
  63  format('   ECRF input power         =',1pe11.4,'   [Watts]    ',
     &  'RPLOT abrev = ',a10)
  
c
c  read/write profiles
c
      inumpro = 0

      write(iu,11) trim(rlabel),trim(trpath),time,deltat
 11   format(' Run "',a,'" TRREAD path "',a,'"'/
     &  ' Profiles:  time = ',f10.4,' averaged +/- ',f10.4,' seconds.') 
c
c  first get no. of zones (not always 20 anymore)
c
      call t1profil('X',zlabel,zunits,time,deltat,itypex,
     >   pbuf,nxmax,igot,ier)
      nzones=igot
      write(6,12) nzones
      write(iu,12) nzones
 12   format(' Nzones = ',i4)
 
      call t1profil('XB',zlabel,zunits,time,deltat,itypexb,
     >   pbuf,nxmax,igot,ier)
c
c  now get profile values
c
      abrev='X'
      write(iu,70) abrev
  70  format(' Zone centrs = sq_rt(norm toroidal flux) (~r/a)       ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='XB'
      write(iu,71) abrev
  71  format(' XB = zone bdry sq_root(normlz toroidal flux)         ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DAREA'
      write(iu,72) abrev
  72  format(' Zone cross section area             [cm**2]       @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DVOL'
      write(iu,73) abrev
  73  format(' Zone volume                         [cm**3]       @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DRAV'
      write(iu,10073) abrev
10073 format(' Zone spacing <dr>                   [cm]          @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DRAVFAC'
      call rpexist_profile(abrev,i_dravfac)
      write(iu,10173) abrev
10173 format('<1/dr><dr> (DRAVFAC/DRAV -> <grad>)  [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      if(i_dravfac) then
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
      else
         pbuf = 1.0
         call get_profil(' ',time,deltat,nxmax,pbuf,igot)
      endif

      abrev='SURF'
      write(iu,74) abrev
  74  format(' Flux surface area                   [cm**2]      @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='RMJMP'
      write(iu,80) abrev
  80  format(' Midplane major radius               [cm]         @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='RMNMP'
      write(iu,81) abrev
  81  format(' Midplane minor radius               [cm]         @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='SSHAF'
      write(iu,82) abrev
  82  format(' Shafranov shift                     [cm]         @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='GR2I'
      write(iu,83) abrev
  83  format(' surf-vol-avg <1/R**2>               [/cm2]       @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='ELONG'
      write(iu,75) abrev
 75   format(' Flux surface elongation             [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TRIANG'
      write(iu,76) abrev
 76   format(' Flux surface triangularity          [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TRIANGU'
      write(iu,77) abrev
 77   format(' Flux surf. upper triangularity      [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TRIANGL'
      write(iu,78) abrev
 78   format(' Flux surf. lower triangularity      [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='SQUARE_UO'
      write(iu,79) abrev
 79   format(' Flux surf upper outer squareness    [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='SQUARE_LO'
      write(iu,84) abrev
 84   format(' Flux surf lower outer squareness    [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TRFLX'
      write(iu,95) abrev
  95  format(' Toroidal flux                       [Webers]     @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PLFLX'
      write(iu,96) abrev
  96  format(' Poloidal Flux                       [Webers]     @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BPOL'
      write(iu,97) abrev
  97  format(' Poloidal field                      [Tesla]      @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NE'
      write(iu,100) abrev
  100 format(' Electron dens                       [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NH'
      write(iu,101) abrev
  101 format(' Thermal hydrogen density            [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='ND'
      write(iu,102) abrev
  102 format(' Thermal deut dens                   [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NT'
      write(iu,103) abrev
  103 format(' Thermal tritium dens                [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(n_thx.le.1) then
         abrev='NIMP'
         write(iu,104) abrev
 104     format(
     &        ' Impurity density                    [/cm**3]      @X ',
     &        'RPLOT abrev = ',a10)
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
      else
         do ii=1,n_thx
            abrev=abrev_imp(1,ii)
            abrev2=' '
            if(ii.lt.10) then
               write(abrev2,'("NIMP_",i1)') ii
            else
               write(abrev2,'("NIMP_",i2)') ii
            endif
            write(iu,1044) ' Impurity density:  '//abrev,abrev2
            call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
         enddo
      endif
 1044 format(a,'       [/cm**3]      @X ',
     &     'RPLOT abrev = ',a10)
 
      abrev='NI'
      write(iu,105) abrev
  105 format(' Thermal ion dens NH+ND+NT+NIMP+NHE3+...  [/cm3]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NFI'  ! **NOTE** use FDENS_4 in get_profil!
      write(iu,106) abrev
  106 format(' Fusion ion dens                     [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NHE3'
      write(iu,107) abrev
  107 format(' Thermal He3 dens                    [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NHE4'
      write(iu,108) abrev
  108 format(' Thermal He4 dens                    [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='NMINI'
      write(iu,109) abrev
  109 format(' ICRH minority dens                  [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS'
      write(iu,119) abrev
  119 format(' Total beam ion dens                 [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS_H'
      write(iu,120) abrev
  120 format(' Hydrogen beam ion density           [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS_D'
      write(iu,121) abrev
  121 format(' Deuterium beam ion density          [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS_T'
      write(iu,122) abrev
  122 format(' Tritium beam ion density            [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS_3'
      write(iu,810) abrev
 810  format(' Helium-3 beam ion density           [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BDENS_4'
      write(iu,811) abrev
 811  format(' Helium-4 beam ion density           [/cm**3]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DIVFE'
      write(iu,123) abrev
  123 format(' Divergence(el flux)                 [n/cm3/sec]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DIVFI'
      write(iu,124) abrev
  124 format(' Divergence(ion flux)                [n/cm3/sec]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='DFINT'
      write(iu,125) abrev
  125 format(' Divergence(impurity flux)           [n/cm3/sec]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TX'
      write(iu,130) abrev
  130 format(' Impurity Temperature                [eV]          @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TI'
      write(iu,131) abrev
  131 format(' Hydrogenic Temperature              [eV]          @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TE'
      write(iu,132) abrev
  132 format(' Electron Temperature                [eV]          @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='CUR'
      write(iu,135) abrev
  135 format(' Total current                       [Amps/cm**2]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='CURBS'
      write(iu,136) abrev
  136 format(' Bootstrap current                   [Amps/cm**2]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='CURB'
      write(iu,137) abrev
  137 format(' Beam driven current                 [Amps/cm**2]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='LHCUR'
      write(iu,138) abrev
  138 format(' Lower Hybrid driven current         [Amps/cm**2]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='ECCUR'
      write(iu,139) abrev
  139 format(' ECRH current                        [Amps/cm**2]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PLJB'
      write(iu,140) abrev
  140 format(' surf-vol-avg <J*B>                  [Amp*T/cm**2] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='GFUN'
      write(iu,141) abrev
  141 format(' para/diamagnetism correction        [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='Q'
      write(iu,145) abrev
  145 format(' q_psi                               [no units]   @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UE'
      write(iu,146) abrev
  146 format(' Ele energy dens 3*NE*TE/2           [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UI'
      write(iu,147) abrev
  147 format(' Ion energy dens 3*NI*TI/2           [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPAR_H'
      write(iu,150) abrev
  150 format(' H-beam parall energy dens           [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPRP_H'
      write(iu,151) abrev
  151 format(' H-beam perpend energy dens          [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPAR_D'
      write(iu,153) abrev
  153 format(' D-beam parall energy dens           [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPRP_D'
      write(iu,154) abrev
  154 format(' D-beam perpend energy dens          [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPAR_T'
      write(iu,155) abrev
  155 format(' T-beam parall energy dens           [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPRP_T'
      write(iu,196) abrev
  196 format(' T-beam perpend energy dens          [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPAR_3'
      write(iu,156) abrev
 156  format(' He3-beam parall energy dens         [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPRP_3'
      write(iu,157) abrev
 157  format(' He3-beam perpend energy dens        [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPAR_4'
      write(iu,158) abrev
 158  format(' He4-beam parall energy dens         [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UBPRP_4'
      write(iu,159) abrev
 159  format(' He4-beam perpend energy dens        [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UMINPA'
      write(iu,160) abrev
 160  format(' RF minority parall energy dens      [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UMINPP'
      write(iu,161) abrev
 161  format(' RF minority perpend energy dens     [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UFIPA'
      write(iu,197) abrev
  197 format(' Fusion ion paral energy dens        [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UFIPP'
      write(iu,198) abrev
  198 format(' Fusion ion perpend energy dens      [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UPHI'
      write(iu,199) abrev
  199 format(' Rotation energy dens                [Joules/cm3]  @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UFASTPA'
      write(iu,200) abrev
  200 format(' Fast ion par energ dens (UBPAR_D+UBPAR_T+UFIPA)   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UFASTPP'
      write(iu,201) abrev
  201 format(' Fast ion prp energ dens (UBPRP_D+UBPRP_T+UFIPP)   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='UTOTL'
      write(iu,202) abrev
  202 format(' Tot energy den (UE+UI+UPHI+UFASTPA+UFASTPP)       @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='FTOTDT'
      write(iu,211) abrev
  211 format(' DT neut emission rate               [n/cm3/sec]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TTNTX'
      write(iu,212) abrev
  212 format(' Total neutron emission rate         [n/cm3/sec]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTE'
      write(iu,213) abrev
  213 format(' Electron Toroidal beta              [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTI'
      write(iu,214) abrev
  214 format(' Thermal Ion Toroidal beta           [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTPL'
      write(iu,215) abrev
  215 format(' Thermal Toroidal beta (=BTE+BTI)    [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTBE'
      write(iu,216) abrev
  216 format(' Beam Toroidal beta                  [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTMIN'
      write(iu,217) abrev
  217 format(' ICRF Minority Toroidal beta         [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTFI'
      write(iu,218) abrev
  218 format(' Fusion ion Toroidal beta            [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='BTTOT'
      write(iu,219) abrev
  219 format(' Total Toroidal beta (=BTPL+BTBM+BTMIN+BTFI)       @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PPLAS'
      write(iu,220) abrev
  220 format(' Thermal Pressure 2(UI+UE)/3         [Pascals]     @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PTOWB'
      write(iu,221) abrev
  221 format(' Total Press (Therm+3*UPHI/2+UFASTPA+UFASTPP/2)    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PMHD_IN'
      write(iu,251) abrev
  251 format(' Total Pressure (as input to MHD EQ solver)        @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='ZEFFP'
      write(iu,222) abrev
  222 format(' Plasma composition Z_eff            [no units]    @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='ETA_USE'
      write(iu,223) abrev
  223 format(' Resistivity used or inferred        [OHM*CM]      @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PBE'
      write(iu,226) abrev
  226 format(' beam-ele heating power              [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PBI'
      write(iu,227) abrev
  227 format(' beam-ion heating power              [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PBTH'
      write(iu,228) abrev
  228 format(' beam-thermalization heating power   [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PFE'
      write(iu,233) abrev
  233 format(' alpha-ele heating power             [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PFI'
      write(iu,234) abrev
  234 format(' alpha-ion heating power             [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='QICHE'
      write(iu,235) abrev
  235 format(' ICRH direct el heating power        [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='QICHI'
      write(iu,236) abrev
  236 format(' ICRH direct ion heating power       [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='QICHMIN'
      write(iu,237) abrev
  237 format(' ICRH minority ion heating power     [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='QICHA'
      write(iu,238) abrev
  238 format(' ICRH total heating power            [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PELH'
      write(iu,239) abrev
  239 format(' LowerHybrid-ele heating power       [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='PEECH'
      write(iu,240) abrev
  240 format(' ECRH-ele heating power              [Watts/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='TQIN'
      write(iu,730) abrev
  730 format(' Total Input Torque                   [Nt-m/cm**3] @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='OMEGA'
      write(iu,250) abrev
  250 format(' thermal plasma toroidal rotation    [radians/s]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='OMEGB'
      write(iu,241) abrev
  241 format(' beam toroidal rotation              [radians/s]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='OMEGF_4'
      write(iu,242) abrev
  242 format(' fusion alpha toroidal rotation      [radians/s]   @X ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='EPOTRO'
      write(iu,243) abrev
  243 format(' Radial Potential due to rotaion     [Volts]      @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='EPOTNC'
      write(iu,244) abrev
  244 format(' Radial Potential due to rotation NCLASS [Volts]  @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      abrev='VRPOT'
      write(iu,245) abrev
  245 format(' Radial Electrical Potential         [Volts]      @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      tsl_min = 1.0e20
      tsl_max = 0.0

      abrev='TSL1A_H'
      write(iu,246) abrev
 246  format(' H (co) beam slowing down time       [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update

      abrev='TSL1B_H'
      write(iu,247) abrev
 247  format(' H (ctr) beam slowing down time      [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1A_D'
      write(iu,248) abrev
 248  format(' D (co) beam slowing down time       [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1B_D'
      write(iu,249) abrev
 249  format(' D (ctr) beam slowing down time      [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1A_T'
      write(iu,260) abrev
 260  format(' T (co) beam slowing down time       [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1B_T'
      write(iu,261) abrev
 261  format(' T (ctr) beam slowing down time      [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1A_3'
      write(iu,262) abrev
 262  format(' He3 (co) beam slowing down time     [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1B_3'
      write(iu,263) abrev
 263  format(' He3 (ctr) beam slowing down time    [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1A_4'
      write(iu,252) abrev
 252  format(' He4 (co) beam slowing down time     [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TSL1B_4'
      write(iu,253) abrev
 253  format(' He4 (ctr) beam slowing down time    [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TFSL_4'
      write(iu,254) abrev
 254  format(' He4 fusion alpha slowing down time  [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TFSL_3'
      write(iu,255) abrev
 255  format(' He3 fusion ion slowing down time    [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update
 
      abrev='TFSL_T'
      write(iu,256) abrev
 256  format(' T fusion ion slowing down time      [s]          @XB ',
     &  'RPLOT abrev = ',a10)
      call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      if(igot.gt.0) call tsl_update

      write(6,*) ' ...minimum fast ion slowing down time: ',tsl_min
      write(6,*) ' ...maximum fast ion slowing down time: ',tsl_max

      ! next format stmt #: 265 recommended
      !-----------------------

      write(iu,400)
  400 format(' Fourier moments of flux surfaces')

      ! modified DMC Jan 2009 -- at physicist request, write all files
      ! as if equilibrium is up-down ASYMMETRIC.  So, for up-down symmetric
      ! data, map RMMnn -> RMCnn w/RMSnn zero; map YMMnn -> YMSnn w/YMCnn zero.
      ! EXCEPTION:  scalar PLHGT -> YMC00 in case of updown symmetry.

      abrev='RMM01'
      call rpexist_profile(abrev,nlsym)
      if(nlsym) then
         ! get plasma vertical offset (allowed in up-down symmetric equilibria)
         abrev='ZPLAS'
         call t1scalar(abrev,zlabel,zunits,time,deltat,plhgt,idum)
      endif

  500 format(1x,a,'RPLOT abrev = ',a10)

      ! try updown symmetric moments
      do imom=0,imom_max
         abrev=' '
         write(abrev,'("RMM",i2.2)') imom
         call gen_mlabel(imom,'symm R cos(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         if(nlsym) then
            abrev='RMC01'  ! this will force zeroes in nlsym=T case...
         endif
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
         if((igot.eq.0).and.(imom.ge.imom_min)) exit
      enddo

      do imom=0,imom_max
         abrev=' '
         write(abrev,'("YMM",i2.2)') imom
         call gen_mlabel(imom,'symm Y sin(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         if(nlsym) then
            abrev='RMC01'  ! this will force zeroes in nlsym=T case...
         endif
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
         if((igot.eq.0).and.(imom.ge.imom_min)) exit
      enddo

      ! try R & Y asym cos moments (start at 0)
      ! the number of non-zero R cos moments sets the number for the rest

      do imom=0,imom_max
         abrev=' '
         write(abrev,'("RMC",i2.2)') imom
         call gen_mlabel(imom,'asym R cos(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         if(nlsym) then
            abrev(1:3)='RMM'
         endif
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
         if((igot.eq.0).and.(imom.ge.imom_min)) exit
         imom_save=imom + 1
      enddo

      if(nlsym) then
         abrev='YMC00'
         imom=0
         call gen_mlabel(imom,'asym Y cos(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         pbuf(1:nzones)=plhgt
         ! call with ' ' to use pbuf provided
         call get_profil(' ',time,deltat,nxmax,pbuf,igot)
         imom_start=1
      else
         imom_start=0
      endif

      do imom=imom_start,imom_save
         abrev=' '
         write(abrev,'("YMC",i2.2)') imom
         call gen_mlabel(imom,'asym Y cos(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
      enddo

      ! try R & Y asym sin moments (start at 1)

      do imom=1,imom_save
         abrev=' '
         write(abrev,'("RMS",i2.2)') imom
         call gen_mlabel(imom,'asym R sin(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
      enddo

      do imom=1,imom_save
         abrev=' '
         write(abrev,'("YMS",i2.2)') imom
         call gen_mlabel(imom,'asym Y sin(k*theta) moment  [cm]')
         write(iu,500) mlabel,abrev
         if(nlsym) then
            abrev(1:3)='YMM'
         endif
         call get_profil(abrev,time,deltat,nxmax,pbuf,igot)
      enddo
 
      !----------------------------
      ! trailing labels...
 
      call fdate(realtime)
 
      call sget_host(hostname)
      ilhost=len_trim(hostname)
 
      call sget_user(username)
      iluser=len_trim(username)
 
      write(iu,997) realtime,hostname(1:ilhost),username(1:iluser)
      write(iu,998)
      write(iu,999)
  997 format(' file writen on ',a24/
     >   ' on node ',a,' by physicist: ',a)
  998 format(' Warning: Preliminary results.')
  999 format(' Check with physicist before using in publications.')
 
      ! ascii file write completed.

      !----------------------------
      !  NetCDF file

      if(cdf_file.ne.' ') then

         call ts_cdf_write(cdf_file,iu,inumsc,inumpro,nzones,ierr_open)

      endif

      !----------------------------
      if(itmp.gt.0) then
         close (unit=iu, status='delete')
      else
         close (unit=iu)  ! keep ASCII file
      endif

      !----------------------------
      if(tsl_max.gt.0.0) then
         idtms = 1000.0*(tsl_min/5)  ! integer timestep in milliseconds
         idtms = min(9999,max(5,idtms))  ! 5ms minimum
         idtct = 1.3333e3*tsl_max/idtms  ! number of timesteps to cover
                                ! (4/3) maximum slowing down time

         idts = idtms/1000
         idtms = idtms - 1000*idts
         idt1 = idtms/100
         idtms = idtms - 100*idt1
         idt2 = idtms/10
         idtms = idtms - 10*idt2
         idt3 = idtms

         nubeam_repeat=' '
         write(nubeam_repeat,'(i5,"x",i1,".",3(i1))') idtct,
     >        idts,idt1,idt2,idt3
         !  compress
         ii=0
         do ic=1,len(nubeam_repeat)
            if(nubeam_repeat(ic:ic).ne.' ') then
               ii=ii+1
               if(ii.lt.ic) nubeam_repeat(ii:ii)=nubeam_repeat(ic:ic)
            endif
         enddo
         nubeam_repeat(ii+1:)=' '

         write(6,*) ' NUBEAM_REPEAT_COUNT advice based on '//
     >        'slowing down times: '//trim(nubeam_repeat)

         open(unit=iu,file=trim(zfile_nbstep),status='unknown',
     >        iostat=istat)
         if(istat.eq.0) then
            write(iu,7701) trim(nubeam_repeat)
            close(unit=iu)
            write(6,*) ' %wrote: '//trim(zfile_nbstep)
         else
            write(6,*) ' ?open failure: '//trim(zfile_nbstep)
         endif

 7701    format(' suggested NUBEAM_REPEAT_COUNT time step setting:',
     >        1x,a)
      endif

      if(allocated(pbuf)) deallocate(pbuf)
      if(allocated(izc_imp)) deallocate(izc_imp,zz_imp,aa_imp,abrev_imp)
      if(allocated(izc_rf)) deallocate(izc_rf,zz_rf,aa_rf,abrev_rf)

      return

      !---------------------------
      CONTAINS
      !---------------------------

      subroutine get_scalar(abrev,time,deltat,sdata)
 
      implicit NONE
 
c  get one scalar -- CONTAINed subroutine
 
      character*(*), intent(in) :: abrev ! scalar item name
      real,intent(in) :: time,deltat    ! time +/- averaging delta(t)
      real,intent(out) :: sdata         ! data read (or ZERO if not found)
 
      character*50 zlabel,zunits
      integer ierr
      logical :: iexist

      inumsc = inumsc + 1

      call rpexist_scalar(abrev,iexist)

      sdata=0.0
      if(.not.iexist) then
         write(6,*) ' %scalar not found: ',trim(abrev)

      else
         call t1scalar(abrev,zlabel,zunits,time,deltat,sdata,ierr)
         if(ierr.ne.0) then
            write(6,*) ' ?? unexpected t1scalar error on: ',trim(abrev)
            sdata=0.0
         endif
      endif
 
      return
      end subroutine get_scalar
 
c-----------------------------------------------------------------------
      subroutine get_profil(abrev,time,deltat,nxmax,pbuf,igot)
 
      implicit NONE
 
c  get one profile -- CONTAINed subroutine
 
      character*(*), intent(in) :: abrev ! profile name
      real, intent(in) :: time,deltat   ! time +/- averaging delta(t)
      integer, intent(in) :: nxmax      ! buffer size
      real, intent(out) :: pbuf(nxmax)  ! buffer
      integer, intent(out) :: igot      ! no. of values retrieved.
 
      character zlabel*32,zunits*16
      integer itype,ierr,j1,j2,k,iuse
      logical :: iexist

      ! mod: if abrev is blank, assume caller has filled pbuf

      inumpro = inumpro + 1

      if(abrev.eq.' ') then
         iuse=nzones
         igot=nzones

      else
         call rpexist_profile(abrev,iexist)
 
         if(.not.iexist) then
            write(6,*) ' %profile not found: ',trim(abrev)
            pbuf = 0.0
            igot = 0
            iuse = nzones

         else
            call t1profil(abrev,zlabel,zunits,time,deltat,itype,
     >           pbuf,nxmax,igot,ierr)
 
            if(ierr.ne.0) then
               pbuf=0.0
               igot = 0
               iuse = nzones
               write(6,*) ' ?? unexpected t1profil error on: ',
     >              trim(abrev)
            else
               iuse = igot      ! the usual case...
            endif
         endif
      endif
 
      do j1=1,iuse,5
         j2=min(iuse,j1+4)
         write(iu,801) (pbuf(k),k=j1,j2)
      enddo
  801 format(5(2x,1pe11.4))
 
      return
      end subroutine get_profil

c-----------------------------------------------------------------------
      subroutine gen_mlabel(k,tag)
      
      ! generate label for moments profile

      integer, intent(in) :: k
      character*(*) :: tag

      integer :: kmod,ktens

      mlabel=' '

      if(k.lt.10) then
         if(k.eq.1) then
            write(mlabel,'("k=",i1,"st ",a)') k,tag
         else if(k.eq.2) then
            write(mlabel,'("k=",i1,"nd ",a)') k,tag
         else if(k.eq.3) then
            write(mlabel,'("k=",i1,"rd ",a)') k,tag
         else
            write(mlabel,'("k=",i1,"th ",a)') k,tag
         endif
      else if(k.lt.20) then
         write(mlabel,'("k=",i2,"th ",a)') k,tag
      else
         ktens=k/10
         kmod = k - 10*ktens
         if(kmod.eq.1) then
            write(mlabel,'("k=",i2,"st ",a)') k,tag
         else if(kmod.eq.2) then
            write(mlabel,'("k=",i2,"nd ",a)') k,tag
         else if(kmod.eq.3) then
            write(mlabel,'("k=",i2,"rd ",a)') k,tag
         else
            write(mlabel,'("k=",i2,"th ",a)') k,tag
         endif
      endif

      mlabel(50:52)='@XB'

      end subroutine gen_mlabel

      subroutine tsl_update

        ! find min & max of non-zero slowing down times...
        do ii=1,igot
           if(pbuf(ii).gt.0.0) then
              tsl_min=min(tsl_min,pbuf(ii))
              tsl_max=max(tsl_max,pbuf(ii))
           endif
        enddo

      end subroutine tsl_update
      
      subroutine nbstep_filename(zname)
      
        ! form filename "<root>.nbstep" to contain NUBEAM time step
        ! recommendation in form <repeat_count>x<time_step>...

        character*(*), intent(in) :: zname

        integer :: ic,idot,ibrk,ilen

        ilen = len(trim(zname))
        idot = 0
        do ic = ilen,1,-1
           if(zname(ic:ic).eq.'/') exit
           if(zname(ic:ic).eq.'.') then
              idot=ic
              exit
           endif
        enddo

        if(idot.eq.0) then
           ibrk=ilen
        else
           ibrk=idot-1
        endif

        zfile_nbstep = zname(1:ibrk)//'.nbstep'

      end subroutine nbstep_filename

      !-----------------------------
      END  ! subroutine ts_write_r4
      !-----------------------------
