module nbi_bcastbuf
  use iso_c_binding, only: fp => c_double

  implicit none
  private :: fp
  save

  integer, parameter :: csize=150
  integer :: nmax_idata = 0
  integer :: nmax_rdata = 0
  integer :: nmax_cdata = 0
  integer :: nmax_ldata = 0
  integer :: ni_data = 0
  integer :: nr_data = 0
  integer :: nc_data = 0
  integer :: nl_data = 0
  real(fp), dimension(:), allocatable :: bufr8
  integer, dimension(:), allocatable :: bufint
  character(len=csize), dimension(:), allocatable :: bufchr
  logical, dimension(:), allocatable :: buflgc

  private :: bufr8_expand,bufint_expand,bufchr_expand,buflgc_expand

  interface putdat
     module procedure putr8_0d,putr8_1d,putr8_2d,putr8_3d,putr8_4d,putr8_5d,      &
                      putint_0d,putint_1d,putint_2d,putint_3d,putint_4d, &
                      putchr_0d,putchr_1d,putlgc_0d,putlgc_1d
  end interface

  interface getdat
     module procedure getr8_0d,getr8_1d,getr8_2d,getr8_3d,getr8_4d,getr8_5d,      &
                      getint_0d,getint_1d,getint_2d,getint_3d,getint_4d, &
                      getchr_0d,getchr_1d,getlgc_0d,getlgc_1d
  end interface

  contains
    subroutine bufr8_expand(ineed)
      integer, intent(in) :: ineed  ! minimum allocation

      real(fp), dimension(:), allocatable :: bufr8_tmp
      integer :: inew

      if(nr_data.gt.0) then
         allocate(bufr8_tmp(nr_data)); bufr8_tmp = bufr8(1:nr_data)
      endif
      if(allocated(bufr8)) deallocate(bufr8)

      inew=max(100000,ineed,2*nmax_rdata)
      nmax_rdata=inew
      allocate(bufr8(nmax_rdata))

      if(nr_data.gt.0) then
         bufr8(1:nr_data)=bufr8_tmp
         deallocate(bufr8_tmp)
      endif
    end subroutine bufr8_expand

    subroutine putr8_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp) :: zdata

      integer :: ineed

