      subroutine trxpl_master
c
c  (used to be the trxpl main program...)
c  (this routine is called directly from the driver, trxpl/trxpl.for,
c   and that is all trxpl.for does).
c
c  trxpl main program source code
c  ------------------------------
c
c  `trxpl' allows detailed wide ranging access to time-slice data
c  extracted from completed TRANSP runs.
c
c  The data is read into "xplasma" via the "trxplib" subroutine library,
c  using "trread" and the legacy rplot-related libraries it calls to read
c  the actual TRANSP data.
c
c  By using trxplib/xplasma:
c
c    (a) all of the data has been converted to MKS physical units
c    (b) all of the data is presented as cubic-spline or cubic-Hermite
c        piecewise continuous & differentiable functions, allowing for
c        regridding according to user requirements.
c    (c) a complete MHD equilibrium description, with extrapolation to
c        cover a user-specified RxZ rectangle, is contained in the 
c        "xplasma" representation.
c    (d) any number of additional profiles and scalars may be accessed.
c    (e) additional profiles & scalars can be generated using the legacy
c        rplot calculator, but, MKS conversion becomes a user 
c        responsibility.
c
c  The user selects a "time of interest" t, and at averaging time delta_t,
c  so that the data presented is a time average over the range 
c      [t-delta_t, t+delta_t].
c
c  Once the desired data has been acquired, several outputs may be selected:
c
c    (a) equilibrium representation files in various formats:
c        G-eqdsk, Jon-Menard file, Alan-Glasser file, ...
c    (b) namelist data for GS2 may be generated
c    (c) NetCDF data for FWR2D may be generated
c        ...
c        ...
c
      implicit NONE
c
c---------------------------
c
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
c
c  misc.
      integer iwarn,ierr,ilt,ilz,irzflag,ieq,iws,ilun,jlun,ilenf
c
c  time of interest & averaging time
      real*8 ztime0,ztavg,zdelt_lead
      integer :: intime0  ! index in prof timebase to 1st time at/after ztime0
      integer :: intbegin ! index in prof timebase to begin state extraction...
      integer :: insc,inpr,idum,ichar1,iopen,ios
      integer :: istat
      character*12 zctime
      character*1 :: char1
      character*26 :: alphab = 'abcdefghijklmnopqrstuvwxyz'
c
c  user controlled grid sizes
      integer ntheta,nR,nZ,nR_orig,nZ_orig
c
c  direction of Btoroidal and Itoroidal
c
      integer ibccw,ipccw
c
c  non-blank length of character string
c
c  path to TRANSP run
      character*128 apath,tpath,fpath,gpath,hpath,spath,rpath,zpath
      integer ixtra,i,j,inr,inx,inx_state,ier,id_rho,inrho,ilenr,ilens
      integer :: ilenp
c
c  name and units of function
      character*10 zname,ztest
      character*16 zunits
c  calculator expression
      character*80 zexpr
c
c  Xplasma save filename
      character*80 zfile
c  Ufile labels
      character*4 tokdev
      character*12 runid
      character*10 zdate
c
      character*40 rlabel
c
c  (Ufile) scalars ... & profile list
c
      include 'trxpl.blk'
c
c  uread stuff
      integer lnout
      logical lxout,lchar,lyes
c
c  (R,Z) grid limits
      real*8 Rmin,Rmax,Zmin,Zmax
      real*8 Rmin_orig,Rmax_orig,Zmin_orig,Zmax_orig
c
c  (R,Z) limits of last flux surface
      real*8 Rmin1,Rmax1,Zmin1,Zmax1,zmid1,zhgt1
c
c  MHD Equilibrium ESI (L. Zakharov format)
c  related
c
      integer :: irho,ichi,inerr,id_ne=0
      real*8  ztflux
      character*50 :: zuns_mks
c
c  GEQDSK id label & other GEQDSK stuff
c
      character*48 geqdsk_lbl
      character*10 zttmp
      integer nh_geqdsk,nv_geqdsk,nb_geqdsk
 
      real*8 :: zcur
      integer :: id_psi=0,id_pmhd=0,id_q=0,id_g=0
c
c  CURRAY specific arrays and other infor
c
      integer :: nspec,n_species,iorder,lrho,ierror,ik,il,
     >           idcod,idvolt
      integer, dimension(:), allocatable :: id_ns,id_ts,itype,Izc
      character*20, dimension(:), allocatable :: slbl
      character*20 :: zunit_volt
      character*1 zans
      real*8 :: drho
      real*8, dimension(:), allocatable :: rho,zvalv,Zr8,Ar8
      real*8, dimension(:,:), allocatable :: zvaln,zvalt
      real*8, dimension(:), allocatable :: ztimes_p
c
      integer igs2,inaux,iaux,ierloc
c
      character*150 :: mdescr
c
c---------------------------------------
c  initializations
c
      ztime0=0.0
      ztavg=0.0
c
      fpath=' '
      gpath=' '
      hpath=' '
c
      call uinitg("TRXPL")
c
      write(6,*) ' '
      write(6,*) ' TRXPL version update: 4 Nov 2010'
      write(6,*) ' D. McCune, 2000--2010: TRANSP time slice extractor.'
      write(6,*) ' '
c
      call datmgr_no_delete   ! "datmgr" buffer can now be expanded 
c
c  have user specify runid, time, dt(avg), ntheta
c  trxpl - specific call
c
 10   continue
c
      call trxpl_mkgs2_reset
c
      call trxpl_path(tpath,ztime0,ztavg,ntheta,
     >   Rmin,Rmax,nR,Zmin,Zmax,nZ,ibccw,ipccw)
c
      if(tpath.eq.' ') then
         call uexita(0)
         stop  ! normal "trxpl" program exit
      endif
c
      nR_orig = nR
      nZ_orig = nZ
c
      Rmin_orig = Rmin
      Rmax_orig = Rmax
      Zmin_orig = Zmin
      Zmax_orig = Zmax
c
      ilt=len_trim(tpath)
c
c  connect to TRANSP run (file or MDS+)
c  get the radial coordinate "rho" = normalized sqrt(toroidal flux)
c
ccc      call trx_connect(tpath,ierr)
c
c  no, this now done in trxpl_path
c
c  get profile time vector

      call trx_ntimes(insc,inpr,idum)
      if(allocated(ztimes_p)) deallocate(ztimes_p)
      allocate(ztimes_p(inpr))
      call r8_rptime_p(ztimes_p,inpr,idum)
c
c  select the time of interest in the data
c  user selected the time either in "trxpl_path" (above) or in the "T"
c  menu option (below)
c
 15   continue
c
      intime0=inpr
c
      do i=1,inpr
         if(ztimes_p(i).ge.ztime0) then
            intime0=i
            exit
         endif
      enddo
c
c  call CONTAIN'd routine to establish xplasma @indicated time
c
      call loc_trx_get
      if(ierr.ne.0) go to 10
c
 20   continue
c
      if(lxout(0)) write(lnout(0),1000) Rmin1,Rmax1,numsc
 1000 format(/
     >' ...minimum R on boundary surface = ',1pd11.4/
     >' ...maximum R on boundary surface = ',1pd11.4//
     >' ...no. of scalars:  ',i3/
     >'  [caution: for GS2 choose "M" first;',
     >   ' for FWR2D choose "R" first.]'/
     >' C -- RPLOT calculator'/
     >' D -- display data'/
     >' P -- choose profiles'/
     >' S -- choose scalars'/
     >' E -- extract equilibrium Fourier moments'/
     >' I -- get all specie temperatures & densities (NOT for GS2)'//
     >' A -- write ascii file of scalars and profiles'/
     >' F -- write TRANSP equilibrium (Alan Glasser file)'/
     >' G -- write GEQDSK'/
     >' H -- write (Jon Menard style) psipqgRZ file'/
     >' J -- write species temperatures & densities (PPL TESTING only)'/
     >' L -- Write Equilibrium in ESI format (Leonid Zakharov style)'/
     >' N -- Write profiles for use by orbit'/
     >' U -- write Ufiles'/
     >' W -- write XPLASMA save NetCDF save file'//
     >' M -- read specie temperatures & densities; make GS2 namelists'/
     >' R -- read TE & NE; write NetCDF file for FWR2D ',
     >   '(reflectometry code)'//
     >' B -- write TRANSP equilibriumRZ NetCDF file for IMAS DataBase'//
     >' X -- extract data for PLASMA STATE file'/
     >'      (e.g. data for GENRAY/TORAY)'//
     >' T -- choose data from different time'/
     >' 1 -- for "time_slices" formatted output file'/
     >' Q -- quit (or get new run)')
      call uread('trxpl:  option select:$')
c
      if(lchar('Q')) then
         !  new RUN
         go to 10
 
      else if(lchar('1')) then
  
         call grunlb2(rlabel)

         if(lxout(0)) then
            write(lnout(0),*) 
     >           ' Note: data written in "TRANSP" units, not MKS.'
            write(lnout(0),*)
     >           ' Enter filename root, e.g "foo" => ASCII file is'
            write(lnout(0),*)
     >           ' written as "foo.dat"; NetCDF file as "foo.cdf".'
         endif

         spath=' '
         call unixfile('time_slices output <file_path>/<file_root>',
     >        spath)

         call ts_write_r8(trim(spath)//'.dat',trim(spath)//'.cdf',
     >        rlabel,tpath,ztime0,ztavg,ierr)
         if(ierr.ne.0) then
            call uermsi(' ?trxpl_master: time_slices write error.',
     >           ierr,0)
         endif

         go to 20

      else if(lchar('T')) then
         !  new TIME
         do
            call ureadr8('trxpl:  new time:$',ztime0)
            call trxpl_path_dtavg('trxpl: +/- delta(t) averaging time:',
     >           ztime0,ztavg,zans)
            if(zans.eq.'Q') then
               cycle
            else
               exit
            endif
         enddo
         go to 15
 
      else if(lchar('S')) then
         !  loop to get SCALAR data
         if(numsc.eq.maxsc) then
            call uermsi('?max no. of scalars reached: ',maxsc,0)
         else
            call trxpl_get_scalar(zname)
         endif
 
      else if(lchar('P')) then
         !  loop to get PROFILE data
         if(igs2.gt.0) then
            call uermsg(
     >         '%trxpl:  after "M" is used, "P" is not available.',
     >         ' ',0)
            go to 20
         endif
         if(numpro.eq.maxpro) then
            call uermsi('?max no. of profiles reached: ',maxpro,0)
         else
            call trxpl_get_profile(zname)
         endif
 
      else if(lchar('E')) then
         !  get equilibrium moments data
c
c  the moments scaling used in trxpl_eqmoms was found to be unsafe:
c  moments do not always scale as x**n -- it depends on the choice of
c  representation  --  dmc Nov 2006
c
         write(lnout(0),*) 
     >        ' Note: if you need "E" option contact dmccune@pppl.gov.'
         call uermsg(
     >        '?trxpl_master: option disabled for technical reasons',
     >        ' ',0)
ccc         do
ccc            if(lxout(0)) then
ccc               write(lnout(0),1088)
ccc 1088          format(/' Equilibrium moments options:'/
ccc     >            ' "S" -- scalar -- boundary moments only.'/
ccc     >            ' "P" -- profile -- moments profiles.'/
ccc     >            ' "A" -- both "S" and "P", redundancy accepted.'/
ccc     >            ' "Q" -- quit (do nothing)'/)
ccc            endif
ccc            call uread('TRXPL: Eq.moments sub-option:$')
ccc            if(lchar('Q')) then
ccc               ieq=0
ccc            else if(lchar('S')) then
ccc               ieq=1
ccc            else if(lchar('P')) then
ccc               ieq=2
ccc            else if(lchar('A')) then
ccc               ieq=3
ccc            else
ccc               call uermsg('?trxpl(eq.moments): invalid option.',' ',0)
ccc               cycle
ccc            endif
ccc            exit
ccc         enddo
ccc         if(ieq.gt.0) call trxpl_eqmoms(ieq)
 
      else if(lchar('A')) then
         !  write ASCII file of scalar & profile information gotten so far.
         call unixfile('Ascii output filename',apath)
         if((apath.ne.'Q ').and.(apath.ne.'q ')) then
            if(lxout(0)) then
               write(lnout(0),1099)
 1099          format(/
     >            ' enter grid option k:'/
     >            '   k=+1 for TRANSP grid'/
     >            '   k=+2 for TRANSP grid double density'/
     >            '    ...'/
     >            '   k=+5 for TRANSP grid quintuple density'/
     >            '   k=-N for N evenly spaced points; 20 <= N <= 1000'/
     >            '   ...radial flux coordinate "x" is the usual'/
     >            '   sqrt(normalized-toroidal-flux)'/
     >            )
            endif
 
            inr=1
            inx=1
 
            do
               call ureadi(
     >            'enter grid option "k" for radial flux coordinate:',
     >            inx)
               if((inx.eq.0).or.(inx.gt.5).or.(inx.lt.-1000).or.
     >            ((inx.gt.-20).and.(inx.le.0)) ) then
                  call uermsi(
     >               ' require k=1,2,3,4,5 or in range [-1000,-20].',
     >               inx,0)
               else
                  exit
               endif
            enddo
 
            do
               call ureadi('enter grid option "k" for Major Radius:',
     >            inr)
               if((inr.eq.0).or.(inr.gt.5).or.(inr.lt.-1000).or.
     >            ((inr.gt.-20).and.(inr.le.0)) ) then
                  call uermsi(
     >               ' require k=1,2,3,4,5 or in range [-1000,-20].',
     >               inr,0)
               else
                  exit
               endif
            enddo
 
            !----------------------------------------------
            call trxpl_ascii_write(apath,inx,inr)
            !----------------------------------------------
 
         endif
 
      else if(lchar('C')) then
         !  RPLOT CALCULATOR
         if(lxout(0)) then
            write(6,*)
     >         ' %caution -- although MKS conversion of standard TRANSP'
            write(6,*)
     >         '  profiles is automatic, the calculator must work in'
            write(6,*)
     >         '  "TRANSP" units;',
     >         ' user is responsible for labeling calculation results.'
         endif
         call ureadl('trxpl:  enter formula, or "Q" to quit:$',zexpr)
         if(zexpr.eq.'Q') go to 20
         zname=' '
         call ureadw('trxpl:  name of item to compute:$',zname)
         if(zname.eq.' ') then
            call uermsg(' ?trxpl:  non-blank name required.',' ',0)
            go to 20
         endif
         zunits=' '
         if(lxout(0)) then
            write(6,*)
     >        ' If calculation succeeds, trxpl "P" option will be able'
            write(6,*)
     >         ' access results and do most MKS conversions.'
         endif
         call ureadw('trxpl:  enter expected TRANSP physical units:$',
     >         zunits)
         call trx_calc(zname,zname//' (trxpl)',zunits,zexpr,iwarn,ierr)
         if(iwarn.gt.0) then
            write(6,*) ' %arithmetic errors occurred (trapped to zero)'
         endif
         if(ierr.gt.0) then
            write(6,*) ' %calculation failed.'
         endif
 
      else if(lchar('D')) then
         !  DISPLAY data with XPLASMA tool
         do i=1,numsc
            write(6,1001)
     >         i,sclabs(1,i),sclabs(2,i),sclabs(3,i),scvals(i)
         enddo
 1001    format(' scalar #',i3,':  ',3(a10,1x),'= ',1pd11.4)
c
c----------------------------------
         call eqdbg_plot
c----------------------------------
c
      else if(lchar('M')) then
 
         !--------------------------------------------------------------
         !  **** GS2 **** namelist generator
 
         if(numpro.gt.0) then
            call uermsg(
     >         '%trxpl:  after other options are used,'//
     >         ' "M" is not available.',
     >         ' ',0)
         else
            ilt=len_trim(tpath)
            call trxpl_mkgs2(tpath(1:ilt),ztime0,ztavg,ierr)
            igs2=1
            if(ierr.eq.0) then
               write(6,*) 'GS2 processing completed OK.'
            else
               write(6,*) 'GS2 (trxpl_mkgs2) error code, ierr=',ierr
            endif
         endif
c
      else if(lchar('R')) then
 
         !--------------------------------------------------------------
         !  **** FWR2D **** file generator
 
         if(numpro.gt.0) then
            call uermsg(
     >         '%trxpl:  after other options are used,'//
     >         ' "R" is not available.',
     >         ' ',0)
         else
            ilt=len_trim(tpath)
            call trxpl_fwr2d_cdf(tpath(1:ilt),ztime0,ztavg)
         endif
 
      else if(lchar('B')) then
 
         !--------------------------------------------------------------
         !  ****IMAS/ITER **** file generator
 
         if(numpro.gt.0) then
            call uermsg(
     >         '%trxpl:  after other options are used,'//
     >         ' "B" is not available.',
     >         ' ',0)
         else
 
            ilt=len_trim(tpath)

!     call trx_imas(ntheta,ierr)
            if(ierr.ne.0) then
               write(6,*) ' ?trxpl:  error in trx_imas:  ',tpath(1:ilt)
               return
            endif
            call trxpl_imaswr2d_cdf(tpath(1:ilt),ztime0,ztavg,
     >           ibccw,ipccw)
         endif
 
      else if(lchar('U')) then
         !  Ufile output option (no recent maintenance dmc 12/2002!)
         call trxpl_ufiles(tokdev,zdate,scvals,sclabs,numsc)

      else if(lchar('W')) then
         call ureadLw('Please give XPLASMA save filename:',zfile)

         call eq_save(zfile,ierr)
         write(6,*) trim(zfile),' written, status code (0=OK): ',ierr

      else if(lchar('L')) then
         ! Write Equilibrium in ESI format (L. Zakharov format)

         irho=21
         ichi=65

         open (99, file='esiA.00', status='replace')

         call eq_gfnum('pmhd',id_pmhd)

         call trx_scal('TFLUX',zuns_mks,ztflux,inerr)

         call trx_prof('NE',zuns_mks,1,id_ne,inerr)

         call eq_esia(99,irho,ichi,ztflux,id_pmhd,id_ne)

         close(99)

      else if(lchar('N')) then
         ! Write profiles for use by Roscoe's Orbit 

         open (99, file='nbi_profile.dat', status='replace')

         call trxpl_orbit_prof(99)

         close(99)

      else if(lchar('G')) then
         !  write GEQDSK file
 
         call wr_geq   ! contained routine...

      else if(lchar('I')) then
c
c        fetch temperature, density, Eperp and Epll for all charged
c        particle species ... thermal and non-thermal alike
c
         call trx_nspec(nspec)
 
         if(allocated(id_ns)) deallocate(id_ns)
         if(allocated(id_ts)) deallocate(id_ts)
         if(allocated(slbl)) deallocate(slbl)
         if(allocated(itype)) deallocate(itype)
         if(allocated(Zr8)) deallocate(Zr8)
         if(allocated(Ar8)) deallocate(Ar8)
         if(allocated(Izc)) deallocate(Izc)
         if(allocated(zvaln)) deallocate(zvaln)
         if(allocated(zvalt)) deallocate(zvalt)
         if(allocated(zvalv)) deallocate(zvalv)
         allocate(id_ns(nspec))
         allocate(id_ts(nspec))
         allocate(slbl(nspec))
         allocate(itype(nspec))
         allocate(Zr8(nspec))
         allocate(Ar8(nspec))
         allocate(Izc(nspec))
         allocate(zvaln(1:lrho,1:nspec))
         allocate(zvalt(1:lrho,1:nspec))
         allocate(zvalv(1:lrho))
 
         iorder=1
 
         call trx_spec_lbl(nspec,n_species,slbl,itype,Zr8,Ar8,IZc)
         do i=1,nspec
            if(itype(i).eq.3) then
               iordr=1
               ixtnd=0
               zname='AIMPJ'
               call trxpl_add_profile(zname)  ! for model impurity
               zname='XZIMPJ'
               call trxpl_add_profile(zname) ! for model impurity
               zname=' '
            endif
         enddo
 
         call trxpl_species(nspec,iorder,'T',id_ts)
 
         call trxpl_species(nspec,iorder,'<Eperp>',id_ts)
 
         call trxpl_species(nspec,iorder,'<Epll>',id_ts)
 
         call trxpl_species(nspec,iorder,'N',id_ns)
c
      else if(lchar('J')) then
c
c     *** test code ***
c
c Code corresponding to option J (CURRAY) written by
c K. Indireshkumar (08/2002)
c
         lrho_loop: do
 
            call uread(
     >         'ENTER NUMBER OF GRID POINTS OR "Q" TO QUIT:$$')
 
            ierror=0
            if (lchar('Q')) then
               lrho=51
               print *,'Number of zones set to ',lrho
            else
               lrho=idcod(ierror)
            endif
 
            if (ierror.ne.0) cycle lrho_loop
 
            exit lrho_loop
 
         end do lrho_loop
 
         if (allocated(rho)) deallocate(rho)
         allocate(rho(lrho))
 
         rho(1)=0.0
         drho=1.0/(lrho-1)
         do ik=2,lrho
            rho(ik)=rho(ik-1)+drho
         enddo
c
         call trx_nspec(nspec)
 
         if(allocated(id_ns)) deallocate(id_ns)
         if(allocated(id_ts)) deallocate(id_ts)
         if(allocated(slbl)) deallocate(slbl)
         if(allocated(itype)) deallocate(itype)
         if(allocated(Zr8)) deallocate(Zr8)
         if(allocated(Ar8)) deallocate(Ar8)
         if(allocated(Izc)) deallocate(Izc)
         if(allocated(zvaln)) deallocate(zvaln)
         if(allocated(zvalt)) deallocate(zvalt)
         if(allocated(zvalv)) deallocate(zvalv)
         allocate(id_ns(nspec))
         allocate(id_ts(nspec))
         allocate(slbl(nspec))
         allocate(itype(nspec))
         allocate(Zr8(nspec))
         allocate(Ar8(nspec))
         allocate(Izc(nspec))
         allocate(zvaln(1:lrho,1:nspec))
         allocate(zvalt(1:lrho,1:nspec))
         allocate(zvalv(1:lrho))
 
         iorder=1
 
         call trx_spec_lbl(nspec,n_species,slbl,itype,Zr8,Ar8,IZc)
 
         call trxpl_species(nspec,iorder,'T',id_ts)
 
         call trxpl_species(nspec,iorder,'N',id_ns)
 
c Interpolate densities to lrho grid
 
         call eq_rgetff(lrho,rho,nspec,id_ns,0,lrho,zvaln,ierr)
 
         if(ierr.ne.0) then
            write(6,*) ' ?trxpl: error interpolating density profiles'
         endif
 
c Interpolate temperatures to lrho grid
 
         call eq_rgetff(lrho,rho,nspec,id_ts,0,lrho,zvalt,ierr)
 
         if(ierr.ne.0) then
            write(6,*) ' ?trxpl: error interpolating temp profiles'
         endif
 
c  Acquire the id for loop voltage profile
 
         call trx_prof("V",zunit_volt,iorder,idvolt,ierr)
 
         if(ierr.ne.0) then
            write(6,*) ' ?trxpl:  error getting voltage profile id'
         endif
 
c Interpolate voltage to lrho grid
 
         call eq_rgetf(lrho,rho,idvolt,0,zvalv,ierr)
 
c Write profile (density and temperature) and voltage data to
c a file.
 
         open(2,file='test.out',status='unknown')
 
         write(2,*) lrho
         write(2,*) nspec
         write(2,*)
         write(2,'(5(1X,E16.9))') (rho(ik),ik=1,lrho)
         do ik=1,nspec
            write(2,*)
            write(2,'(f19.12)')Zr8(ik)
            write(2,'(f19.12)')Ar8(ik)
            write(2,*)
            write(2,'(5(1X,E16.9))')(zvaln(il,ik),il=1,lrho)
            write(2,*)
            write(2,'(5(1X,E16.9))')(zvalt(il,ik),il=1,lrho)
         enddo
 
         write(2,*)
         write(2,'(5(1X,E16.9))')(zvalv(ik),ik=1,lrho)
 
         close(2)
c
c
      else if(lchar('F')) then
c
c  TREQ file (for Alan Glasser)
c
         call unixfile('treq filename',fpath)
         call eq_gfnum('psi',id_psi)
         call eq_gfnum('pmhd',id_pmhd)
         call eq_gfnum('q',id_q)
         call eq_gfnum('g',id_g)
c
         open(unit=99,file=fpath,status='unknown',
     >      iostat=ierr)
c
         if(ierr.ne.0) then
            write(lnout(0),*) ' ?trxpl:  open failure:  ',fpath
            call uermsg(' %trxpl:  error opening file.',' ',0)
         else
            call trxpl_wrtreq(99,id_psi,id_pmhd,id_q,id_g,ierr)
            close(unit=99)
            if(ierr.ne.0) call uermsg(
     >         ' %trxpl:  error writing file.',fpath,0)
         endif
c
      else if(lchar('H')) then
c
c  Jon Menard style psipqgRZ file
c
         ixtra=0
         if(lxout(0)) then
            write(lnout(0),*)
     >         ' By default, the radial grid of this file is the'
            write(lnout(0),*)
     >         ' the original TRANSP grid (ixtra=0).'
            write(lnout(0),*)
     >         ' to insert extra points (ixtra points per radial zone),'
            write(lnout(0),*)
     >         ' set ixtra to a value between 1 and 10.'
            write(lnout(0),*)
         endif
         call ureadi('trxpl:  extra points per zone (ixtra):$',ixtra)
         ixtra=max(0,min(10,ixtra))
         call unixfile('psipqgRZ filename',hpath)
         call eq_gfnum('pmhd',id_pmhd)
         call eq_gfnum('q',id_q)
 
         call eq_psipqgrz(hpath,ixtra,id_pmhd,id_q,ierr)
 
         write(lnout(0),*)
     >      'eq_psipqgrz completion code (0=normal):',ierr
c
c------------------------
      else if(lchar('X')) then
c
c  extract plasma state(s) (also write G-EQDSK file as needed by state)
c  99 is a fortran LUN
c
        ilun = 99   ! LUN for GEQ file (set to 0 to suppress)
        call eq_ganum('__RHO',id_rho)
        call eq_ngrid(id_rho,inrho)
        inx_state=max(20,(inrho-1))
        do 
          if(lxout(0)) then
            write(lnout(0),*) inrho-1,' zones in original TRANSP run.'
            write(lnout(0),*) inx_state,' zones to be written in state.'
            write(lnout(0),*) ' ..."light" state output flag: ',
     >           (ilun.eq.0)
            call trxplib_getnum_mdescr(inaux)
            if(inaux.eq.0) then
               write(lnout(0),*) ' machine description list: EMPTY'
            else
               write(lnout(0),*) ' machine description list:'
               do iaux=1,inaux
                  call trxplib_getname_mdescr(iaux,mdescr)
                  write(lnout(0),*) '    '//trim(mdescr)
               enddo
            endif
            write(lnout(0),2000)
 2000       format(/
     >           ' "L" -- "light" state output option;'/
     >           ' "H" -- "heavy" state output option;'/
     >      '        (heavy state includes Psi(R,Z) & MHD equilibrium)'/
     >           ' "M" -- add/remove machine description files'/
     >           ' "N" -- change number of zones in output state file;'/
     >           ' "P" -- print recent events & slowing down times;'/
     >           ' "F" -- write events & slowing down times to file;'/
     >           ' "T" -- write time series of plasma states;'/
     >           '        (no time averaging; trxpl input is reset!);'/
     >        ' "S" -- write file containing all known sawtooth times.'/
     >        ' "O" -- write file containing all profile output times.'/
     >           ' "W" -- write single state file (+GENRAY option).'/
     >           ' "Q" -- quit without writing.'/)
          endif

          call uread('trxpl state file I/O option:')

          if(lchar('Q')) then
             go to 20

          else if(lchar('L')) then
             ilun = 0

          else if(lchar('M')) then
             if(lxout(0)) then
                write(lnout(0),*) ' enter "0" to clear list;'
                write(lnout(0),*) ' enter "Q" to exit w/o change;'
             endif
             call ureadLw('machine description filename:',mdescr)
             if(mdescr.eq.'q') cycle
             if(mdescr.eq.'Q') cycle
             if(mdescr.eq.'0') then
                call trxplib_clear_mdescr
             else
                call trxplib_add_mdescr(mdescr,ierloc)
                if(ierloc.ne.0) then
                   write(lnout(0),*) ' %trxpl_master: could not add: '//
     >                  trim(mdescr)
                endif
             endif

          else if(lchar('H')) then
             ilun = 99

          else if(lchar('N')) then
             call ureadi(
     >            'Enter number of radial zones in state profiles',
     >            inx_state)

          else if(lchar('P')) then
             call tausl(' ')

          else if(lchar('F')) then
             spath=' '
             call unixfile('event & slowing down times report',spath)
             call tausl(spath)

          else if(lchar('S')) then
             spath=' '
             call unixfile('file of sawtooth times',spath)
             call trx_wr_stimes(spath,ierr)
             if(ierr.ne.0) then
                call uermsi(' ?trx_wr_stimes returned error code',
     >               ierr,0)
             endif

          else if(lchar('O')) then
             spath=' '
             call unixfile('file of profile output times',spath)
             call trx_wr_protimes(spath,ierr)
             if(ierr.ne.0) then
                call uermsi(' ?trx_wr_protimes returned error code',
     >               ierr,0)
             endif

          else if(lchar('T')) then
             if(lxout(0)) then
                write(lnout(0),'(a,1pe12.5)') ' current time t0: ',
     >               ztime0
                write(lnout(0),*) ' time series of states to be written'
                write(lnout(0),*) ' from t0-delta_t to t0 at TRANSP run'
                write(lnout(0),*) ' output times; delta_t=0 to skip...'
             endif

             zdelt_lead = 0.0d0
             call ureadr8('trxpl_master: enter lead time delta_t:',
     >            zdelt_lead)

             if(zdelt_lead.le.0.0d0) cycle

             if(lxout(0)) then
                write(lnout(0),*) 
     >               ' specify directory for output files'
                write(lnout(0),*) 
     >               ' or "Q" for current working directory.'
                write(lnout(0),*)
     >               ' output filenames will encode time in form:'
                if(ilun.eq.0) then
                   write(lnout(0),*) 
     >                  '   <tok>_<runid>_nnxnnnn_1d.*'
                else
                   write(lnout(0),*) 
     >                  '   <tok>_<runid>_nnxnnnn.*'
                endif
                write(lnout(0),*) 
     >               ' all listed in <tok>_<runid>_states.list...'
             endif

             spath=' '
             call unixpath(spath,rpath,ilenr)

             iopen=0
             do i=1,inpr
                if(ztimes_p(i).gt.(ztime0-zdelt_lead)) then
                   intbegin=max(1,(i-1))
                   exit
                endif
             enddo

             char1=' '
             ichar1=0

             do i=intbegin,intime0
                write(6,*) ' '
                write(6,*) ' ====================== '
                write(6,'(1x,a,1x,i4,1x,f12.4)') 'processing time',
     >               i,ztimes_p(i)

                zctime=' '
                write(zctime,'(f12.4)') ztimes_p(i)

                ztime0 = ztimes_p(i)
                ztavg  = 0.0

                call loc_trx_get  ! restart trxplib data, @ new time...

                call trx_init_state(ier)  ! re-init state
                if(ier.ne.0) then
                   write(lnout(0),*) ' ?? trx_init_state: error. '
                   exit
                endif

                zpath = spath  ! save preceding file path

                if(rpath.eq.' ') then
                   spath='.'
                else 
                   spath=rpath
                endif

                ilenr = len(trim(spath))
                if(spath(ilenr:ilenr).ne.'/') then
                   ilenr=ilenr+1
                   spath(ilenr:ilenr) = '/'
                endif
                ilenp=ilenr+1   ! 1st char of filename after directory path

                spath = trim(spath)//trim(tokdev)//'_'//trim(runid)
                ilens = len(trim(spath))  ! save this root len <tok>_<runid>
                ilenr = ilens + 1
                spath(ilenr:ilenr)='_'
                
                do j=1,len(zctime)
                   if(zctime(j:j).ne.' ') then
                      ilenr = ilenr + 1
                      if(zctime(j:j).eq.'-') then
                         spath(ilenr:ilenr)='m'
                      else if(zctime(j:j).eq.'.') then
                         spath(ilenr:ilenr)='x'
                      else
                         spath(ilenr:ilenr)=zctime(j:j)
                      endif
                   endif
                enddo

                if(ilun.eq.0) then
                   spath(ilenr+1:ilenr+3)='_1d'
                   ilenr=ilenr+3
                endif

                if(spath.eq.zpath) then
                   ichar1=ichar1+1
                   if(ichar1.gt.len(alphab)) then
                      write(6,*) ' ?? trxpl_master: too many states '//
     >                     'at nearly the same time.'
                      exit
                   else
                      char1 = alphab(ichar1:ichar1)
                   endif
                   ilenr=ilenr+1
                   if(ilun.eq.0) then
                      spath(ilenr-3:ilenr)=char1//'_1d'
                   else
                      spath(ilenr:ilenr)=char1
                   endif
                else
                   ichar1=0
                   char1=' '
                endif

                if(i.eq.intbegin) then
                   iws=2  ! write machine description, 1st call only
                else
                   iws=1  ! don't write machine description, nth call
                endif

                call trx_gen_state(ilun,
     >               geqdsk_lbl,tokdev,runid,inx_state,spath,
     >               iws,1,ier)

                write(lnout(0),*) ' trx_gen_state completed, status = ',
     >               ier,' (0 is normal).'
                if(ier.ne.0) exit

                if(i.eq.intbegin) then
                   call frename(spath(1:ilenr)//'.mdescr',
     >                  spath(1:ilens)//'.mdescr',istat)
                   call frename(spath(1:ilenr)//'.sconfig',
     >                  spath(1:ilens)//'.sconfig',istat)

                   ! start list file
                   open(unit=98,file=spath(1:ilens)//'.list',
     >                  status='unknown',iostat=ios)
                   if(ios.ne.0) then
                      write(6,*) 
     >                     ' ?? trxpl_master: list file open failure.'
                      exit
                   else
                      iopen=1
                   endif

                   j=index(geqdsk_lbl,'t=') - 1
                   j=max(1,j)

                   write(98,'(1x,a,i4)') geqdsk_lbl(1:j)//'  Nstates: ',
     >                  intime0-intbegin+1

                endif

                write(98,'(2x,1pe13.6,2x,a)') ztimes_p(i),
     >               spath(ilenp:ilenr)//'.cdf'

             enddo

             if(iopen.eq.1) close(unit=98)

             go to 10  ! get new runid & time

          else if(lchar('W')) then

             if(lxout(0)) write(lnout(0),2001)
 2001        format(
     >        ' --> enter %ECH or <file_path>/%ECH for ECH data '/
     >        '     package (assist TORAY/GENRAY comparisons).'//
     >        ' Output files:'/
     >        '   <file_path>/<file_root>.geq = G-EQDSK'/
     >        '   <file_path>/<file_root>.cdf = Plasma State'/
     >        '   <file_path>/<file_root>.mdescr = Machine Description'/
     >        '   <file_path>/<file_root>.sconfig = Shot Configuration'/
     >            )
             spath=' '
             call unixfile(
     >            'Plasma state output <file_path>/<file_root>',spath)

             jlun = ilun

             ilenf=len(trim(spath))
             ztest=spath(max(1,ilenf-3):ilenf)
             call uupper(ztest)
             if(ztest.eq.'%ECH') then
                write(lnout(0),*) ' ** ECH package: cur_state.cdf etc.'
                spath(ilenf-3:ilenf)=ztest
                jlun=99 ! force "heavy" state
             endif

             call trx_init_state(ier)
             write(lnout(0),*) ' trx_init_state status = ',ier

             iws=2
             call trx_gen_state(jlun,
     >            geqdsk_lbl,tokdev,runid,inx_state,spath,
     >            iws,1,ier)

             write(lnout(0),*) ' trx_gen_state completed, status = ',
     >            ier,' (0 is normal).'

             go to 20  ! return to main loop
          else
             call uermsg('option code not understood.',' ',0)

          endif
        enddo
c
c------------------------
c
      else
         call uermsg('?invalid option.',' ',0)
      endif
      go to 20
c
c-----------------------------------------------------------------------------
c
      contains

      !-----------------------------------
         subroutine wr_geq

           ! contained routine to write G-EQDSK file

           gpath=' '  ! if blank on exit, file was not written successfully.

           nh_geqdsk=nR
           nv_geqdsk=nZ
           nb_geqdsk=201
c
           write(lnout(0),*) ' GEQDSK label string:  ',geqdsk_lbl
           if(lxout(0)) write(lnout(0),*)
     >          ' %enter "0" to abort GEQDSK write.'
c
           call ureadi(' trxpl:  #horizontal pts for GEQDSK file:',
     >          nh_geqdsk)
           if(nh_geqdsk.eq.0) then
              return
           else
              nh_geqdsk=max(32,min(500,nh_geqdsk))
           endif
c
           call ureadi(' trxpl:  #vertical pts for GEQDSK file:',
     >          nv_geqdsk)
           if(nv_geqdsk.eq.0) then
              return
           else
              nv_geqdsk=max(32,min(500,nv_geqdsk))
           endif
c
           call ureadi(' trxpl:  #bdy contour pts for GEQDSK file:',
     >          nb_geqdsk)
           if(nb_geqdsk.eq.0) then
              return
           else
              nb_geqdsk=max(32,min(500,nb_geqdsk))
           endif
c
c------------------------
c
           write(lnout(0),*) ' GEQDSK label string:  ',geqdsk_lbl
           if(lxout(0)) write(lnout(0),*) 
     >          ' enter "Q" to quit w/o write.'
           call unixfile('GEQDSK filename',gpath)
           if(gpath.eq.'q ') then
              gpath=' '
              return
           endif
           if(gpath.eq.'Q ') then
              gpath=' '
              return
           endif
c
           open(unit=99,file=gpath,status='unknown',
     >          iostat=ierr)
c
           if(ierr.eq.0) then
              call eq_gfnum('pmhd',id_pmhd)
              call eq_gfnum('q',id_q)
              call eq_geqdsk(99,geqdsk_lbl,Rmin,Rmax,Zmin,Zmax,zcur,
     >             id_pmhd,id_q,nh_geqdsk,nv_geqdsk,nb_geqdsk,ierr)
              if(ierr.ne.0) then
                 gpath=' '
                 close(unit=99,status='DELETE')
              else
                 close(unit=99)
              endif
           else
              write(lnout(0),*)
     >             ' %trxpl:  GEQDSK file open failure:  ',ierr
              gpath=' '
           endif
           if(ierr.ne.0) then
              call uermsg(' %trxpl:  error writing GEQDSK file.',' ',0)
              gpath=' '
           endif

           return
         end subroutine wr_geq

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

         subroutine loc_trx_get
c
c  load xplasma @ time ztime0 w/avg +/- ztavg, for current run
c
           logical :: ltrx_freebdy ! test for free bdy data
c
           integer :: ifind
           real*8 :: psi0
c
c-------------
c
           nR=nR_orig
           nZ=nZ_orig
c
           Rmin = Rmin_orig
           Rmax = Rmax_orig
           Zmin = Zmin_orig
           Zmax = Zmax_orig
c
           call trx_time(ztime0,ztavg,iwarn,ierr)
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl:  error in trx_time:  ',tpath(1:ilt)
              return
           endif
c
           call trx_init_xplasma(ierr)
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl:  error in trx_init_xplasma:  ',
     >             tpath(1:ilt)
              return
           endif
c
c  get the internal equilibrium data
c  this sets up a poloidal angle grid "theta" (cf ntheta)
c  this sets up in "xplasma" the profiles:
c        PMHD - Pascals
c         g  - tesla*m
c         q  - no units
c       psi  - poloidal flux, Webers
c       phi  - toroidal flux, Webers
c       R(rho,theta), Z(rho,theta)
c
c  dmc Sept 20, 2000 -- enable theta reverse (for debugging purposes)
c
           if(ntheta.lt.0) then
              call trx_set_threverse(1)
              ntheta=-ntheta
           else
              call trx_set_threverse(0)
           endif
c
           call trx_mhd(ntheta,ierr)
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl:  error in trx_mhd:  ',tpath(1:ilt)
              return
           endif
c
c  get the limiters (from the namelist); set up an (R,Z) rectangular grid
c
           if(ltrx_freebdy(0)) then
              call trx_wall_freebdy(99,ierr)
           else
              call trx_wall_RZ(99,Rmin,Rmax,nR,Zmin,Zmax,nZ,ierr)
           endif
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl:  error in trx_wall:  ',tpath(1:ilt)
              return
           endif
c
c  get B field components on flux grid;
c  extrapolate B field components onto the (R,Z) grid
c
c  after this call we have Bmod(rho,theta)
c                          BR(rho,theta) or BR(R,Z)
c                          BZ(rho,theta) or BZ(R,Z)
c                                           Bphi(R,Z)
c
           irzflag=1
           call trx_bxtr(ibccw,ipccw,irzflag,ierr)
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl: trx_bxtr error status: ',ierr
           endif
c
c  initialize scalar data array & labels
c  trxpl - specific call ... prepare some Ufile labeling info
c
           call trxpl_sc_init(ztime0,ztavg,
     >          tokdev,runid,zdate,scvals,sclabs,numsc,maxsc)
c
           zcur=scvals(numsc)   ! plasma current, amps
c
c  initialize GEQDSK label
c
           zttmp=' '
           call c9date(zttmp)
c
c
c  NOTE: for TRANSP run w/o free boundary data: important that this 
c        label start with "TRXPL"; "TRXfb" used to identify TRANSP runs
c        with free boundary data
c
           call trx_psi0(ifind,Psi0)
           if(ifind.eq.0) then
              geqdsk_lbl='TRXPL '//zttmp
           else
              ! trxplib has Psi0 data only for "fb" free boundary cases
              geqdsk_lbl='TRXfb '//zttmp
           endif
c
           ilt=len_trim(geqdsk_lbl)+2
           geqdsk_lbl(ilt:)=tokdev
c
           ilt=len_trim(geqdsk_lbl)+2
           geqdsk_lbl(ilt:)=sclabs(2,1)
c
           ilt=len_trim(geqdsk_lbl)+2
           geqdsk_lbl(ilt:)=sclabs(3,1)
c
           ilt=len_trim(geqdsk_lbl)+2
           geqdsk_lbl(ilt:)='t='
c
           ilt=len_trim(geqdsk_lbl)
           if(ztavg.gt.0) geqdsk_lbl(ilt:ilt)='~'
           ilz=min(10,(len(geqdsk_lbl)-ilt))
c
           write(zttmp,'(f10.5)') ztime0
           geqdsk_lbl(ilt+1:ilt+ilz)=zttmp(1:ilz)
c
c  get profile and scalar functions / calculator results as
c  requested by user... first fetch from xplasma the (R,Z) grid limits.
c
           call eq_glimrz(1.0_R8,rmin1,rmax1,zmin1,zmax1,ierr)
           if(ierr.ne.0) then
              write(6,*) ' ?trxpl:  eq_glimrz failure.'
              return
           endif
           if(rmin.gt.0.95*rmin1) then
              write(6,*)
     >      ' %trxpl: Rmin reset to safely enclose inner bdy of plasma.'
              write(6,*) '  old Rmin: ',rmin,' new Rmin: ',0.95*rmin1
              rmin=0.95*rmin1
           endif
           if(rmax.lt.1.05*rmax1) then
              write(6,*)
     >      ' %trxpl: Rmax reset to safely enclose outer bdy of plasma.'
              write(6,*) '  old Rmax: ',rmax,' new Rmax: ',1.05*rmax1
              rmax=1.05*rmax1
           endif
           zmid1=(zmin1+zmax1)/2
           zhgt1=(zmax1-zmin1)/2
           if(zmin.gt.zmid1-1.05*zhgt1) then
              write(6,*)
     >      ' %trxpl: Zmin reset to safely enclose lower bdy of plasma.'
              write(6,*) 
     >             '  old Zmin: ',zmin,' new Zmin: ',zmid1-1.05*zhgt1
              zmin=zmid1-1.05*zhgt1
           endif
           if(zmax.lt.zmid1+1.05*zhgt1) then
              write(6,*)
     >      ' %trxpl: Zmax reset to safely enclose upper bdy of plasma.'
              write(6,*) 
     >             '  old Zmax: ',zmax,' new Zmax: ',zmid1+1.05*zhgt1
              zmax=zmid1+1.05*zhgt1
           endif
c
           zlamda=0.01_r8*(rmax1-rmin1)
c
           igs2=0
           numpro=0
           prolabs=' '
           id_pros=0
           id_xaxis=0
           ixtnd=0
           iordr=1

           return
        end subroutine loc_trx_get

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

        subroutine tausl(zfile)

           ! write "slowing down & events" report
           
           character*(*), intent(in) :: zfile  ! file to write (blank for tty)

           !------------------------------------------
           integer :: iolun,ios,if,iordr,itmp,iwarn,irho,itype,id
           real*8, dimension(:), allocatable :: zrho,zvol,zrhozc
           real*8, dimension(:), allocatable :: zden,ztau
           real, dimension(:), allocatable :: zscdata  ! ** single precision **
           real, dimension(:), allocatable :: zsclist
           real*8 :: ztausl,ztsum,zdsum,zdv,ztmin
           character*120 :: zfilu,zline
           character*20 zuns
           character*32 zlbl
           character*50 zrlabel
           logical :: iexist
           integer :: insaw,ingot,ii
           !------------------------------------------
           integer, parameter :: nf_species = 9
           logical :: ihave(nf_species)
           character*32 :: f_species_lbl(nf_species) = (/ 
     >          'H beam ions   ','D beam ions   ','T beam ions   ',
     >          'He3 beam ions ','He4 beam ions ',
     >          'fusion alphas ','fusion He3    ',
     >          'fusion T      ','fusion protons' /)
           character*10 :: f_dens(nf_species) = (/
     >          'BDENS_H', 'BDENS_D', 'BDENS_T', 'BDENS_3', 'BDENS_4',
     >          'FDENS_4', 'FDENS_3', 'FDENS_T', 'FDENS_P' /)
           character*10 :: f_spec1(nf_species) = (/
     >          'TSL1A_H','TSL1A_D','TSL1A_T','TSL1A_3','TSL1A_4',
     >          'TFSL_4 ','TFSL_3 ','TFSL_T ','TFSL_P ' /)
           character*10 :: f_spec2(nf_species) = (/
     >          'TSL1B_H','TSL1B_D','TSL1B_T','TSL1B_3','TSL1B_4',
     >          '       ','       ','       ','       ' /)
           integer :: itype1(nf_species) = (/ 1,1,1,1,1, 3,3,3,3 /)
           integer :: itype2(nf_species) = (/ 2,2,2,2,2, 0,0,0,0 /)

           character*32 :: ztyp_lbl(3) = (/
     >          'full energy co-injected     ',
     >          'full energy counter-injected',
     >          'nominal birth energy        ' /)
           !------------------------------------------

           if(zfile.eq.' ') then
              itmp=1
              call tmpfile_d('trxpl_tausl',zfilu,idum)
           else
              itmp=0
              zfilu=zfile
           endif

           do
              allocate(zrho(inrho),zvol(inrho))
              call eq_grid(id_rho,zrho,inrho,idum,ierr)
              if(ierr.ne.0) exit

              call eq_volume(inrho,zrho,0,zvol,ierr)
              if(ierr.ne.0) exit
           
              allocate(zrhozc(inrho-1))
              zrhozc = 0.5d0*(zrho(1:inrho-1)+zrho(2:inrho))

              allocate(zden(inrho-1),ztau(inrho-1))

                                ! use I/O unit 99 for file
                                ! like rest of trxpl_master.for
              iolun=99
              open(unit=iolun,file=trim(zfilu),status='unknown',
     >             iostat=ios)
              if(ios.ne.0) then
                 call uermsg('apparent file open failure',zfilu,0)
                 exit
              endif
                                ! write report...
              call trx_label(zrlabel)
              write(iolun,3001) trim(zrlabel),ztime0,ztavg
 3001         format("TRANSP ",a,"; time0=",
     >             1pe13.6,"s; delta_t=",1pe13.6,"s")
              write(iolun,'(1x,A)') 
     >             'Density weighted averaged'//
     >             ' approximate slowing down times:'

              write(6,*) ' trxpl_tausl: probing for fast ion species...'
              ztausl = 0.0d0
                                ! loop over possible species...
              do if=1,nf_species
                 call rpexist_profile(f_dens(if),iexist)
                 if(.not.iexist) cycle

                 call trx_prof(f_dens(if),zuns,1,id,iwarn)
                 if(id.eq.0) cycle

                 call eq_rgetf(inrho-1,zrhozc,id,0,zden,idum)

                 call trx_prof(f_spec1(if),zuns,1,id,iwarn)
                 if(id.eq.0) cycle

                 call eq_rgetf(inrho-1,zrhozc,id,0,ztau,idum)

                 zdsum = 0.0d0
                 ztsum = 0.0d0
                 do irho=1,inrho-1
                    zdv = zvol(irho+1)-zvol(irho)
                    zdsum = zdsum + zden(irho)*zdv
                    ztsum = ztsum + ztau(irho)*zden(irho)*zdv
                 enddo
                 if(zdsum.le.0.0d0) then
                    ztsum = 0.0d0
                 else
                    ztsum = ztsum/zdsum
                 endif

                 itype=itype1(if)
                 write(iolun,'(1x,1pe12.5,a)') ztsum,
     >                ' seconds: '//trim(f_species_lbl(if))//' at '//
     >                trim(ztyp_lbl(itype))

                 ztausl = max(ztausl,ztsum)

                 if(f_spec2(if).eq.' ') cycle

                 call trx_prof(f_spec2(if),zuns,1,id,iwarn)
                 if(id.eq.0) cycle

                 call eq_rgetf(inrho-1,zrhozc,id,0,ztau,idum)

                 zdsum = 0.0d0
                 ztsum = 0.0d0
                 do irho=1,inrho-1
                    zdv = zvol(irho+1)-zvol(irho)
                    zdsum = zdsum + zden(irho)*zdv
                    ztsum = ztsum + ztau(irho)*zden(irho)*zdv
                 enddo
                 if(zdsum.le.0.0d0) then
                    ztsum = 0.0d0
                 else
                    ztsum = ztsum/zdsum
                 endif

                 itype=itype2(if)
                 write(iolun,'(1x,1pe12.5,a)') ztsum,
     >                ' seconds: '//trim(f_species_lbl(if))//' at '//
     >                trim(ztyp_lbl(itype))

                 ztausl = max(ztausl,ztsum)

              enddo
              write(iolun,'(1x,a,1pe12.5,a)') 'max slowing down time:',
     >             ztausl,' seconds.'

                                ! look for sawteeth
              insaw = 0

              call rpexist_scalar('TLASTSAW',iexist)
              if(iexist) then
                 call trx_ntimes(insc,inpr,idum)
                 allocate(zscdata(insc),zsclist(insc))
                 call rpscalar('TLASTSAW',zscdata,insc,ingot,iwarn)

                 ztmin=ztime0-2*ztausl
                 do ii=1,ingot
                    if((ztmin.le.zscdata(ii)).AND.
     >                   (zscdata(ii).le.ztimes_p(intime0)) ) then
                       if(insaw.gt.0) then
                          if(zscdata(ii).ne.zsclist(insaw)) then
                             insaw=insaw + 1
                             zsclist(insaw)=zscdata(ii)
                          endif
                       else
                          insaw=1
                          zsclist(1)=zscdata(ii)
                       endif
                    endif
                 enddo
              endif

              write(iolun,'(1x,a,i4)') 'Number of recent sawteeth: ',
     >             insaw
              do ii=1,insaw
                 write(iolun,'(4x,1pe13.6)') zsclist(ii)
              enddo

              if(iolun.eq.99) then
                 if(itmp.eq.0) then
                    close(unit=iolun)
                 else
                    rewind(iolun)
                    write(6,*) ' '
                    write(6,*) ' trxpl_tausl results:'
                    write(6,*) ' '
                    do
                       read(iolun,'(A)',iostat=ios) zline
                       if(ios.ne.0) exit
                       write(6,*) trim(zline)
                    enddo
                    write(6,*) ' '
                    close(unit=iolun,status='delete')
                 endif
              endif

              exit
           enddo
           if(allocated(zrho)) deallocate(zrho)
           if(allocated(zrhozc)) deallocate(zrhozc)
           if(allocated(zvol)) deallocate(zvol)
           if(allocated(zden)) deallocate(zden)
           if(allocated(ztau)) deallocate(ztau)
           if(allocated(zscdata)) deallocate(zscdata)
           if(allocated(zsclist)) deallocate(zsclist)

           return
        end subroutine tausl

      end
