subroutine ts_cdf_write(filename,iu,inumsc,inumpro,nzones,ierr_open)

  ! create a NetCDF version of the traditional ASCII TRANSP "time_slices"
  ! dataset

  ! the ASCII file has just been written and is open on unit (iu) --
  ! rewind to read back

  ! See: ts_write.for -- routine that writes the ASCII file.

  use netcdf
  implicit NONE

  character*(*), intent(in) :: filename   ! NetCDF filename

  integer, intent(in) :: iu               ! I/O unit number, open ASCII file

  integer, intent(in) :: inumsc           ! number of scalar values
  integer, intent(in) :: inumpro          ! number of profiles
  integer, intent(in) :: nzones           ! number of spatial pts in profiles

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

  !-----------------------------------------------
  integer :: icdf  ! open NetCDF file identifier

  !-------------
  ! header data

  character*40 tr_label   ! TRANSP run global label
  character*120 tr_path   ! TRANSP run file or MDS+ path

  real*8 :: time          ! time of time slice (s)
  real*8 :: avg_delta_t   ! averaging time +/- around (time) (s)

  !-------------
  ! trailer data

  character*40 wdate,nodename,username
  character*120 disclaimer

  !-------------
  ! labels for time data
  character*20 tunits
  character*60 tlabel,avg_tlabel

  !-------------
  ! scalar data
  character*20, dimension(:), allocatable :: snames
  real*8, dimension(:), allocatable :: svals
  character*20, dimension(:), allocatable :: sunits
  character*60, dimension(:), allocatable :: slabels

  !-------------
  ! profile data
  character*20, dimension(:), allocatable :: pnames
  real*8, dimension(:,:), allocatable :: pvals
  character*20, dimension(:), allocatable :: punits
  character*60, dimension(:), allocatable :: plabels
  integer, dimension(:), allocatable :: itypex

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

  character*150 :: linbuf,save_linbuf

  character*12 :: fdcod
  integer :: il1,il2,ilen,ii,jj,ic,icsave,istat
  integer :: ivar,itype
  integer :: idim20,idim40,idim60,idim120
  integer :: idim,idimx,idimxb

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

  !  OPEN NetCDF file

  ierr_open = 0
  istat = nf90_create(trim(filename),NF90_CLOBBER,icdf)
  if(istat.ne.NF90_NOERR) then
     write(6,*) ' ?ts_cdf_write: open failure: '//trim(filename)
     ierr_open = 3
     return
  endif

  ! OK 
  rewind(iu)

  allocate(snames(inumsc),sunits(inumsc))
  allocate(svals(inumsc),slabels(inumsc))

  allocate(pnames(inumpro),punits(inumpro),itypex(inumpro))
  allocate(pvals(nzones,inumpro),plabels(inumpro))

  tunits = 's'
  tlabel = 'selected time of TRANSP data'
  avg_tlabel='averaging delta(time) +/-'

  !--------------------------
  !  read ASCII data: HEADER

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf
  save_linbuf = linbuf

  il1 = index(linbuf,'Run') + 3
  il2 = index(linbuf,'TRREAD path')

  call fld_delim('"',il1,il2)
  tr_label = linbuf(il1:il2)

  il1 = il2 + 10
  il2 = len(trim(linbuf))

  call fld_delim('"',il1,il2)
  tr_path = linbuf(il1:il2)

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf
  il1 = index(linbuf,'=')
  il2 = index(linbuf,'averaged')
  call fld_delim(' ',il1,il2)
  call fld_decod(linbuf(il1:il2),time)

  il1 = index(linbuf,'+/-')
  il2 = index(linbuf,'second')
  call fld_delim(' ',il1,il2)
  call fld_decod(linbuf(il1:il2),avg_delta_t)

  !--------------------------
  !  read ASCII data: SCALARS

  do ii=1,inumsc
     linbuf=' '
     read(unit=iu,fmt='(A)') linbuf

     il2 = index(linbuf,'[')
     il1 = il2-14
     call fld_delim(' ',il1,il2)
     call fld_decod(linbuf(il1:il2),svals(ii))

     ic=il1
     do 
        ic=ic-1
        if(linbuf(ic:ic).eq.'=') exit
        if(ic.eq.0) exit
     enddo

     il1=1
     il2=ic
     call fld_delim(' ',il1,il2)
     if(linbuf(ic-1:ic-1).ne.' ') il2=ic  ! correction if no trailing blank
     if(linbuf(1:1).ne.' ') il1=1
     slabels(ii) = linbuf(il1:il2)

     do
        ic=ic+1
        if(ic.gt.len(linbuf)) exit
        if(linbuf(ic:ic).eq.'[') then
           il1 = ic + 1
        else if(linbuf(ic:ic).eq.']') then
           il2 = ic - 1
           exit
        endif
     enddo

     sunits(ii) = linbuf(il1:il2)

     il1 = index(linbuf,'RPLOT abrev = ')
     il1 = il1 + 14
     il2 = len(trim(linbuf))

     snames(ii) = linbuf(il1:il2)

  enddo

  !--------------------------
  !  read ASCII data: PROFILES

  ii = 0
  do 
     linbuf=' '
     read(unit=iu,fmt='(A)') linbuf
     il1 = index(linbuf,'RPLOT abrev = ')
     if(il1.le.0) cycle

     ! found one...

     ii = ii + 1

     il1 = il1 + 14
     il2 = len(trim(linbuf))

     pnames(ii) = linbuf(il1:il2)

     if(pnames(ii).eq.'X') then
        itypex(ii)=1
        punits(ii) = 'no units'
        il2 = il1-14
        il1 = 1
        call fld_delim(' ',il1,il2)
        plabels(ii)= linbuf(il1:il2)

     else if(pnames(ii).eq.'XB') then
        itypex(ii)=2
        punits(ii) = 'no units'
        il2 = il1-14
        il1 = 1
        call fld_delim(' ',il1,il2)
        plabels(ii)= linbuf(il1:il2)

     else
        ic = il1 - 15
        do 
           if(linbuf(ic:ic).eq.'@') exit
           ic = ic -1
           if(ic.eq.0) exit
        enddo

        if(linbuf(ic+1:ic+2).eq.'X ') then
           itypex(ii)=1
        else if(linbuf(ic+1:ic+2).eq.'XB') then
           itypex(ii)=2
        else
           itypex(ii)=0
           write(6,*) ' %ts_cdf_write: parse failure on line:'
           write(6,*) '  '//trim(linbuf)
           plabels(ii)=' '
           punits(ii)=' '
        endif

        if(itypex(ii).gt.0) then
           icsave=ic
           do
              ic=ic-1
              if(ic.eq.0) exit  ! some entries omit units

              if(linbuf(ic:ic).eq.']') then
                 il2=ic-1
              else if(linbuf(ic:ic).eq.'[') then
                 il1=ic+1
                 exit
              endif
           enddo
           if(ic.eq.0) then
              ! if units were omitted use prior profile's units
              punits(ii)=punits(ii-1)
              ic=icsave
              il1=ic-1
           else
              punits(ii)=linbuf(il1:il2)
           endif

           il2=il1
           il1=1
           call fld_delim(' ',il1,il2)
           if(linbuf(ic-1:ic-1).ne.' ') il2=ic  ! correction if no trailing blank
           if(linbuf(1:1).ne.' ') il1=1

           plabels(ii) = linbuf(il1:il2)
        endif

     endif

     ! parse out values

     jj = 0
     do 
        linbuf=' '
        read(unit=iu,fmt='(A)') linbuf
        ilen = len(trim(linbuf))

        il1 = 1
        do
           jj = jj + 1
           call fld_next(il1,il2)
           call fld_decod(linbuf(il1:il2),pvals(jj,ii))
           if(il2.eq.ilen) exit
           il1 = il2 + 1
        enddo
        if(jj.eq.nzones) exit
     enddo

     if(ii.eq.inumpro) exit
  enddo

  !--------------------------
  !  read ASCII data: TRAILER

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf

  il1=index(linbuf,' on ') + 4
  il2=len(trim(linbuf))

  wdate = linbuf(il1:il2)

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf

  il1=index(linbuf,' on node ') + 4
  il2=index(linbuf,' by ')
  call fld_delim(' ',il1,il2)
  nodename = linbuf(il1:il2)

  il1 = il2 + 5
  il2 = len(trim(linbuf)) + 1
  call fld_delim(' ',il1,il2)
  username = linbuf(il1:il2)

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf

  disclaimer = linbuf
  il1 = len(trim(disclaimer))

  linbuf=' '
  read(unit=iu,fmt='(A)') linbuf

  disclaimer(il1+3:) = trim(linbuf)

  !--------------------------
  ! file read complete; NetCDF definitions

  !  lengths of labels
  istat = nf90_def_dim(icdf,"char_len_20",20,idim20)
  istat = nf90_def_dim(icdf,"char_len_40",40,idim40)
  istat = nf90_def_dim(icdf,"char_len_60",60,idim60)
  istat = nf90_def_dim(icdf,"char_len_120",120,idim120)

  !  header

  itype = NF90_CHAR

  istat = nf90_def_var(icdf,'TR_label',itype,idim40,ivar)
  istat = nf90_def_var(icdf,'TR_path',itype,idim120,ivar)

  itype = NF90_DOUBLE

  istat = nf90_def_var(icdf,'time',itype,ivar)
  istat = nf90_put_att(icdf,ivar,'units',tunits)
  istat = nf90_put_att(icdf,ivar,'label',tlabel)

  istat = nf90_def_var(icdf,'avg_delta_t',itype,ivar)
  istat = nf90_put_att(icdf,ivar,'units',tunits)
  istat = nf90_put_att(icdf,ivar,'label',avg_tlabel)

  !  scalars

  itype = NF90_DOUBLE

  do ii=1,inumsc
     istat = nf90_def_var(icdf,snames(ii),itype,ivar)
     istat = nf90_put_att(icdf,ivar,'units',sunits(ii))
     istat = nf90_put_att(icdf,ivar,'label',slabels(ii))
  enddo

  ! profile data

  ! these two dimensions match but are distinguished according as data
  ! is vs. X or XB; this is also indicated by attribute

  istat = nf90_def_dim(icdf,"dim_X",nzones,idimx)
  istat = nf90_def_dim(icdf,"dim_XB",nzones,idimxb)

  !  trailer

  itype = NF90_DOUBLE

  do ii=1,inumpro
     if(itypex(ii).eq.1) then
        idim=idimx
     else
        idim=idimxb
     endif
     istat = nf90_def_var(icdf,pnames(ii),itype,idim,ivar)
     istat = nf90_put_att(icdf,ivar,'units',punits(ii))
     istat = nf90_put_att(icdf,ivar,'label',plabels(ii))
     if(itypex(ii).eq.1) then
        istat = nf90_put_att(icdf,ivar,'vs','X')
     else
        istat = nf90_put_att(icdf,ivar,'vs','XB')
     endif
  enddo

  itype = NF90_CHAR

  istat = nf90_def_var(icdf,'wdate',itype,idim40,ivar)
  istat = nf90_def_var(icdf,'nodename',itype,idim40,ivar)
  istat = nf90_def_var(icdf,'username',itype,idim40,ivar)
  istat = nf90_def_var(icdf,'Disclaimer',itype,idim120,ivar)

  !--------------------------
  ! NetCDF writes
 
  ! header data
  istat = nf90_enddef(icdf)  ! exit definition mode
 
  istat = nf90_inq_varid(icdf,"TR_label",ivar)
  istat = nf90_put_var(icdf,ivar,tr_label)
 
  istat = nf90_inq_varid(icdf,"TR_path",ivar)
  istat = nf90_put_var(icdf,ivar,tr_path)
 
  istat = nf90_inq_varid(icdf,"time",ivar)
  istat = nf90_put_var(icdf,ivar,time)
 
  istat = nf90_inq_varid(icdf,"avg_delta_t",ivar)
  istat = nf90_put_var(icdf,ivar,avg_delta_t)

  ! scalar data

  do ii=1,inumsc
     istat = nf90_inq_varid(icdf,snames(ii),ivar)
     istat = nf90_put_var(icdf,ivar,svals(ii))
  enddo

  ! profile data

  do ii=1,inumpro
     istat = nf90_inq_varid(icdf,pnames(ii),ivar)
     istat = nf90_put_var(icdf,ivar,pvals(:,ii)) 
  enddo

  ! trailer data       
  istat = nf90_inq_varid(icdf,"wdate",ivar)
  istat = nf90_put_var(icdf,ivar,wdate)
 
  istat = nf90_inq_varid(icdf,"nodename",ivar)
  istat = nf90_put_var(icdf,ivar,nodename)
 
  istat = nf90_inq_varid(icdf,"username",ivar)
  istat = nf90_put_var(icdf,ivar,username)
 
  istat = nf90_inq_varid(icdf,"Disclaimer",ivar)
  istat = nf90_put_var(icdf,ivar,disclaimer)



  !--------------------------
  ! finish up

  istat = nf90_close(icdf)

  deallocate(snames,sunits,svals,slabels)
  deallocate(pnames,punits,pvals,plabels,itypex)