!     ineed=nr_data+1
      ineed=iadr+1
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      iadr=iadr+1
      bufr8(iadr)=zdata
      nr_data=iadr
    end subroutine putr8_0d

    subroutine getr8_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp) :: zdata

      iadr=iadr+1
      zdata=bufr8(iadr)
    end subroutine getr8_0d

    subroutine putr8_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:) :: zdata

      integer :: isize,ineed,i1

      isize=size(zdata)
      ineed=nr_data+isize
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      do i1=1,isize
         iadr=iadr+1
         bufr8(iadr)=zdata(i1)
      enddo
      nr_data=iadr
    end subroutine putr8_1d

    subroutine getr8_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:) :: zdata

      integer :: isize,i1

      isize=size(zdata)

      do i1=1,isize
         iadr=iadr+1
         zdata(i1)=bufr8(iadr)
      enddo
    end subroutine getr8_1d

    subroutine putr8_2d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:) :: zdata

      integer :: isize,ineed,i1,i2,isizes(2)

      isize=1
      do i1=1,2
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=nr_data+isize
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      do i2=1,isizes(2)
         do i1=1,isizes(1)
            iadr=iadr+1
            bufr8(iadr)=zdata(i1,i2)
         enddo
      enddo
      nr_data=iadr
    end subroutine putr8_2d

    subroutine getr8_2d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:) :: zdata

      integer :: i1,i2,isizes(2)

      do i1=1,2
         isizes(i1)=size(zdata,i1)
      enddo

      do i2=1,isizes(2)
         do i1=1,isizes(1)
            iadr=iadr+1
            zdata(i1,i2)=bufr8(iadr)
         enddo
      enddo
    end subroutine getr8_2d

    subroutine putr8_3d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:) :: zdata

      integer :: isize,ineed,i1,i2,i3,isizes(3)

      isize=1
      do i1=1,3
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=nr_data+isize
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      do i3=1,isizes(3)
         do i2=1,isizes(2)
            do i1=1,isizes(1)
               iadr=iadr+1
               bufr8(iadr)=zdata(i1,i2,i3)
            enddo
         enddo
      enddo
      nr_data=iadr
    end subroutine putr8_3d

    subroutine getr8_3d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:) :: zdata

      integer :: i1,i2,i3,isizes(3)

      do i1=1,3
         isizes(i1)=size(zdata,i1)
      enddo

      do i3=1,isizes(3)
         do i2=1,isizes(2)
            do i1=1,isizes(1)
               iadr=iadr+1
               zdata(i1,i2,i3)=bufr8(iadr)
            enddo
         enddo
      enddo
    end subroutine getr8_3d

    subroutine putr8_4d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:,:) :: zdata

      integer :: isize,ineed,i1,i2,i3,i4,isizes(4)

      isize=1
      do i1=1,4
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=nr_data+isize
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      do i4=1,isizes(4)
         do i3=1,isizes(3)
            do i2=1,isizes(2)
               do i1=1,isizes(1)
                  iadr=iadr+1
                  bufr8(iadr)=zdata(i1,i2,i3,i4)
               enddo
            enddo
         enddo
      enddo
      nr_data=iadr
    end subroutine putr8_4d

    subroutine getr8_4d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:,:) :: zdata

      integer :: i1,i2,i3,i4,isizes(4)

      do i1=1,4
         isizes(i1)=size(zdata,i1)
      enddo

      do i4=1,isizes(4)
         do i3=1,isizes(3)
            do i2=1,isizes(2)
               do i1=1,isizes(1)
                  iadr=iadr+1
                  zdata(i1,i2,i3,i4)=bufr8(iadr)
               enddo
            enddo
         enddo
      enddo
    end subroutine getr8_4d

    subroutine putr8_5d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:,:,:) :: zdata

      integer :: isize,ineed,i1,i2,i3,i4,i5,isizes(5)

      isize=1
      do i1=1,5
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=nr_data+isize
      if(ineed.gt.nmax_rdata) call bufr8_expand(ineed)

      do i5=1,isizes(5)
         do i4=1,isizes(4)
            do i3=1,isizes(3)
               do i2=1,isizes(2)
                  do i1=1,isizes(1)
                     iadr=iadr+1
                     bufr8(iadr)=zdata(i1,i2,i3,i4,i5)
                  enddo
               enddo
            enddo
         enddo
      enddo
      nr_data=iadr
    end subroutine putr8_5d

    subroutine getr8_5d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      real(fp), dimension(:,:,:,:,:) :: zdata

      integer :: i1,i2,i3,i4,i5,isizes(5)

      do i1=1,5
         isizes(i1)=size(zdata,i1)
      enddo

      do i5=1,isizes(5)
         do i4=1,isizes(4)
            do i3=1,isizes(3)
               do i2=1,isizes(2)
                  do i1=1,isizes(1)
                     iadr=iadr+1
                     zdata(i1,i2,i3,i4,i5)=bufr8(iadr)
                  enddo
               enddo
            enddo
         enddo
      enddo
    end subroutine getr8_5d

