C--------------------------------------------------------------------
      subroutine trxpl_path(tpath,ztime0,ztavg,ntheta,
     >   Rmin,Rmax,nR,Zmin,Zmax,nZ,
     >   ibccw,ipccw)
C
C  specify TRANSP runid, desired time, time averaging & #theta pts
C
      implicit NONE
C
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      character*(*) tpath               ! run path (file or MDS+)
      real*8 ztime0                     ! time of interest
      real*8 ztavg                      ! +/- delta(t)
      integer ntheta                    ! #of theta pts for bicubic splines

      real*8 Rmin,Rmax                  ! desired (R) range or 0 for defaults
      real*8 Zmin,Zmax                  ! desired (Z) range or 0 for defaults
      integer nR,nZ                     ! #of (R,Z) pts for external grid

      integer ibccw                     ! +1 for Bt counterclockwise, -1 o.w.
      !  leave at 0 to read from TRANSP "trdatbuf" data
      integer ipccw                     ! +1 for Ip counterclockwise, -1 o.w.
      !  leave at 0 to read from TRANSP "trdatbuf" data
C
C--------------
C
      integer ilt,iert,idcod,ifree
C
      integer icall,icallRZ
C
      character*25 ccwlbl(-1:1)
C
      character*1 zans
C
      real*8 zt1,zt2
      integer :: insc,inpr
C
      real*8, parameter :: ZERO = 0.0d0
C---------------
C  functions...
C
      integer lnout                     ! tty lun
      logical lxout                     ! menu output flag
      logical lchar                     ! response test
      logical lyes                      ! test for "Y" or discard input char
      logical :: ltrx_freebdy           ! test for free bdy data
      real*8 :: r8dcod
C---------------
C
      data ccwlbl/'clockwise ',
     >     'set from TRANSP data','counter-clockwise '/
C
      data icall/0/
      data icallRZ/0/
C
C----------------------------
C
      icall=icall+1
      if(icall.eq.1) then
         ntheta=151
      endif

      icallRZ=icallRZ+1
      if(icallRZ.eq.1) then
         nR=101
         nZ=101
      endif
C
      Rmin=0.0_R8
      Rmax=0.0_R8
      Zmin=0.0_R8
      Zmax=0.0_R8
C
 10   continue
c
      call trxpl_path0(tpath)
      if(tpath.eq.' ') return
      ilt=len_trim(tpath)
C
      call trx_connect(tpath,iert)
      if(iert.ne.0) go to 10
C
      call trx_tlims(zt1,zt2,iert)
      call trx_ntimes(insc,inpr,iert)
      write(6,*) ' '
      write(6,*) ' trxpl:  connected to run ',tpath(1:ilt)
      write(6,'(A,2(1x,1pe12.5))') '   time range (seconds): ',zt1,zt2
      write(6,*) '   #time pts: scalars: ',insc,'; profiles: ',inpr
      write(6,*) ' '
C
      if(ltrx_freebdy(0)) then
         ifree=1
         write(6,*) ' ===> Free Boundary Equilibrium Available.'
         icallRZ = 0

         call trx_freebdy_RZgridSize(nR,nZ)

         call trx_freebdy_RZminmax(Rmin,Rmax,Zmin,Zmax)
      else
         ifree = 0   ! prescribed bdy only
         write(6,*) ' (no free boundary data).'
      endif
      write(6,*) ' '
C
C  OK... now get time of interest   & #ntheta
C
 100  continue
      call ureadr8('trxpl_path:  time of interest:$',ztime0)
      call trxpl_path_dtavg('trxpl_path:  +/- averging time (.ge.0):$',
     >     ztime0,ztavg,zans)
      if(zans.eq.'Q') go to 100
C
      if(lxout(0)) write(lnout(0),*)
     >   ' %for theta reversal test, give ntheta.lt.0:'
      call ureadi('trxpl_path:  #theta pts for 2d splines:$',ntheta)
      if(ifree.eq.0) then
         call ureadi(
     >        'trxpl_path:  #R pts for cartesian overlay grid:$',nR)
         call ureadi(
     >        'trxpl_path:  #Z pts for cartesian overlay grid:$',nZ)
      endif
