c------------------------------------------------------------
c  these routines write the GS2 namelist, generally by inserting
c  or replacing records at key points in a template file.
c------------------------------------------------------------
      subroutine trxpl_nlist_find(luni,lparams,lzeff,lbeta,lsknobs,
     >     lgrid,lgrd2)
c
c  find record number of key namelists in template file
c  when done, rewind the file.
c
      use trxpl_gs2_module
      implicit NONE
c
      integer, intent(in) :: luni       ! file lun
      integer, intent(out) :: lparams   ! parameters namelist (0 if not found)
      integer, intent(out) :: lzeff     ! zeff= line in parameters namelist
      integer, intent(out) :: lbeta     ! beta= line in parameters namelist
      integer, intent(out) :: lsknobs   ! species_knobs namelist or 0
      integer, intent(out) :: lgrid(4)  ! grid namelist (all 0 if not found)
c                lgrid(1), whole namelist
c                lgrid(2), irho record
c                lgrid(3), iflux record
c                lgrid(4), local_eq record

      integer, intent(out) :: lgrd2(2)  ! grd2 namelist (all 0 if not found)
c                lgrd2(1), whole namelist
c                lgrd2(2), rhoc record
c
c------------------------------------
c
      integer irec
      character*128 zline
      integer i,inb,ieqs,ilen
      character*50 ztest1,ztest2
      logical iflag                     ! .TRUE.:  seek zeff= line...
      logical jflag                     ! .TRUE.:  seek irho,iflux,local_eq...
      logical kflag                     ! .TRUE.:  seek rhoc= line...
      logical inlist                    ! .TRUE.:  inside namelist...
c
c------------------------------------
c
      iflag=.FALSE.
      jflag=.FALSE.
      kflag=.FALSE.
      inlist=.FALSE.
      irec=0
c
      lparams=0
      lzeff=0
      lbeta=0
      lsknobs=0
      lgrid=0
      lgrd2=0
c
      do
c
         read(luni,'(A)',end=99) zline
         irec=irec+1
         ilen=len_trim(zline)
c
         inb=0
         do i=1,ilen
            if((zline(i:i).ne.' ').and.(zline(i:i).ne.char(9))) then
               inb=i
               exit
            endif
         enddo
         if(inb.eq.0) cycle
c
         if(inlist) then
c
c  inside a namelist... look for end
            if(zline(inb:inb).eq.'/') then
               inlist=.FALSE.
               iflag=.FALSE.
               jflag=.FALSE.
            else
               if(iflag) then
c
c  look for zeff= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='ZEFF'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lzeff=irec      ! found the "zeff=" line
                     endif
                  endif
c
c  look for beta= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='BETA'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lbeta=irec      ! found the "zeff=" line
                     endif
                  endif
 
               else if(jflag) then
c
c  look for irho= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='IRHO'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lgrid(2)=irec ! found the "irho=" line
                     endif
                  endif
c
c  look for iflux= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='IFLUX'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lgrid(3)=irec ! found the "iflux=" line
                     endif
                  endif
c
c  look for local_eq= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='LOCAL_EQ'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lgrid(4)=irec ! found the "local_eq=" line
                     endif
                  endif
               else if(kflag) then