! ---------------------------------------
!   handle integer data
! -----------------------------------------

    subroutine bufint_expand(ineed)
      integer, intent(in) :: ineed  ! minimum allocation

      integer, dimension(:), allocatable :: bufint_tmp
      integer :: inew

      if(ni_data.gt.0) then
         allocate(bufint_tmp(ni_data)); bufint_tmp = bufint(1:ni_data)
      endif
      if(allocated(bufint)) deallocate(bufint)

      inew=max(100000,ineed,2*nmax_idata)
      nmax_idata=inew
      allocate(bufint(nmax_idata))

      if(ni_data.gt.0) then
         bufint(1:ni_data)=bufint_tmp
         deallocate(bufint_tmp)
      endif
    end subroutine bufint_expand

    subroutine putint_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer :: zdata

      integer :: ineed

      ineed=ni_data+1
      if(ineed.gt.nmax_idata) call bufint_expand(ineed)

      iadr=iadr+1
      bufint(iadr)=zdata
      ni_data=iadr
    end subroutine putint_0d

    subroutine getint_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer :: zdata

      iadr=iadr+1
      zdata=bufint(iadr)
    end subroutine getint_0d

    subroutine putint_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:) :: zdata

      integer :: isize,ineed,i1

      isize=size(zdata)
      ineed=ni_data+isize
      if(ineed.gt.nmax_idata) call bufint_expand(ineed)

      do i1=1,isize
         iadr=iadr+1
         bufint(iadr)=zdata(i1)
      enddo
      ni_data=iadr
    end subroutine putint_1d

    subroutine getint_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:) :: zdata

      integer :: isize,i1

      isize=size(zdata)

      do i1=1,isize
         iadr=iadr+1
         zdata(i1)=bufint(iadr)
      enddo
    end subroutine getint_1d

    subroutine putint_2d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:) :: zdata

      integer :: isize,ineed,i1,i2,isizes(2)

      isize=1
      do i1=1,2
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=ni_data+isize
      if(ineed.gt.nmax_idata) call bufint_expand(ineed)

      do i2=1,isizes(2)
         do i1=1,isizes(1)
            iadr=iadr+1
            bufint(iadr)=zdata(i1,i2)
         enddo
      enddo
      ni_data=iadr
    end subroutine putint_2d

    subroutine getint_2d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:) :: zdata

      integer :: i1,i2,isizes(2)

      do i1=1,2
         isizes(i1)=size(zdata,i1)
      enddo

      do i2=1,isizes(2)
         do i1=1,isizes(1)
            iadr=iadr+1
            zdata(i1,i2)=bufint(iadr)
         enddo
      enddo
    end subroutine getint_2d

    subroutine putint_3d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:,:) :: zdata

      integer :: isize,ineed,i1,i2,i3,isizes(3)

      isize=1
      do i1=1,3
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=ni_data+isize
      if(ineed.gt.nmax_idata) call bufint_expand(ineed)

      do i3=1,isizes(3)
         do i2=1,isizes(2)
            do i1=1,isizes(1)
               iadr=iadr+1
               bufint(iadr)=zdata(i1,i2,i3)
            enddo
         enddo
      enddo
      ni_data=iadr
    end subroutine putint_3d

    subroutine getint_3d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:,:) :: zdata

      integer :: i1,i2,i3,isizes(3)

      do i1=1,3
         isizes(i1)=size(zdata,i1)
      enddo

      do i3=1,isizes(3)
         do i2=1,isizes(2)
            do i1=1,isizes(1)
               iadr=iadr+1
               zdata(i1,i2,i3)=bufint(iadr)
            enddo
         enddo
      enddo
    end subroutine getint_3d

    subroutine putint_4d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:,:,:) :: zdata

      integer :: isize,ineed,i1,i2,i3,i4,isizes(4)

      isize=1
      do i1=1,4
         isizes(i1)=size(zdata,i1)
         isize=isize*isizes(i1)
      enddo
      ineed=ni_data+isize
      if(ineed.gt.nmax_idata) call bufint_expand(ineed)

      do i4=1,isizes(4)
         do i3=1,isizes(3)
            do i2=1,isizes(2)
               do i1=1,isizes(1)
                  iadr=iadr+1
                  bufint(iadr)=zdata(i1,i2,i3,i4)
               enddo
            enddo
         enddo
      enddo
      ni_data=iadr
    end subroutine putint_4d

    subroutine getint_4d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      integer, dimension(:,:,:,:) :: zdata

      integer :: i1,i2,i3,i4,isizes(4)

      do i1=1,4
         isizes(i1)=size(zdata,i1)
      enddo

      do i4=1,isizes(4)
         do i3=1,isizes(3)
            do i2=1,isizes(2)
               do i1=1,isizes(1)
                  iadr=iadr+1
                  zdata(i1,i2,i3,i4)=bufint(iadr)
               enddo
            enddo
         enddo
      enddo
    end subroutine getint_4d