C
 110  continue
      if(lxout(0)) write(lnout(0),*)
     >     ' "ccw" means "counter-clockwise looking down from above".'
      if(lxout(0)) write(lnout(0),*)
     >     ' ...enter "-1" for clockwise orientation.'
      if(lxout(0)) write(lnout(0),*)
     >     ' ...enter "0" to read orientation from TRANSP data archive.'
      call uread(
     >   'trxpl_path:  enter "1" for if Btoroidal is ccw:$')
      ibccw=idcod(iert)
      if(iert.ne.0) go to 110
      if(abs(ibccw).gt.1) then
         call uermsi(' ccw option:  enter 0, 1 or -1',ibccw,0)
         go to 110
      endif
C
 120  continue
      if(lxout(0)) write(lnout(0),*)
     >     ' "ccw" means "counter-clockwise looking down from above".'
      if(lxout(0)) write(lnout(0),*)
     >     ' ...enter "-1" for clockwise orientation.'
      if(lxout(0)) write(lnout(0),*)
     >     ' ...enter "0" to read orientation from TRANSP data archive.'
      call uread(
     >   'trxpl_path:  enter "1" for if Plasma current is ccw:$')
      ipccw=idcod(iert)
      if(iert.ne.0) go to 120
      if(abs(ipccw).gt.1) then
         call uermsi(' ccw option:  enter 0, 1 or -1',ipccw,0)
         go to 120
      endif
C
 150  continue
      write(lnout(0),*) ' path:  ',tpath
      write(lnout(0),*) ' time of interest:  ',ztime0
      write(lnout(0),*) ' +/- averaging time: ',ztavg
      write(lnout(0),*) ' # of theta pts:    ',abs(ntheta)
      if(ntheta.lt.0) write(lnout(0),*)
     >   ' *** theta reversal test requested *** '
      write(lnout(0),*) ' # of R pts:        ',nR
      write(lnout(0),*) ' # of Z pts:        ',nZ
      write(lnout(0),*) ' Btoroidal orientation is ',ccwlbl(ibccw)
      write(lnout(0),*) ' Plasma current orientation is ',ccwlbl(ipccw)
C
      if((Rmin.eq.0.0_R8).and.(Rmax.eq.0.0_R8).and.
     >   (Zmin.eq.0.0_R8).and.(Zmax.eq.0.0_R8)) then
         write(lnout(0),*) ' (R,Z) grid extent:  to match limiters.'
      else
         write(lnout(0),*) ' (R,Z) grid extent:'
         write(lnout(0),*) '    Rmin=',Rmin,' Rmax=',Rmax
         write(lnout(0),*) '    Zmin=',Zmin,' Zmax=',Zmax
         if(ifree.eq.0) then
            write(lnout(0),*) ' (may be extended to cover limiters).'
         endif
      endif
C
      if(lxout(0)) then
         write(lnout(0),*) 
     >        ' ** enter "C" to control {R,Z}(theta,rho) bdy cond.'
         if(ifree.eq.0) then
            write(lnout(0),*)
     >           ' ** enter "R" to modify (R,Z) grid limits.'
         endif
      endif
      call uread('trxpl_path:  enter "Y" to verify:$')

      if(lchar('R')) then
         if(ifree.eq.0) then
            call ureadr8('trxpl_path:  Rmin:',Rmin)
            call ureadr8('trxpl_path:  Rmax:',Rmax)
            call ureadr8('trxpl_path:  Zmin:',Zmin)
            call ureadr8('trxpl_path:  Zmax:',Zmax)
         else
            call uermsg('cannot change grid (free bdy run)',' ',0)
         endif
         go to 150

      else if(lchar('C')) then
         if(lxout(0)) write(lnout(0),*) 
     >        ' For boundary conditions on {R,Z}(theta,rho):'
         if(lxout(0)) write(lnout(0),*) 
     >        ' Enter other than "Y" for "not a knot" Bdy Condition.'
         call uread(
     >        'enter "Y" for finite difference Boundary Condition:')
         if(lyes(0)) then
            call trx_rzbc_fdiff
         else
            call trx_rzbc_nknot
         endif
         go to 150
      else if(lyes(0)) then
         return                         ! return path to caller
      else
         go to 10
      endif
C
      end
C------------------------------------------------------------------
      subroutine trxpl_path0(tpath)
      character*(*) tpath               ! run path (file or MDS+)

C----------------------------------------------------
C just set the run path
C----------------------------------------------------
C
C  mode
C
      integer, save :: imode            ! mode select
      character*4, save :: zmode(2)     ! FILE/MDS+
