module cesrv_init_groups

use cesrv_struct
use cesrv_interface
use bookkeeper_mod                  
 
contains

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

subroutine setup_groups (u, make_groups)

implicit none

type (universe_struct), target :: u

integer make_groups

!

select case (make_groups)
case (make_groups$)
  call init_the_groups (u)
case (reestablish_groups$)
  call reestablish_groups (u)
case (no_make_groups$)
case default
  print *, 'ERROR IN INIT_LATTICE: INTERNAL MAKE_GROUP ERROR!'
  call err_exit
end select

end subroutine

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

subroutine init_the_groups (u)

implicit none

type (universe_struct), target :: u
type (ele_struct), pointer :: ele

type (group_info_struct) :: grp
type (var_struct), pointer :: var

real(rp) dtime

integer i, j, jmax, n
integer, external :: vnumbr
integer ix0

logical ok

character(12) group_name

!

call run_timer ('START')
print *, 'Begin group setup...'

if (logic%biggrp_set == 0) then   
  print *, ' Note: BIGGRP set IS 0'
  print *, '       [Info will be taken from the DataBase]'
else
  print *, 'Initializing with BIGGRP set:', logic%biggrp_set
endif

! take out old group elements if they exist

do i = u%ring%n_ele_track+1, u%ring%n_ele_max
  if (u%ring%ele(i)%name == 'GROUP MARKER ELE') then
    u%ring%ele(i:u%ring%n_ele_max)%key = -1  ! Mark for deletion
    call remove_eles_from_lat(u%ring)
    exit
  endif
enddo

! put in marker element.

call new_control (u%ring, ix0)
ele => u%ring%ele(ix0)
ele%name = 'GROUP MARKER ELE'
ele%key = null_ele$
ele%mat6_calc_method = no_makeup$
allocate (ele%control_var(1))
ele%control_var = controller_var_struct('COMMAND', 0.0_rp, 0.0_rp)

! loop over all group nodes

do i = 1, logic%n_db_group_max

  group_name = u%db_group(i)%v1%name
  jmax = vnumbr (group_name)

  u%db_group(i)%v1%v(:)%good_user = .false.
  u%db_group(i)%v1%v(:)%exists = .false.

  ! loop over all elements in a group

  ele_loop: do j = 1, jmax
             
    call setup_group (group_name, j, logic%biggrp_set, logic%csr_set, grp, ok, .true., .true.)

    if (.not. ok .or. grp%n_node == 0) cycle
    write (u%db_group(i)%v1%v(j)%name, '(a12, i4)') group_name, j
    call db_group_to_bmad_group (grp%ing_name, grp%ing_num, &
           logic%biggrp_set, logic%csr_set, u%ring, u%db, n, ok, .true., grp)

    if (.not. ok) cycle
    call fill_in_group_info (u%db_group(i)%v1%v(j), j, n, group_name, u)

  enddo ele_loop

enddo

! Now it is safe to setup the pointers

do i = 1, logic%n_db_group_max
  do j = lbound(u%db_group(i)%v1%v, 1), ubound(u%db_group(i)%v1%v, 1)
    var => u%db_group(i)%v1%v(j)
    if (var%ix_ele < 1) cycle
    var%model => u%ring%ele(var%ix_ele)%control_var(1)%value
  enddo
enddo

call reallocate_coord (u%orb, u%ring%n_ele_max)
u%energy_var%v(1)%model => u%orb(0)%vec(6)  ! point to orbit vector

!

call run_timer ('READ', dtime)
print '(a, f8.1)', 'End group setup. dTime (sec):', dtime

end subroutine

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

subroutine reestablish_groups (u)

implicit none

type (universe_struct), target :: u

type (group_info_struct) :: grp
type (var_struct), pointer :: var

integer make_groups
integer i, j, jmax, n
integer i_mark, i1
integer, external :: vnumbr
integer ix0

logical ok

character(12) group_name
character(16) full_name
character(12) this_group_name

! see if there is a group marker element

do i = u%ring%n_ele_track+1, u%ring%n_ele_max
  if (u%ring%ele(i)%name == 'GROUP MARKER ELE') exit
enddo

if (i == u%ring%n_ele_max+1) then
  print *, 'Note: DB GROUPS NOT FOUND. MAKING NEW ONES.'
  call init_the_groups (u)
  return
endif

!

i_mark = i + 1

do i = 1, logic%n_db_group_max

  group_name = u%db_group(i)%v1%name
  jmax = vnumbr (group_name)

  u%db_group(i)%v1%v(:)%good_user = .false.
  u%db_group(i)%v1%v(:)%exists = .false.


  call convert_blanks_to_underscore (group_name, this_group_name)
  do i1 = i_mark, u%ring%n_ele_max
    if (u%ring%ele(i1)%name(1:12) == this_group_name) exit
  enddo

! loop over all elements in a group

  ele_loop: do j = 1, jmax

    write (u%db_group(i)%v1%v(j)%name, '(a12, i4)') group_name, j
    call convert_blanks_to_underscore (u%db_group(i)%v1%v(j)%name, full_name)
    do n = i1, u%ring%n_ele_max
      if (u%ring%ele(n)%name == full_name) then
        call fill_in_group_info (u%db_group(i)%v1%v(j), j, n, group_name, u)
        exit
      endif
      if (u%ring%ele(n)%name(1:12) /= this_group_name) exit
    enddo

  enddo ele_loop

enddo

end subroutine

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

subroutine fill_in_group_info (var, ix_db, ix_ele, group_name, u)

implicit none

type (var_struct) var
type (universe_struct) :: u  
integer ix_db, ix_ele
character(*) group_name

var%db_ele_name = u%ring%ele(ix_ele)%name
var%db_node_name = group_name
var%ele_name = u%ring%ele(ix_ele)%name
var%ix_db = ix_db
var%ix_ele = ix_ele
var%attrib_name = 'COMMAND'
var%ix_attrib = var_offset$ + 1
var%exists = .true.
var%good_var = .true.
var%dvar_dcu = 1
var%step = 10
var%cu_high_lim = 1e5
var%cu_low_lim  = -1e5
var%cu_zero_lim = 0

end subroutine 

end module