!
!  utility routines to write out labeled data in various ascii formats
!
!  scalars...

subroutine nbi_ascii_l_wr0(lun,zname,zdata)
  character*(*) zname
  logical zdata

  write(lun,1001) zname,zdata
 1001 format(3x,a,t15,' = ',l1)

end subroutine nbi_ascii_l_wr0

subroutine nbi_ascii_i_wr0(lun,zname,zdata)
  character*(*) zname
  integer zdata

  write(lun,1001) zname,zdata
 1001 format(3x,a,t15,' = ',i10)

end subroutine nbi_ascii_i_wr0

subroutine nbi_ascii_r_wr0(lun,zname,zdata)
  character*(*) zname
  real zdata

  write(lun,1001) zname,zdata
 1001 format(3x,a,t15,' = ',1pe13.6)

end subroutine nbi_ascii_r_wr0

subroutine nbi_ascii_d_wr0(lun,zname,zdata)
  use iso_c_binding, only: fp => c_double
  character*(*) zname
  real(fp) :: zdata

  write(lun,1001) zname,zdata
 1001 format(3x,a,t15,' = ',1pd20.13)

end subroutine nbi_ascii_d_wr0

subroutine nbi_ascii_c_wr0(lun,zname,zdata)
  character*(*) zname
  character*(*) zdata

  write(lun,1001) zname,zdata
 1001 format(3x,a,t15,' = "',a,'"')

end subroutine nbi_ascii_c_wr0


!  routine to squeeze blanks out of a label...

subroutine nbi_ascii_squeeze(str_in,str_out)
  character*(*), intent(in) :: str_in
  character*(*), intent(out) :: str_out

  str_out=' '
  j=0
  do i=1,len(str_in)
     if(str_in(i:i).ne.' ') then
        j=j+1
        if(j.le.len(str_out)) str_out(j:j)=str_in(i:i)
     endif
  enddo

end subroutine nbi_ascii_squeeze


!  1d vectors...

subroutine nbi_ascii_l_wr1(lun,zname,zdata,idim1)
  character*(*) zname
  logical zdata(idim1)

  character*30 znamc  ! blanks squeezed out
  character*78 buf
  character*1 buf1

  if(idim1.eq.0) return

  call nbi_ascii_squeeze(zname,znamc)
  buf = '   '//znamc//' = '
  ilen = len_trim(buf)

  do i=1,idim1
     write(buf1,'(l1)') zdata(i)
     call nbi_ascii_bufadd(lun,buf,ilen,buf1)
  enddo

  buf(ilen:ilen)=' '  ! delete trailing comma
  ilen=ilen-1
  write(lun,'(1x,a)') buf(1:ilen)
  write(lun,'(1x)')

end subroutine nbi_ascii_l_wr1

subroutine nbi_ascii_i_wr1(lun,zname,zdata,idim1)
  character*(*) zname
  integer zdata(idim1)

  character*30 znamc  ! blanks squeezed out
  character*78 buf
  character*10 buf1

  if(idim1.eq.0) return

  call nbi_ascii_squeeze(zname,znamc)
  buf = '   '//znamc//' = '
  ilen = len_trim(buf)

  do i=1,idim1
     write(buf1,'(i10)') zdata(i)
     call nbi_ascii_bufadd(lun,buf,ilen,buf1)
  enddo

  buf(ilen:ilen)=' '  ! delete trailing comma
  ilen=ilen-1
  write(lun,'(1x,a)') buf(1:ilen)
  write(lun,'(1x)')

end subroutine nbi_ascii_i_wr1

subroutine nbi_ascii_r_wr1(lun,zname,zdata,idim1)
  character*(*) zname
  real zdata(idim1)

  character*30 znamc  ! blanks squeezed out
  character*78 buf
  character*13 buf1

  if(idim1.eq.0) return

  call nbi_ascii_squeeze(zname,znamc)
  buf = '   '//znamc//' = '
  ilen = len_trim(buf)

  do i=1,idim1
     write(buf1,'(1pe13.6)') zdata(i)
     call nbi_ascii_bufadd(lun,buf,ilen,buf1)
  enddo

  buf(ilen:ilen)=' '  ! delete trailing comma
  ilen=ilen-1
  write(lun,'(1x,a)') buf(1:ilen)
  write(lun,'(1x)')

end subroutine nbi_ascii_r_wr1

subroutine nbi_ascii_d_wr1(lun,zname,zdata,idim1)
  use iso_c_binding, only: fp => c_double
  character*(*) zname
  real(fp) :: zdata(idim1)

  character*30 znamc  ! blanks squeezed out
  character*78 buf
  character*20 buf1

  if(idim1.eq.0) return

  call nbi_ascii_squeeze(zname,znamc)
  buf = '   '//znamc//' = '
  ilen = len_trim(buf)

  do i=1,idim1
     write(buf1,'(1pd20.13)') zdata(i)
     call nbi_ascii_bufadd(lun,buf,ilen,buf1)
  enddo

  buf(ilen:ilen)=' '  ! delete trailing comma
  ilen=ilen-1
  write(lun,'(1x,a)') buf(1:ilen)
  write(lun,'(1x)')