C
C  file spec components
C
      character*64, save :: rpath       ! file path to results root directory
      character*50, save :: tokyy       ! results subdirectory (tok.yy)
      character*10, save :: runid       ! runid
C
C  MDS+ spec components
C
      character*50, save :: mds_server  ! server node
      character*20, save :: mds_tree    ! tree name
      character*25, save :: mds_shot    ! shot spec or runid combo
C
      character*180, save :: lpath      ! "literal" path
C        ! syntax: <server>:<tree>(<mds_number>), or,
C                  <server>:<tree>(<tok.yy>,<runid>)
C
      logical, save :: initp = .FALSE.  ! initialization status flag
C
C  misc...
C
      integer :: i,ilenl,ic,id,isl,ilr,ilt,ild,ils,ilxy,imds
C
C  for lpath parse:
C
      integer :: icolon,ilparen,irparen,ifld1,ifld2,ifld3
C
C---------------
C  for env var lookup
C
      character*60 zenv
C
C---------------
C  functions...
C
      integer lnout                     ! tty lun
      logical lxout                     ! menu output flag
      logical lchar                     ! response test
      logical lyes                      ! test for "Y" or discard input char
C
C---------------
C  data stmts
C
      data lpath/'.'/
      data rpath/'ARCDIR'/
      data tokyy/'tok.yy'/
      data runid/'runid'/
C
      data mds_server/'mds_server.ip.address'/
      data mds_tree/'TRANSP'/
      data mds_shot/'tok.yy,runid | shot#'/
C
      data imode/1/
      data zmode/'FILE','MDS+'/
C
C----------------------------------------------------
C
      if(.NOT.initp) then
         initp=.TRUE.

         call sget_env('MDS_TRANSP_SERVER',zenv)
         if(zenv.ne.' ') mds_server=zenv

         call sget_env('MDS_TRANSP_TREE',zenv)
         if(zenv.ne.' ') mds_tree=zenv
      endif

 10   continue
      if(imode.eq.1) then
C
C  file mode ************************
C
         ilr=len_trim(rpath)
         ilt=len_trim(tokyy)
         ild=len_trim(runid)
C
         tpath=zmode(imode)//':'
         ilx=len_trim(tpath)+1
c
         if(rpath.ne.'NONE') then
            tpath(ilx:)=rpath(1:ilr)//'/'
            ilx=len_trim(tpath)+1
         endif
c
         if(tokyy.ne.'NONE') then
            i=index(tokyy,'.')
            if (i .gt. 0) tokyy(i:i) = '/'
            tpath(ilx:)=tokyy(1:ilt)//'/'
            ilx=len_trim(tpath)+1
         endif
c
         tpath(ilx:)=runid(1:ild)
C
         ilt=len_trim(tpath)
C
         if(lxout(0)) then
            write(lnout(0),1001) tpath(1:ilt)
 1001       format(/
     >         ' ...path:  ',a//
     >         ' F -- select FILE mode (no change)'/
     >         ' M -- toggle btw MDS+ and FILE mode'/
     >         ' R -- reset path to results root directory',
     >                ' (enter "none" to use CWD)'/
     >         ' Y -- reset tok.yy (none for CWD)'/
     >         ' D -- reset runid'/
     >         ' P -- provide full path including runid as one word.'/
     >         ' X/Q -- quit:  stop the program.'/
     >         ' A -- accept:  read data at given path location.')
         endif
         call uread('trxpl_path:  enter option:$')
         if(lchar('A')) then
C  quit
            return
         else if(lchar('X').or.lchar('Q')) then
C  exit program (see caller)
            tpath=' '
            return
         else if(lchar('M')) then
C  toggle mode
            imode=3-imode
         else if(lchar('F')) then
            imode=1
         else if(lchar('R')) then
C  reset path
            if(lxout(0)) write(lnout(0),*) ' enter "NONE" to suppress:'
            call ureadw('trxpl_path:  results root directory:$',rpath)
         else if(lchar('Y')) then
