!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubecompute_primepower_tool
  use cubetools_parameters
  use cubetools_structure
  use cubetools_array_types
  use cubecompute_messaging
  !
  public :: primepower
  private
  !
  type, extends(inte_2d_t) :: primepower_t
     integer(kind=inte_k), private :: maxpoweroftwo = 0
   contains
     procedure, public :: init => cubecompute_primepower_init
     procedure, public :: list => cubecompute_primepower_list
  end type primepower_t
  type(primepower_t) :: primepower
  !
contains
  !
  subroutine cubecompute_primepower_init(list,maxpoweroftwo,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(primepower_t),  intent(inout) :: list
    integer(kind=inte_k), intent(in)    :: maxpoweroftwo
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ier
    integer(kind=4), allocatable :: iorder(:),work(:),mp
    integer(kind=long_k) :: maxinteger,maxpowerofthree,maxpoweroffive
    integer(kind=long_k) :: poweroftwo,poweroftwoandthree,poweroftwothreeandfive
    integer(kind=long_k), allocatable :: allpoweroftwo(:),allpowerofthree(:),allpoweroffive(:)
    integer(kind=indx_k) :: iy,ip,jp,kp,np
    character(len=*), parameter :: rname='PRIMEPOWER>INIT'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    if (primepower%maxpoweroftwo.eq.maxpoweroftwo) then
       ! Already initialized
       return
    else if (maxpoweroftwo.le.0) then
       call cubecompute_message(seve%e,rname,'Maximum power of two must be > 0!')
       error = .true.
       return
    endif
    !
    maxinteger = 2**maxpoweroftwo
    maxpowerofthree = floor(log(real(maxinteger))/log(3.0))
    maxpoweroffive  = floor(log(real(maxinteger))/log(5.0))
    !
    allocate(&
         allpoweroftwo(maxpoweroftwo+1),&
         allpowerofthree(maxpowerofthree+1),&
         allpoweroffive(maxpoweroffive+1),&
         stat=ier)
    if (failed_allocate(rname,"simple prime powers",ier,error)) return
    !
    do ip=1,maxpoweroftwo+1
       allpoweroftwo(ip) = 2**(ip-1)
    enddo ! ip
    do jp=1,maxpowerofthree+1
       allpowerofthree(jp) = 3**(jp-1)
    enddo ! jp
    do kp=1,maxpoweroffive+1
       allpoweroffive(kp) = 5**(kp-1)
    enddo ! kp
    !
    np = 0
    do ip=2,maxpoweroftwo+1
       poweroftwo = allpoweroftwo(ip)
       do jp=1,min(ip,maxpowerofthree+1)
          poweroftwoandthree = poweroftwo*allpowerofthree(jp)
          if (poweroftwoandthree.le.maxinteger) then
             do kp=1,min(ip,maxpoweroffive+1)                
                poweroftwothreeandfive = poweroftwoandthree*allpoweroffive(kp)
                if (poweroftwothreeandfive.le.maxinteger) then
                   np = np+1
                endif
             enddo ! kp
          endif
       enddo ! jp
    enddo ! ip
    !
    call list%reallocate('Prime powers',int(4,kind=indx_k),np,error)
    if (error) return
    !
    np = 0
    do ip=2,maxpoweroftwo+1
       poweroftwo = allpoweroftwo(ip)
       do jp=1,min(ip,maxpowerofthree+1)
          poweroftwoandthree = poweroftwo*allpowerofthree(jp)
          if (poweroftwoandthree.le.maxinteger) then
             do kp=1,min(ip,maxpoweroffive+1)
                poweroftwothreeandfive = poweroftwoandthree*allpoweroffive(kp)
                if (poweroftwothreeandfive.le.maxinteger) then
                   np = np+1
                   if (np.gt.list%ny) then
                      call cubecompute_message(seve%e,rname,'Inconsistent number of prime powers')
                      error = .true.
                      return
                   endif
                   list%val(1,np) = ip-1
                   list%val(2,np) = jp-1
                   list%val(3,np) = kp-1
                   list%val(4,np) = poweroftwothreeandfive
                endif
             enddo ! kp
          endif
       enddo ! jp
    enddo ! ip
    !
    mp = np
    allocate(iorder(mp),work(mp),stat=ier)
    if (failed_allocate(rname,"prime power sorting",ier,error)) return
    call gi4_trie(list%val(4,:),iorder,mp,error)
    if (error) return
    do iy=1,3
       call gi4_sort(list%val(iy,:),work,iorder,mp)
       if (error) return
    enddo ! iy
  end subroutine cubecompute_primepower_init
  !
  subroutine cubecompute_primepower_list(array,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(primepower_t), intent(in)    :: array
    logical,             intent(inout) :: error
    !
    integer(kind=indx_k) :: iy
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PRIMEPOWER>LIST'
    !
    call cubecompute_message(computeseve%trace,rname,'Welcome')
    !
    do iy=1,array%ny
       write(mess,'(a,i4,a,i2,a,i2,a,i2,a,i0)') '#',iy,': 2^',array%val(1,iy),'*3^',array%val(2,iy),&
            '*5^',array%val(3,iy),' = ',array%val(4,iy)
       call cubecompute_message(seve%r,rname,mess)
    enddo ! iy
  end subroutine cubecompute_primepower_list
end module cubecompute_primepower_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
