module nbo_ascii_mod

  !  read/write (xplasma) profile names
  !  on read, also set integer ids with old_xplasma call

  implicit none
  public
  private :: rd_item_name, wr_item_name

  interface nbo_wr_aname
     module procedure &
          nbo_wr_aname_0d,nbo_wr_aname_1d,nbo_wr_aname_2d,nbo_wr_aname_3d
  end interface

  interface nbo_rd_aname
     module procedure &
          nbo_rd_aname_0d,nbo_rd_aname_1d,nbo_rd_aname_2d,nbo_rd_aname_3d
  end interface

contains

  subroutine nbo_wr_aname_0d(ilun,item_name,prof_name)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, intent(in) :: prof_name

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

    call wr_item_name(ilun,item_name)
    write(ilun,'(1x,a)') trim(prof_name)

  end subroutine nbo_wr_aname_0d

  subroutine nbo_wr_aname_1d(ilun,item_name,prof_name)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:), intent(in) :: prof_name

    !---------------------
    integer :: i1,n1
    !---------------------

    call wr_item_name(ilun,item_name)

    n1=size(prof_name)
    do i1=1,n1
       write(ilun,'(1x,a)') trim(prof_name(i1))
    enddo


  end subroutine nbo_wr_aname_1d

  subroutine nbo_wr_aname_2d(ilun,item_name,prof_name)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:,:), intent(in) :: prof_name

    !---------------------
    integer :: i1,i2,n1,n2
    !---------------------

    call wr_item_name(ilun,item_name)

    n1=size(prof_name,1)
    n2=size(prof_name,2)
    do i2=1,n2
       do i1=1,n1
          write(ilun,'(1x,a)') trim(prof_name(i1,i2))
       enddo
    enddo

  end subroutine nbo_wr_aname_2d

  subroutine nbo_wr_aname_3d(ilun,item_name,prof_name)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:,:,:), intent(in) :: prof_name

    !---------------------
    integer :: i1,i2,i3,n1,n2,n3
    !---------------------

    call wr_item_name(ilun,item_name)

    n1=size(prof_name,1)
    n2=size(prof_name,2)
    n3=size(prof_name,3)
    do i3=1,n3
       do i2=1,n2
          do i1=1,n1
             write(ilun,'(1x,a)') trim(prof_name(i1,i2,i3))
          enddo
       enddo
    enddo

  end subroutine nbo_wr_aname_3d

  !=============================

  subroutine nbo_rd_aname_0d(ilun,item_name,prof_name,prof_id,ierr)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, intent(out) :: prof_name
    integer, intent(out) :: prof_id
    integer, intent(out) :: ierr

    !---------------------
    integer :: icln
    !---------------------

    prof_name = ' '
    prof_id = 0

    call rd_item_name(ilun,item_name,ierr)
    if(ierr.ne.0) return

    read(ilun,'(1x,a)',iostat=ierr) prof_name
    if(ierr.ne.0) return

    icln = index(prof_name,':')
    if(icln.gt.0) ierr=1

    if((ierr.eq.0).and.(prof_name.ne.' ')) then
       call eq_gfnum(prof_name,prof_id)
    endif

  end subroutine nbo_rd_aname_0d

  subroutine nbo_rd_aname_1d(ilun,item_name,prof_name,prof_id,ierr)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:), intent(out) :: prof_name
    integer, dimension(:), intent(out) :: prof_id
    integer, intent(out) :: ierr

    !---------------------
    integer :: i1,n1
    integer :: icln
    !---------------------

    prof_name = ' '
    prof_id = 0

    call rd_item_name(ilun,item_name,ierr)
    if(ierr.ne.0) return

    n1=size(prof_name)
    do i1=1,n1
       read(ilun,'(1x,a)',iostat=ierr) prof_name(i1)
       if(ierr.ne.0) exit
       if(index(prof_name(i1),':').gt.0) then
          ierr=1
          exit
       endif
       if(prof_name(i1).ne.' ') then
          call eq_gfnum(prof_name(i1),prof_id(i1))
       endif
    enddo


  end subroutine nbo_rd_aname_1d

  subroutine nbo_rd_aname_2d(ilun,item_name,prof_name,prof_id,ierr)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:,:), intent(out) :: prof_name
    integer, dimension(:,:), intent(out) :: prof_id
    integer, intent(out) :: ierr

    !---------------------
    integer :: i1,i2,n1,n2
    integer :: icln
    !---------------------

    prof_name = ' '
    prof_id = 0

    call rd_item_name(ilun,item_name,ierr)
    if(ierr.ne.0) return

    n1=size(prof_name,1)
    n2=size(prof_name,2)
    do i2=1,n2
       do i1=1,n1
          read(ilun,'(1x,a)',iostat=ierr) prof_name(i1,i2)
          if(ierr.ne.0) exit
          if(index(prof_name(i1,i2),':').gt.0) then
             ierr=1
             exit
          endif
          if(prof_name(i1,i2).ne.' ') then
             call eq_gfnum(prof_name(i1,i2),prof_id(i1,i2))
          endif
       enddo
       if(ierr.ne.0) exit
    enddo

  end subroutine nbo_rd_aname_2d

  subroutine nbo_rd_aname_3d(ilun,item_name,prof_name,prof_id,ierr)

    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name
    character*32, dimension(:,:,:), intent(out) :: prof_name
    integer, dimension(:,:,:), intent(out) :: prof_id
    integer, intent(out) :: ierr

    !---------------------
    integer :: i1,i2,i3,n1,n2,n3
    integer :: icln
    !---------------------

    prof_name = ' '
    prof_id = 0

    call rd_item_name(ilun,item_name,ierr)
    if(ierr.ne.0) return

    n1=size(prof_name,1)
    n2=size(prof_name,2)
    n3=size(prof_name,3)
    do i3=1,n3
       do i2=1,n2
          do i1=1,n1
             read(ilun,'(1x,a)',iostat=ierr) prof_name(i1,i2,i3)
             if(ierr.ne.0) exit
             if(index(prof_name(i1,i2,i3),':').gt.0) then
                ierr=1
                exit
             endif
             if(prof_name(i1,i2,i3).ne.' ') then
                call eq_gfnum(prof_name(i1,i2,i3),prof_id(i1,i2,i3))
             endif
          enddo
          if(ierr.ne.0) exit
       enddo
       if(ierr.ne.0) exit
    enddo

  end subroutine nbo_rd_aname_3d

  !----------------------------------------
  ! private routines...

  subroutine wr_item_name(ilun,item_name)
    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name

    !---------------------
    character*32 znam_local
    !---------------------

    znam_local=item_name
    call uupper(znam_local)

    write(ilun,'(1x,a)') trim(znam_local)//':'

  end subroutine wr_item_name

  subroutine rd_item_name(ilun,item_name_exp,ierr)
    integer, intent(in) :: ilun
    character*(*), intent(in) :: item_name_exp
    integer, intent(out) :: ierr

    !---------------------
    character*32 znam_exp,znam_found
    integer :: icln
    !---------------------

    znam_exp=item_name_exp
    call uupper(znam_exp)

    read(unit=ilun,fmt='(1x,a)',iostat=ierr) znam_found
    if(ierr.ne.0) return

    icln = index(znam_found,':')
    if(icln.le.1) then
       ierr=1
    else
       znam_found(icln:icln)=' '
       icln=icln-1
       call uupper(znam_found(1:icln))
       if(znam_found.ne.znam_exp) then
          ierr=1
       endif
    endif

  end subroutine rd_item_name

end module nbo_ascii_mod