c
c  look for rhoc= line...
c
                  ieqs=index(zline,'=')
                  if(ieqs.gt.0) then
                     ztest1='RHOC'
                     ztest2=zline(inb:ieqs-1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lgrd2(2)=irec ! found the "rhoc=" line
                     endif
                  endif
               endif            ! iflag/jflag/kflag tests

            endif               ! "/" test
c
         else
c
c  looking for a namelist...
c
            if(zline(inb:inb).eq.'&') then
c
c  got one...
c
               inlist=.TRUE.
               i=index(zline(inb:ilen+1),' ')+inb-2
               ztest1=nlist_zeff
               ztest2=zline(inb+1:i)
               call uupper(ztest1)
               call uupper(ztest2)
               if(ztest1.eq.ztest2) then
                  lparams=irec          ! "parameters" namelist
                  iflag=.TRUE.
               else
                  ztest1=nlist_nspc
                  call uupper(ztest1)
                  if(ztest1.eq.ztest2) then
                     lsknobs=irec
                  else
                     ztest1=nlist_grid
                     call uupper(ztest1)
                     if(ztest1.eq.ztest2) then
                        lgrid(1)=irec
                        jflag=.TRUE.
                     else
                        ztest1=nlist_grd2
                        call uupper(ztest1)
                        if(ztest1.eq.ztest2) then
                           lgrd2(1)=irec
                           kflag=.TRUE.
                        endif
                     endif
                  endif
               endif
c
            endif                       ! "&" test
         endif
c
      enddo
c
 99   continue
      rewind(luni)
      return
c
      end
 
c------------------------------------------------------------
      subroutine trxpl_nlist_copy(luni,luno,lparams,lzeff,lbeta,lsknobs,
     >     lgrid,lgrd2)
c
c copy from template to output file-- pause when data needs to be inserted
c
      use trxpl_gs2_module
      implicit NONE
c
      integer luni                      ! LUN of open template file
      integer luno                      ! LUN of open namelist output file
c
      integer lparams                   ! record # of parameters namelist or 0
      integer lzeff                     ! record # of zeff= record or 0
      integer lbeta                     ! record # of beta= record or 0
      integer lsknobs                   ! record # of species_knobs nl or 0
      integer :: lgrid(4)               ! grid namelist (all 0 if not found)
c                lgrid(1), whole namelist
c                lgrid(2), irho record
c                lgrid(3), iflux record
c                lgrid(4), local_eq record
      integer :: lgrd2(2)               ! grd2 namelist (all 0 if not found)
c                lgrd2(1), whole namelist
c                lgrd2(2), rhoc record
c
c----------------------------------------------
c
      integer irec
      character*128 zline
      integer i,j,inb,ilen
      logical lskip,prev_blank
c
      character*50 ztest1,ztest2
c
c----------------------------------------------
c
      lskip=.FALSE.
      prev_blank=.FALSE.
c
      irec=0
c
      do
         read(luni,'(A)',end=99) zline
         irec=irec+1
         ilen=len_trim(zline)
c
         if(irec.eq.lgrid(2)) then
            write(luno,'(1x,a,"  !_trxpl")') irho_lbl//' 1'
            prev_blank=.FALSE.
         else if(irec.eq.lgrid(3)) then
            write(luno,'(1x,a,"  !_trxpl")') iflux_lbl//' 1'
            prev_blank=.FALSE.
         else if(irec.eq.lgrid(4)) then
            write(luno,'(1x,a,"  !_trxpl")') lqeq_lbl//' .FALSE.'
            prev_blank=.FALSE.
         else if(irec.eq.lgrd2(2)) then
            write(luno,'(1x,a,1pe19.12,"  !_trxpl")') irhoc_lbl,transp_x
            prev_blank=.FALSE.
         else if(irec.eq.lzeff) then
c  replace "zeff=" line with trxpl version; this is inside the &parameters
c  namelist
            write(luno,'(1x,a,1pe19.12,"  !_trxpl")') zeff_lbl,zeff_calc
            prev_blank=.FALSE.
            cycle
         else if(irec.eq.lbeta) then
c  replace "beta=" line with trxpl version; this is inside the &parameters
c  namelist
            write(luno,'(1x,a,1pe19.12,"  !_trxpl")') beta_lbl,beta
            prev_blank=.FALSE.
            cycle
         else if((irec.eq.lparams).and.
     >         ((lzeff.eq.0).or.(lbeta.eq.0)) ) then
            if(lzeff.eq.0) then
c  there was no "zeff=" line to replace, so, insert it here at the
c   beginning of the &parameters namelist
               write(luno,'(A)') zline(1:ilen)
               write(luno,'(1x,a,1pe19.12,"  !_trxpl")')
     >            zeff_lbl,zeff_calc
               prev_blank=.FALSE.
            endif
            if(lbeta.eq.0) then
c  there was no "beta=" line to replace, so, insert it here at the
c   beginning of the &parameters namelist
               write(luno,'(A)') zline(1:ilen)
               write(luno,'(1x,a,1pe19.12,"  !_trxpl")')
     >            beta_lbl,beta
               prev_blank=.FALSE.
            endif
            cycle
         else if(irec.eq.lsknobs) then
c  &species_knobs namelist found.
            lskip=.TRUE.
c  if there was no &parameters namelist, write one here.
c  write the &species_knobs and the &species_parameters_* namelists now
            call trxpl_nlist_write_all(luno,
     >           (lparams.eq.0),(lgrid(1).eq.0),(lgrd2(1).eq.0))
            prev_blank=.FALSE.
            cycle
c
         else
c
c  ordinary record... copy unless skip flag is set.
c  set skip flag if this is a &species_parameters_* namelist record
c  clear skip flag if this is an end-of-namelist record.
c
c  find first nonblank...
c
            inb=0
            do i=1,ilen
               if((zline(i:i).ne.' ').and.(zline(i:i).ne.char(9))) then
                  inb=i
                  exit
               endif
            enddo
c
c  inb= address of first nonblank, or, zero if the whole line is blank
c
            if(lskip) then
               if(inb.gt.0) then
                  if(zline(inb:inb).eq.'/') then
                     lskip=.FALSE.      ! clear:  end-of-namelist record.
                  endif
               endif
c
               cycle                    ! no write
c
            else
c
c  no skip flag-- will write, unless this line starts a &species_parameters
c  namelist.  So... check for namelist record
c
               if(inb.gt.0) then
                  if(zline(inb:inb).eq.'&') then
                     i=len_trim(nlist_root)
                     ztest1=nlist_root
                     ztest2=zline(inb+1:inb+i)
                     call uupper(ztest1)
                     call uupper(ztest2)
                     if(ztest1.eq.ztest2) then
                        lskip=.TRUE.    ! &species_parameter_* nl detected
                        cycle
                     endif
                  endif
               endif
c
c  fall through:  do copy the record, unless it is an old trxpl comment
c  record, or the 2nd blank record in a row...
c
               if(zline(1:8).ne.'!_trxpl:') then
                  if((inb.gt.0).or.(.not.prev_blank)) then
c
                     write(luno,'(A)') zline(1:ilen)
                     if(inb.eq.0) then
                        prev_blank=.TRUE.
                     else
                        prev_blank=.FALSE.
                     endif
c
c  write here any missing items in grid namelist
c
                     if(irec.eq.lgrid(1)) then
                        if(lgrid(2).eq.0) then
                           write(luno,'(1x,a,"  !_trxpl")') 
     >                          irho_lbl//' 1'
                        endif
                        if(lgrid(3).eq.0) then
                           write(luno,'(1x,a,"  !_trxpl")')
     >                          iflux_lbl//' 1'
                        endif
                        if(lgrid(4).eq.0) then
                           write(luno,'(1x,a,"  !_trxpl")')
     >                          lqeq_lbl//' .FALSE.'
                        endif
                     endif
c
                     if(irec.eq.lgrd2(1)) then
                        if(lgrd2(2).eq.0) then
                           write(luno,'(1x,a,1x,1pe19.12,"  !_trxpl")')
     >                          irhoc_lbl,transp_x
                        endif
                     endif
c
                  endif
               endif
               cycle
            endif
c
         endif                          ! record count match tests
      enddo
c
c  EOF
c
 99   continue
c
c  write data here, if necessary...
c
      if(lsknobs.eq.0) then
         call trxpl_nlist_write_all(luno,(lparams.eq.0),(lgrid(1).eq.0),
     >        (lgrd2(1).eq.0))
      endif
c
c  do not close files: this is done by caller
c
      return
      end
c------------------------------------------------------------------
      subroutine trxpl_nlist_write_all(luno,iflag,jflag,kflag)
c
c  write the GS2 namelist fragment
c
      use trxpl_gs2_module
      implicit NONE
c
      integer luno                      ! LUN where to write
      logical iflag                     ! .TRUE. to write &parameters namelist
c                                       ! ... with "zeff= ..." record
      logical jflag                     ! .TRUE. to write &theta_grid_eik_knobs
c                                       ! namelist with irho, iflux, local_eq
      logical kflag             ! .TRUE. to write &theta_grid_parameters
c                               ! namelist with "rhoc= ..." record
c-----------------------------
c
      integer i,j
c
c-----------------------------
      if(iflag) then
         i=len_trim(nlist_zeff)
         write(luno,1005) nlist_zeff(1:i),zeff_lbl,zeff_calc,
     >        beta_lbl,beta
      endif
c
 1005 format(/
     >     '&',a/
     >     1x,a,1pe19.12,'  !_trxpl'/
     >     1x,a,1pe19.12,'  !_trxpl'/
     >     '/')
c
      if(jflag) then
         write(luno,1006) trim(nlist_grid),irho_lbl//' 1',
     >        iflux_lbl//' 1',lqeq_lbl//' .FALSE.'
      endif
c
 1006 format(/
     >     '&',a/
     >     1x,a,'  !_trxpl'/
     >     1x,a,'  !_trxpl'/
     >     1x,a,'  !_trxpl'/
     >     '/')
c
      if(kflag) then
         write(luno,1007) trim(nlist_grd2),irhoc_lbl,transp_x
      endif
c
 1007 format(/
     >     '&',a/
     >     1x,a,1pe19.12,'  !_trxpl'/
     >     '/')
c
      i=len_trim(nlist_nspc)
      write(luno,1011) nlist_nspc(1:i),num_lbl,num_species
 1011 format(/
     >   '&',a/1x,a,i6,'  !_trxpl'/'/')
c
      do j=1,num_species
         call trxpl_mkgs2_write1(luno,j)
      enddo
c
      return
      end