end subroutine nbi_ascii_d_wr1


!  if there is room add value to line buffer, otherwise write & start new
!  line buffer

subroutine nbi_ascii_bufadd(lun,buf,ilbuf,bufadd)

  integer, intent(in) :: lun    ! unit to write
  character*(*), intent(inout) :: buf   ! line buffer
  integer, intent(inout) :: ilbuf       ! amount of buffer in use
  character*(*), intent(in) :: bufadd   ! item to add

  iladd = len(bufadd)
  if(ilbuf+iladd+2.gt.len(buf)) then
     write(lun,'(1x,a)') buf(1:ilbuf)
     buf=' '
     ilbuf=11
  endif

  buf(ilbuf+1:) = ' '//bufadd//','
  ilbuf = ilbuf + iladd + 2

end subroutine nbi_ascii_bufadd


!  2d arrays

subroutine nbi_ascii_l_wr2(lun,zname,zdata,idim1,idim2)
  character*(*) zname
  logical zdata(idim1,idim2)

  character*60 zlbuf

  do i=1,idim2
     
     zlbuf=' '
     write(zlbuf,'(a,''(*,'',i10,'')'')') zname,i
     call nbi_ascii_l_wr1(lun,zlbuf,zdata(1:idim1,i),idim1)

  enddo

end subroutine nbi_ascii_l_wr2

subroutine nbi_ascii_i_wr2(lun,zname,zdata,idim1,idim2)
  character*(*) zname
  integer zdata(idim1,idim2)

  character*60 zlbuf

  do i=1,idim2
     
     zlbuf=' '
     write(zlbuf,'(a,''(*,'',i10,'')'')') zname,i
     call nbi_ascii_i_wr1(lun,zlbuf,zdata(1:idim1,i),idim1)

  enddo

end subroutine nbi_ascii_i_wr2

subroutine nbi_ascii_r_wr2(lun,zname,zdata,idim1,idim2)
  character*(*) zname
  real zdata(idim1,idim2)

  character*60 zlbuf

  do i=1,idim2
     
     zlbuf=' '
     write(zlbuf,'(a,''(*,'',i10,'')'')') zname,i
     call nbi_ascii_r_wr1(lun,zlbuf,zdata(1:idim1,i),idim1)

  enddo

end subroutine nbi_ascii_r_wr2

subroutine nbi_ascii_d_wr2(lun,zname,zdata,idim1,idim2)
  use iso_c_binding, only: fp => c_double
  character*(*) zname
  real(fp) :: zdata(idim1,idim2)

  character*60 zlbuf

  do i=1,idim2
     
     zlbuf=' '
     write(zlbuf,'(a,''(*,'',i10,'')'')') zname,i
     call nbi_ascii_d_wr1(lun,zlbuf,zdata(1:idim1,i),idim1)

  enddo

end subroutine nbi_ascii_d_wr2


!  3d arrays

subroutine nbi_ascii_l_wr3(lun,zname,zdata,idim1,idim2,idim3)
  character*(*) zname
  logical zdata(idim1,idim2,idim3)

  character*60 zlbuf

  do j=1,idim3
     do i=1,idim2
     
        zlbuf=' '
        write(zlbuf,'(a,''(*,'',i10,'','',i10,'')'')') zname,i,j
        call nbi_ascii_l_wr1(lun,zlbuf,zdata(1:idim1,i,j),idim1)

     enddo
  enddo

end subroutine nbi_ascii_l_wr3

subroutine nbi_ascii_i_wr3(lun,zname,zdata,idim1,idim2,idim3)
  character*(*) zname
  integer zdata(idim1,idim2,idim3)

  character*60 zlbuf

  do j=1,idim3
     do i=1,idim2
     
        zlbuf=' '
        write(zlbuf,'(a,''(*,'',i10,'','',i10,'')'')') zname,i,j
        call nbi_ascii_i_wr1(lun,zlbuf,zdata(1:idim1,i,j),idim1)

     enddo
  enddo

end subroutine nbi_ascii_i_wr3

subroutine nbi_ascii_r_wr3(lun,zname,zdata,idim1,idim2,idim3)
  character*(*) zname
  real zdata(idim1,idim2,idim3)

  character*60 zlbuf

  do j=1,idim3
     do i=1,idim2
     
        zlbuf=' '
        write(zlbuf,'(a,''(*,'',i10,'','',i10,'')'')') zname,i,j
        call nbi_ascii_r_wr1(lun,zlbuf,zdata(1:idim1,i,j),idim1)

     enddo
  enddo

end subroutine nbi_ascii_r_wr3

subroutine nbi_ascii_d_wr3(lun,zname,zdata,idim1,idim2,idim3)
  use iso_c_binding, only: fp => c_double
  character*(*) zname
  real(fp) :: zdata(idim1,idim2,idim3)

  character*60 zlbuf

  do j=1,idim3
     do i=1,idim2
     
        zlbuf=' '
        write(zlbuf,'(a,''(*,'',i10,'','',i10,'')'')') zname,i,j
        call nbi_ascii_d_wr1(lun,zlbuf,zdata(1:idim1,i,j),idim1)

     enddo
  enddo

end subroutine nbi_ascii_d_wr3