C  reset tok.yy
            if(lxout(0)) write(lnout(0),*) ' enter "NONE" to suppress:'
            if (imode .eq. 1) then
               call ureadw('trxpl_path:  TRANSP tok/yy:$',tokyy)
               i=index(tokyy,'.')
               if (i .gt. 0) tokyy(i:i) = '/'
            else
               call ureadw('trxpl_path:  TRANSP tok.yy:$',tokyy)
            endif
         else if(lchar('P')) then 
            call ureadw('trxpl_path: file path (end with runid):$',
     >           lpath)
            ilenl=len(trim(lpath))
            isl=0
            do ic=ilenl,1,-1
               if(lpath(ic:ic).eq.'/') then
                  isl=ic
                  exit
               endif
            enddo

            if(isl.le.1) then
               tokyy='NONE'
               runid=lpath(isl+1:ilenl)
               rpath='.'
            else
               tokyy='NONE'
               rpath=lpath(1:isl-1)
               if(isl.lt.ilenl) then
                  runid=lpath(isl+1:ilenl)
               else
                  runid='?'
               endif
            endif

         else if(lchar('D')) then
C  reset runid
            call ureadw('trxpl_path:  TRANSP runid:$',runid)
         else
C  ?? error ??
            call uermsg(' ?trxpl_path:  invalid option.',' ',0)
         endif
C
      else
C
C  MDS+ mode ****************************
C
         ils=len_trim(mds_server)
         ilt=len_trim(mds_tree)
         ild=len_trim(mds_shot)
C
         tpath=zmode(imode)//':'//mds_server(1:ils)//':'//
     >      mds_tree(1:ilt)//'('//mds_shot(1:ild)//')'
         ilt=len_trim(tpath)
C
         if(lxout(0)) then
            write(lnout(0),1002) tpath(1:ilt)
 1002       format(/
     >         ' ...path:  ',a//
     >         ' F -- select FILE mode'/
     >         ' M -- toggle btw MDS+ and FILE mode'/
     >         ' S -- set MDS+ server'/
     >         ' T -- set MDS+ tree name'/
     >         ' D -- set MDS+ shot# or tok.yy/runid combination'/
     >         ' P -- set "literal" MDS+ path'/
     >         ' X/Q -- quit:  stop the program.'/
     >         ' A -- accept:  read data at given path location.')
         endif
         call uread('trxpl_path:  enter option:$')
         if(lchar('A')) then
C  quit
            return
         else if(lchar('X').or.lchar('Q')) then
C  exit program (see caller)
            tpath=' '
            return
         else if(lchar('M')) then
C  toggle mode
            imode=3-imode
         else if(lchar('F')) then
            imode=1
         else if(lchar('S')) then
C  server
            call ureadw('trxpl_path:  MDS+ server (ip name):$',
     >         mds_server)
         else if(lchar('T')) then
C  tree name
            call ureadw('trxpl_path:  MDS+ tree name:$',
     >         mds_tree)
         else if(lchar('D')) then
C  shot / runid
            call uread('enter "S" for shot#, "D" for tok.yy/runid:$')
            if(lchar('S')) then
               ! this encoder will convert nnnnnAmm -> nnnnn01mm...

               call ureadi_nrun('trxpl_path:  MDS+ shot number:$',imds)

               ! convert integer to left justified string
               mds_shot=' '
               write(mds_shot(1:15),'(I15)') imds
               id=0
               do ic=1,15
                  if(mds_shot(ic:ic).ne.' ') then
                     id=id+1
                     mds_shot(id:id)=mds_shot(ic:ic)
                     mds_shot(ic:ic)=' '
                  endif
               enddo

            else if(lchar('D')) then
               call ureadw('trxpl_path:  TRANSP tok.yy:$',tokyy)
               call ureadw('trxpl_path:  TRANSP runid:$',runid)
               ilt=len_trim(tokyy)
               ild=len_trim(runid)
               if(index(tokyy,'.').eq.0) then
                  ! attempt automatic shot year generation
                  call yygen
                  ilt=len_trim(tokyy)
                  ild=len_trim(runid)
               endif
               mds_shot=tokyy(1:ilt)//','//runid(1:ild)
            else
               call uermsg(' ?trxpl_path:  needed "S" or "D".',' ',0)
            endif
         else if(lchar('P')) then
            call ureadL('trxpl_path:  MDS+ literal path string:$',
     >           lpath)

            istart=1
            if(lpath(1:1).eq.'"') istart=2
            icolon=index(lpath,':')
            ilparen=index(lpath,'(')
            irparen=index(lpath,')')
            ifld1 = icolon-1
            ifld2 = ilparen-icolon-1
            ifld3 = irparen-ilparen-1

            if(min(ifld1,ifld2,ifld3).le.0) then
               call uermsg(
     >              ' ?trxpl_path:  MDS+ literal path syntax error',
     >              trim(lpath),0)
            else
               mds_server = lpath(istart:icolon-1)
               mds_tree = lpath(icolon+1:ilparen-1)
               mds_shot = lpath(ilparen+1:irparen-1)
            endif

         else