! ---------------------------------------
!   handle character data
! -----------------------------------------

    subroutine bufchr_expand(ineed)
      integer, intent(in) :: ineed  ! minimum allocation

      character(len=csize), dimension(:), allocatable :: bufchr_tmp
      integer :: inew

      if(nc_data.gt.0) then
         allocate(bufchr_tmp(nc_data))
         bufchr_tmp(1:nc_data) = bufchr(1:nc_data)
      endif
      if(allocated(bufchr)) deallocate(bufchr)

      inew=max(500,ineed,2*nmax_cdata)
      nmax_cdata=inew
      allocate(bufchr(nmax_cdata))

      if(nc_data.gt.0) then
         bufchr(1:nc_data)=bufchr_tmp(1:nc_data)
         deallocate(bufchr_tmp)
      endif
    end subroutine bufchr_expand

    subroutine putchr_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      character(len=*) :: zdata

      integer :: ineed

      
      ineed=nc_data+1
      if(ineed.gt.nmax_cdata) call bufchr_expand(ineed)

      iadr=iadr+1
      bufchr(iadr)=zdata
      nc_data=iadr

    end subroutine putchr_0d

    subroutine getchr_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      character(len=*) :: zdata 


      iadr=iadr+1
      zdata=trim(bufchr(iadr))
    end subroutine getchr_0d

    subroutine putchr_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      character(len=*), dimension(:) :: zdata 

      integer :: isize,ineed,i1

      isize=size(zdata)
      ineed=nc_data+isize
      if(ineed.gt.nmax_cdata) call bufchr_expand(ineed)

      do i1=1,isize
         iadr=iadr+1
         bufchr(iadr)=zdata(i1)
      enddo
      nc_data=iadr
    end subroutine putchr_1d

    subroutine getchr_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      character(len=*), dimension(:) :: zdata 

      integer :: isize,i1

      isize=size(zdata)

      do i1=1,isize
         iadr=iadr+1
         zdata(i1)=bufchr(iadr)
      enddo
    end subroutine getchr_1d

! ---------------------------------------
!   handle logical data
! -----------------------------------------

    subroutine buflgc_expand(ineed)
      integer, intent(in) :: ineed  ! minimum allocation

      logical, dimension(:), allocatable :: buflgc_tmp
      integer :: inew

      if(nl_data.gt.0) then
         allocate(buflgc_tmp(nl_data)); buflgc_tmp = buflgc(1:nl_data)
      endif
      if(allocated(buflgc)) deallocate(buflgc)

      inew=max(100000,ineed,2*nmax_ldata)
      nmax_ldata=inew
      allocate(buflgc(nmax_ldata))

      if(nl_data.gt.0) then
         buflgc(1:nl_data)=buflgc_tmp
         deallocate(buflgc_tmp)
      endif
    end subroutine buflgc_expand

    subroutine putlgc_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      logical :: zdata

      integer :: ineed

      ineed=nl_data+1
      if(ineed.gt.nmax_ldata) call buflgc_expand(ineed)

      iadr=iadr+1
      buflgc(iadr)=zdata
      nl_data=iadr
    end subroutine putlgc_0d

    subroutine getlgc_0d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      logical :: zdata 

      iadr=iadr+1
      zdata=buflgc(iadr)
    end subroutine getlgc_0d

    subroutine putlgc_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      logical, dimension(:) :: zdata

      integer :: isize,ineed,i1

      isize=size(zdata)
      ineed=nl_data+isize
      if(ineed.gt.nmax_ldata) call buflgc_expand(ineed)

      do i1=1,isize
         iadr=iadr+1
         buflgc(iadr)=zdata(i1)
      enddo
      nl_data=iadr
    end subroutine putlgc_1d

    subroutine getlgc_1d(zdata,iadr)
      integer, intent(inout) :: iadr  ! address last used
      logical, dimension(:) :: zdata

      integer :: isize,i1

      isize=size(zdata)

      do i1=1,isize
         iadr=iadr+1
         zdata(i1)=buflgc(iadr)
      enddo
    end subroutine getlgc_1d

end module nbi_bcastbuf