CONTAINS

  subroutine fld_delim(dchar,i1,i2)

    ! linbuf(i1:i2) gives the aproximate location of the field value sought;
    ! use delimiter character (dchar) to narrow the location to the precise
    ! range covered by the data field.

    character*1, intent(in) :: dchar
    integer, intent(inout) :: i1,i2

    !------------------------
    integer :: idgot
    !------------------------

    idgot = 0
    do 
       if(idgot.eq.0) then
          if(linbuf(i1:i1).eq.dchar) then
             idgot = 1
          endif
          i1=i1+1
          cycle

       else
          if(linbuf(i1:i1).ne.dchar) then
             exit
          else
             i1=i1+1
             cycle
          endif
       endif
    enddo

    idgot = 0
    do 
       if(idgot.eq.0) then
          if(linbuf(i2:i2).eq.dchar) then
             idgot = 1
          endif
          i2=i2-1
          cycle

       else
          if(linbuf(i2:i2).ne.dchar) then
             exit
          else
             i2=i2-1
             cycle
          endif
       endif
    enddo

  end subroutine fld_delim

  subroutine fld_next(il1,il2)

    ! find next non-blank field for decoding
    ! start searching at linbuf(il1:il1)

    integer, intent(inout) :: il1  ! beginning of field, on exit
    integer, intent(out) :: il2    ! end of field

    do
       if(linbuf(il1:il1).ne.' ') exit
       il1 = il1 + 1
    enddo

    il2=il1
    do
       if(linbuf(il2+1:il2+1).eq.' ') exit
       il2=il2 + 1
    enddo

  end subroutine fld_next

  subroutine fld_decod(fstr,valr8)

    character*(*), intent(in) :: fstr
    real*8, intent(out) :: valr8

    ! decode a floating pt number, max length .le. 12 assumed

    integer :: ilenf

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

    ilenf=len(trim(fstr))

    fdcod=' '
    fdcod(12-ilenf+1:12) = fstr(1:ilenf)

    read(fdcod,'(G12.0)') valr8

  end subroutine fld_decod

end subroutine ts_cdf_write