C  ?? error ??
            call uermsg(' ?trxpl_path:  invalid option.',' ',0)
         endif
      endif
C
      go to 10

      CONTAINS
        subroutine yygen

          ! given tok.yy string that contains <tok> only, try to generate
          ! yy part.  Functionality available only for certain tokamaks...

          character*26 :: alphab = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
          integer :: islen,ishot,istat
          character*6 :: zshot6
          character*2 :: yy

          write(lnout(0),*) 
     >     ' %trxpl_path0(yygen): attempt auto-generation of shot year.'

          islen=0
          do ic=1,len(trim(runid))
             if(index(alphab,runid(ic:ic)).gt.0) then
                islen=ic-1
                exit
             endif
          enddo

          if((islen.ne.5).and.(islen.ne.6)) then
             call uermsg(
     >           'trxpl_path0(yygen): failed to find shot no. in runid',
     >            runid,0)
             runid='runid'
             tokyy='tok.yy'
             return
          endif

          if(islen.eq.5) then
             zshot6=' '//runid(1:5)
          else
             zshot6=runid(1:6)
          endif

          read(zshot6,'(I6)',iostat=istat) ishot
          if(istat.ne.0) then
             call uermsg(
     >           'trxpl_path0(yygen): failed to decode runid shot no.',
     >            runid,0)
             runid='runid'
             tokyy='tok.yy'
             return
          endif

          if((tokyy.eq.'TFTR').or.(tokyy.eq.'AUGD').or.
     >         (tokyy.eq.'EAST').or.(tokyy.eq.'JET').or.
     >         (tokyy.eq.'NSTX').or.(tokyy.eq.'MAST').or.
     >         (tokyy.eq.'D3D')) then

             call get_tokyr(0,0,tokyy,ishot,yy)
             if(yy.eq.' ') then
                call uermsg(
     >               'get_tokyr failed for '//tokyy,zshot,0)
                tokyy='tok.yy'
                runid='runid'
             else
                tokyy=trim(tokyy)//'.'//yy
             endif

          else
             call uermsg(
     >            'shot-year generation unavailable for tokamak',tokyy,
     >            0)
             tokyy='tok.yy'
             runid='runid'
          endif

        end subroutine yygen
      end

      subroutine trxpl_path_dtavg(prompt,ztime0,ztavg,zans)

      !  prompt for +/- delta(t) for time averaging *OR* a pre/post
      !  sawtooth hint

      implicit NONE

      character*(*), intent(in) :: prompt ! UREAD prompt string
      real*8, intent(inout) :: ztime0     ! data time (may be adjusted)
      real*8, intent(inout) :: ztavg      ! +/- averaging time
      character*1, intent(out) :: zans    ! echo back "Q" response to caller

      !--------------------------------
      ! UREAD functions:
      logical :: lxout,lchar
      integer :: lnout
      real*8 :: r8dcod

      integer :: iert
      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
      !--------------------------------

      zans=' '

      do
         if(lxout(0)) then
            write(lnout(0),*) ' "A": dt_avg=0, hint: pre-sawtooth'
            write(lnout(0),*) ' "B": dt_avg=0, hint: post-sawtooth'
            write(lnout(0),*) ' "Q": choose different time.'
         endif
         call uread('trxpl_path:  +/- averging time (.ge.0):$')
         if(lchar('Q')) then
            zans='Q'
            exit
         else if(lchar('A')) then
            ztavg=0.0d0
            call trx_chk_saw_r8(ztime0,1)
            exit
         else if(lchar('B')) then
            ztavg=0.0d0
            call trx_chk_saw_r8(ztime0,2)
            exit
         else
            ztavg=r8dcod(iert)
            if(iert.ne.0) then
               call uermsg('r8dcod error -- reprompt',' ',0)
            else
               if(ztavg.lt.0.0_R8) ztavg=0.0_R8
               if(ztavg.eq.0.0_R8) call trx_chk_saw_r8(ztime0,0)
               exit
            endif
         endif
      enddo

      return
      end
