<commit_before>module packdat

  implicit none

  ! COMMONS SCALARS

  ! Number of current items
  integer :: nItems
  ! Current container's dimensions
  real(8) :: cLength, cWidth
  ! Current container's id
  integer :: cId

  ! PRIVATE PARAMETERS

  ! Configuration file: containers' dimensions
  character(80), parameter :: c_filename = 'containers.txt'
  ! Configuration file: items' dimensions
  character(80), parameter :: i_filename = 'items.txt'
  ! Statistics information file
  character(80), parameter :: stats_filename = 'stats.csv'

  ! PRIVATE SCALARS

  ! Number of containers
  integer :: nContainers
  ! Current container
  integer :: currContainer
  ! Total number of items
  integer :: nTItems
  ! Total number of types of items
  integer :: nTypes
  ! Total number of boxes used
  integer :: nTContainers
  ! Active items
  integer :: iini, iend

  ! PRIVATE ARRAYS

  ! Falta colocar ponteiros para o tipo e o numero!

  ! Container's type
  integer, allocatable :: cType(:)
  !Container's id
  integer, allocatable :: cId_(:)
  ! Container's dimensions
  real(8), target, allocatable :: cLength_(:)
  real(8), target, allocatable :: cWidth_(:)
  ! Item's type
  integer, pointer :: iType(:) => NULL()
  integer, target, allocatable :: iType_(:)
  ! Item's number
  integer, pointer :: iNumber(:) => NULL()
  integer, target, allocatable :: iNumber_(:)
  ! Item's dimensions
  real(8), target, allocatable :: iLength_(:)
  real(8), target, allocatable :: iWidth_(:)
  !Item's Id
  integer, target, allocatable :: iId_(:)
  ! Maximum number of items in the largest Container
  integer, allocatable :: maxItems(:)
  ! Type of container for each type of item
  integer, allocatable :: contType(:)

  ! Types of containers used
  integer, allocatable :: cTypeUsed_(:)
  ! Index to the items in the container
  integer, allocatable :: cStartEnd_(:)

  ! COMMON ARRAYS

  ! Pointer to current item's dimensions
  real(8), pointer :: iLength(:) => NULL(), iWidth(:) => NULL()

  ! Pointer Id for containers and items
  ! TODO: check if iId must be public
  integer, pointer :: iId(:) => NULL()
  
  private

  public :: iLength, iWidth, cLength, cWidth, nItems, nTItems,    &
            nContainers, evalover, evaldover, setCurrContainer,   &
            initialpoint, loadData, drawSol, extractBoxes,        &
            removeAppendedBox, appendBox, removeBoxes, sortItems, &
            reduction, printStats, remainingItems, resetPacking,  &
            saveSol, reset, cId, iId, sortContainers, &
            getAvContainers

contains

! ******************************************************************
! ******************************************************************

  subroutine resetPacking()

    ! This subroutine cancels the current packing and allows a whole
    ! new packing to start using the available items.

    call removeItems(0)

  end subroutine resetPacking

! ******************************************************************
! ******************************************************************

  function remainingItems()

    ! This function return the number of remaining items to be packed.

    implicit none

    ! RETURN
    integer :: remainingItems

    remainingItems = nTItems - iend

  end function remainingItems

! ******************************************************************
! ******************************************************************

  subroutine printStats(elapsedTime)

    ! This subroutine prints final statistics on the screen and also
    ! in an output file.

    implicit none

    ! SCALAR ARGUMENTS
    real(kind=8), intent(in) :: elapsedTime

    ! LOCAL SCALARS
    integer :: i, c
    real(8) :: tiArea, tbArea

    tiArea = 0.0D0
    
    do i = 1, nTItems

       tiArea = tiArea + iWidth_(i) * iLength_(i)

    end do

    c = 0.0D0
    
    do i = 1, nTContainers

       c = cTypeUsed_(i)

       tbArea = tbArea + cWidth_(c) * cLength_(c)

    end do

    write(*,FMT=0080) nTContainers, nTItems, tbArea,  &
         tiArea, (tbArea / tiArea - 1.0D0) * 100.0D0, &
         elapsedTime * 1.0D+02

    ! Save STATS in file

    open(99, FILE=stats_filename)
    
    write(99, FMT=0090) nTContainers, nTItems, tbArea, &
         tiArea, (tbArea / tiArea - 1.0D0) * 100.0D0,  &
         elapsedTime * 1.0D+02

    close(99)

0080 FORMAT(/, /, 'FINAL INFORMATION', /, 17('-'), /, /, &
          'Number of containers:', 35X, I4,/             &
          'Number of items:', 37X, I7,/                  &
          'Total area:', 39X, F10.2, /                   &
          'Total item area:', 34X, F10.2, /,             &
          'Waste ratio (%):', 34X, F10.2, /,             &
          'Elapsed time (in ms):', 19X, F20.6)
0090 FORMAT(I7, ',', I7, ',', F10.2, ',', F10.2, ',', &
          F20.4, ',', F20.6)

  end subroutine printStats

! ******************************************************************
! ******************************************************************

  function evalover(x, i, j)

    ! Evaluates the overlapping between item i and j

    implicit none

    ! SCALAR ARGUMENTS
    integer :: i, j

    ! ARRAY ARGUMENTS
    real(8) :: x(:)

    ! OUTPUT
    real(8) :: evalover

    intent(in) :: i, j, x

    ! LOCAL SCALARS
    integer :: pi, pj

    pi = 2 * (i - 1) + 1

    pj = 2 * (j - 1) + 1

    evalover = max(0.0D0, x(pj    ) + iLength(j) - x(pi    )) * &
               max(0.0D0, x(pi    ) + iLength(i) - x(pj    )) * &
               max(0.0D0, x(pj + 1) + iWidth(j)  - x(pi + 1)) * &
               max(0.0D0, x(pi + 1) + iWidth(i)  - x(pj + 1))

    evalover = evalover ** 2.0D0
    
    return

  end function evalover

! ******************************************************************
! ******************************************************************

  subroutine evaldover(x, i, j, g)

    ! Evaluates the derivatives of the overlapping function between
    ! item i and j

    implicit none

    ! SCALAR ARGUMENTS
    integer :: i, j

    ! ARRAY ARGUMENTS
    real(8) :: g(:), x(:)

    intent(in ) :: i, j, x
    intent(out) :: g

    ! LOCAL SCALARS
    integer :: pi, pj
    real(8) :: t, t1, t2, t3, t4

    pi = 2 * (i - 1) + 1

    pj = 2 * (j - 1) + 1

    t1 = max(0.0D0, x(pj    ) + iLength(j) - x(pi    ))

    t2 = max(0.0D0, x(pi    ) + iLength(i) - x(pj    ))

    t3 = max(0.0D0, x(pj + 1) + iWidth(j)  - x(pi + 1))

    t4 = max(0.0D0, x(pi + 1) + iWidth(i)  - x(pj + 1))


    t = - 2.0D0 * t1 * (t2 * t3 * t4) ** 2.0D0 &
        + 2.0D0 * t2 * (t1 * t3 * t4) ** 2.0D0 

    g(pi    ) = g(pi    ) + t

    g(pj    ) = g(pj    ) - t
                

    t = - 2.0D0 * t3 * (t1 * t2 * t4) ** 2.0D0 &
        + 2.0D0 * t4 * (t1 * t2 * t3) ** 2.0D0

    g(pi + 1) = g(pi + 1) + t

    g(pj + 1) = g(pj + 1) - t
    
  end subroutine evaldover
  
! ******************************************************************
! ******************************************************************

  subroutine setCurrContainer(c)

    ! This subroutine sets the current container and exports its
    ! dimensions

    ! SCALAR ARGUMENTS
    integer, intent(in) :: c

    if ( c .le. 0 .or. c .gt. nContainers ) then

       write(*,*) 'Wrong container number'

       stop

    end if

    currContainer = c

    cWidth = cWidth_(c)

    cLength = cLength_(c)

    cId = cId_(c)

  end subroutine setCurrContainer

! ******************************************************************
! ******************************************************************

  subroutine reduction(numberOfSolutions, csvoutput)

    ! This subroutine applies the reduction heuristic. It uses the
    ! values given by vector 'maxItems' to quickly eliminates items of
    ! the same type.

    ! TODO: It is a good idea to identify when different items have
    ! the same sizes.

    implicit none

    ! SCALAR ARGUMENTS
    character(80), intent(in) :: csvoutput
    integer, intent(out) :: numberOfSolutions

    ! LOCAL SCALARS
    integer :: c, qot, curr_item, i, tmpIt
    character(80) :: filename

    ! LOCAL ARRAYS
    real(8) :: x(2 * nItems)

    numberOfSolutions = 1

    do curr_item = 1,4

       ! Count the number of items

       c = 0

       do i = 1, nItems

          if ( iType(i) .eq. curr_item ) c = c + 1

       end do

       ! Calculate the number of containers
       
       qot = INT(c / maxitems(curr_item))
       
       ! Com 'gordura'
       ! qot = qot - 1 ! It can be negative

       c = 0

       do i = 1, nItems

          if ( iType(i) .eq. curr_item ) then

             if ( c .gt. qot * maxitems(curr_item) ) exit

             c = c + 1

             call swap(x, iWidth, iLength, iType, iNumber,iId, i, c)

          end if

       end do

       ! Draw pattern

       write(*,*) 'Eliminating', max(0, qot) * maxitems(curr_item), 'items of ', &
            'type', curr_item, 'in', max(0, qot), 'containers of type',          &
            conttype(curr_item), '.'

       do i = 1, qot

          write(filename, FMT="('sol',I0.3,'.asy')") numberOfSolutions

          call drawPattern(filename, maxitems(curr_item), iWidth(1), &
                           iLength(1), conttype(curr_item))

          cTypeUsed_(numberOfSolutions) = conttype(curr_item)

          ! TODO: improve saveSol

          tmpIt = nItems
          
          nItems = maxitems(curr_item)
       
          call saveSol(csvoutput)

          nItems = tmpIt

          numberOfSolutions = numberOfSolutions + 1

       end do

       ! Update the number of containers

       nTContainers = numberOfSolutions - 1

       ! Remove items

       if ( qot .gt. 0 ) call removeItems(qot * maxitems(curr_item))

    end do

  end subroutine reduction

! ******************************************************************
! ******************************************************************

  subroutine drawPattern(filename, nit, itwid, itlen, container)

    ! This subroutine draws a pre-optimized pattern for the given item
    ! type. This pattern was found by the heuristic procedure of
    ! subroutine 'reduction'. It is an easy way to set up the current
    ! solution data and call subroutine 'drawSol'.
    !
    ! filename: the output filename
    !
    ! nit: number of items of the current type
    !
    ! itwid: item's width
    !
    ! itlen: item's length
    !
    ! container: type of the container onto which the items will be
    !            packed

    implicit none

    ! SCALAR ARGUMENTS
    integer :: nit, container
    real(8) :: itwid, itlen
    character(80) :: filename

    intent(in) :: nit, container, itwid, itlen, filename

    ! LOCAL ARRAYS
    real(8) :: x(2 * nit)

    ! LOCAL SCALARS
    integer :: i, prevNItems
    real(8) :: dx, dy

    call setCurrContainer(container)

    dx = 0.0D0

    dy = 0.0D0

    do i = 1, nit

       if ( dy + itwid .gt. cWidth ) then 

          dx = dx + itlen

          dy = 0.0D0

       end if

       x(2 * (i - 1) + 1) = dx
       
       x(2 * i) = dy

       dy = dy + itwid

    end do

    prevNItems = nItems

    nItems = nit
    
    call drawSol(x, filename, .false.)

    nItems = prevNItems

  end subroutine drawPattern
  
! ******************************************************************
! ******************************************************************

  subroutine sortItems(x)

    ! This subroutine sort items in ascending form according to their
    ! area.

    implicit none

    ! ARRAY ARGUMENTS
    real(8), intent(inout) :: x(:)

    ! LOCAL SCALARS
    integer :: i, j, min_j,k
    real(8) :: curr_area, min_area    
    !I tried change the priority
!!$    do k=nContainers,1,-1
!!$    
    do i = 1, nItems - 1

!!$       		if ( iId(i) .eq. cId_(k)) then
!!$
       min_area = iWidth(i) * iLength(i)

       min_j    = i
       
       do j = i + 1, nItems

          curr_area = iWidth(j) * iLength(j)

          if ( (iId(j) .lt. iId(min_j)) .or. &
               ((iId(j) .eq. iId(min_j)) .and. &
                (curr_area .le. min_area)) ) then

             min_area = curr_area

             min_j    = j

          end if

       end do

       if ( min_j .ne. i ) then
          
          call swap(x, iWidth, iLength, iType, iNumber, iId, i, min_j)

       end if
!!$
!!$	       end if

    end do

!!$    end do
!!$
  end subroutine sortItems

! ******************************************************************
! ******************************************************************

  subroutine initialpoint(x, s, strip)

    ! This subroutine sets up an random initial position of the items,
    ! in order to solve a non-linear programming problem.
    !
    ! x: On output, it contains the position of the items to be
    !    packed
    !
    ! s: the seed to be used to call the random intrinsic functions
    !
    ! strip: if '.true.', the problem of minimizing a strip is
    !        considered, which means that the last position of vector
    !        'x' is the length of the strip and also has to be
    !        randomly initialized.

    implicit none

    ! SCALAR ARGUMENTS
    integer, intent(in ) :: s
    logical, intent(in ) :: strip

    ! ARRAY ARGUMENTS
    real(8), intent(out) :: x(:)

    ! LOCAL SCALARS
    integer :: i, j, nseed, itmp, ri
    real(8) :: rnumber, cl, maxd, dx, dy

    ! LOCAL ARRAYS
    integer, allocatable :: seed(:), ritems(:)

    ! Initialize the random structure

    call random_seed(SIZE=nseed)

    allocate(seed(nseed), ritems(nItems))

    do i = 1,nseed
       seed(i) = s
    end do

    call random_seed(PUT=seed)

    deallocate(seed)

    ! Select the items with the largest area first.  If a random
    ! initial point is wanted, then comment this procedure and
    ! uncomment the random procedure below.

    do i = 1, nItems

       rItems(i) = nItems - (i - 1)

    end do

!!$    ! Randomly select the order of the items
!!$
!!$    do i = 1, nItems
!!$
!!$       call random_number(rnumber)
!!$
!!$       ri = i + INT((nItems - i) * rnumber)
!!$
!!$       itmp = rItems(i)
!!$
!!$       rItems(i) = rItems(ri)
!!$
!!$       rItems(ri) = itmp
!!$
!!$    end do

    ! Allocate items in random order with low overlapping

    dy = 0.0D0

    dx = 0.0D0

    maxd = 0.0D0

    do i = 1, nItems

       j = rItems(i)

       if ( dy + iWidth(j) .gt. cWidth ) then 

          call random_number(rnumber)

          dx = dx + maxd

          dy = 0.0D0

          maxd = 0.0D0

       end if

       x(2 * (j - 1) + 1) = dx
       
       x(2 * j) = dy

       call random_number(rnumber)

       dy = dy + iWidth(j)

       maxd = max(maxd, iLength(j))

    end do

    if ( strip ) x(2 * nItems + 1) = dx + maxd

    deallocate(ritems)

  end subroutine initialpoint

! ******************************************************************
! ******************************************************************

  subroutine setMaxItems(itemType, itemId, itemL, itemW)

    ! This subroutine calculates the maximum number of items of type
    ! 'itemType' that can be packed onto the largest available
    ! container. It automatically initializes internal vectors
    ! 'maxItems' and 'contType'.

    implicit none

    ! SCALAR ARGUMENTS
    integer, intent(in) :: itemType, itemId
    real(kind=8), intent(in) :: itemL, itemW

    ! LOCAL ARRAYS
    integer :: lC(nContainers)
    
    ! LOCAL SCALARS
    integer :: c, i, maxW, maxL

    do i = 1, nContainers
       
       lC(i) = i
       
    end do

    call sortContainers(nContainers, lC)

    do i = nContainers, 1, -1

       c = lC(i)
       
       if ( itemId .le. cId_(c) ) then
       
          maxW = INT(cWidth_(c) / itemW)

          maxL = INT(cLength_(c) / itemL)
    
          maxItems(itemType) = maxW * maxL

          contType(itemType) = c

          exit

       end if

    end do

  end subroutine setMaxItems

! ******************************************************************
! ******************************************************************

  subroutine loadData(filename)

    ! This subroutine loads the problem's data and initializes all the
    ! structure of the packing problem.
    !
    ! filename: the name of the data file, which contains the number
    !           of each type of item to be packed

    implicit none

    ! LOCAL SCALARS
    integer :: i, t, iprev, k
    character(80) :: filename

    ! LOCAL ARRAYS
    integer, allocatable :: types(:),tId(:), tcl(:)
    real(8), allocatable :: tW(:), tL(:)

    ! Container data

    open(99, FILE=c_filename)

    read(99, *) nContainers

    allocate(clength_(nContainers), cWidth_(nContainers), cId_(nContainers), &
             tcl(nContainers))

    do i = 1, nContainers

       read(99, *) cLength_(i), cWidth_(i), cId_(i)

       tcl(i) = i

    end do

    close(99)

!!$    ! Sort containers according to our rules.
!!$    !
!!$    !I don't know if this is a good idea. It can save some
!!$    ! computation, but should be discussed.
!!$    
!!$    call sortContainers(nContainers, tcl)
!!$
!!$    do i = 1, nContainers
!!$
!!$       if (tcl(i) .eq. i) continue
!!$
!!$       call dswap(cLength_, i, tcl(i))
!!$
!!$       call dswap(cWidth_, i, tcl(i))
!!$
!!$       call iswap(cId_, i, tcl(i))
!!$
!!$       ! Since each position of 'tcl' is the position (AND identifier)
!!$       ! of a container, when the container moves, due a swap, we have
!!$       ! to change its index in 'tcl'. This should be done just here, because
!!$       ! we are changing the real container's properties.
!!$       do k = i + 1, nContainers
!!$
!!$          if (tcl(k) .eq. i) then
!!$
!!$             tcl(k) = tcl(i)
!!$
!!$             exit
!!$
!!$          end if             
!!$
!!$       end do         
!!$
!!$    end do
    
    currContainer = 1
    
    ! Item data

    open(99, FILE=i_filename)

    read(99, *) nTypes

    ! TODO: test allocation error
    allocate(types(nTypes), tL(nTypes), tW(nTypes), maxItems(nTypes), &
             contType(nTypes), tId(nTypes))

    ! Load items sizes and initializes the maximum number of items in
    ! the largest container
    ! We inserted the iId input here. Note that the weight option 
    ! was excluded

    do t = 1, nTypes

       read(99, *) tL(t), tW(t), tId(t)

       call setMaxItems(t, tId(t), tL(t), tW(t))

    end do

    close(99)

    ! Read the number of items

    open(99, FILE=filename)

    nTItems = 0

    do t = 1, nTypes<commit_msg>setMaxItems is now public and does not modify global states.<commit_after>module packdat

  implicit none

  ! COMMONS SCALARS

  ! Number of current items
  integer :: nItems
  ! Current container's dimensions
  real(8) :: cLength, cWidth
  ! Current container's id
  integer :: cId

  ! PRIVATE PARAMETERS

  ! Configuration file: containers' dimensions
  character(80), parameter :: c_filename = 'containers.txt'
  ! Configuration file: items' dimensions
  character(80), parameter :: i_filename = 'items.txt'
  ! Statistics information file
  character(80), parameter :: stats_filename = 'stats.csv'

  ! PRIVATE SCALARS

  ! Number of containers
  integer :: nContainers
  ! Current container
  integer :: currContainer
  ! Total number of items
  integer :: nTItems
  ! Total number of types of items
  integer :: nTypes
  ! Total number of boxes used
  integer :: nTContainers
  ! Active items
  integer :: iini, iend

  ! PRIVATE ARRAYS

  ! Falta colocar ponteiros para o tipo e o numero!

  ! Container's type
  integer, allocatable :: cType(:)
  !Container's id
  integer, allocatable :: cId_(:)
  ! Container's dimensions
  real(8), target, allocatable :: cLength_(:)
  real(8), target, allocatable :: cWidth_(:)
  ! Item's type
  integer, pointer :: iType(:) => NULL()
  integer, target, allocatable :: iType_(:)
  ! Item's number
  integer, pointer :: iNumber(:) => NULL()
  integer, target, allocatable :: iNumber_(:)
  ! Item's dimensions
  real(8), target, allocatable :: iLength_(:)
  real(8), target, allocatable :: iWidth_(:)
  !Item's Id
  integer, target, allocatable :: iId_(:)
  ! Maximum number of items in the largest Container
  integer, allocatable :: maxItems(:)
  ! Type of container for each type of item
  integer, allocatable :: contType(:)

  ! Types of containers used
  integer, allocatable :: cTypeUsed_(:)
  ! Index to the items in the container
  integer, allocatable :: cStartEnd_(:)

  ! COMMON ARRAYS

  ! Pointer to current item's dimensions
  real(8), pointer :: iLength(:) => NULL(), iWidth(:) => NULL()

  ! Pointer Id for containers and items
  ! TODO: check if iId must be public
  integer, pointer :: iId(:) => NULL()
  
  private

  public :: iLength, iWidth, cLength, cWidth, nItems, nTItems,    &
            nContainers, evalover, evaldover, setCurrContainer,   &
            initialpoint, loadData, drawSol, extractBoxes,        &
            removeAppendedBox, appendBox, removeBoxes, sortItems, &
            reduction, printStats, remainingItems, resetPacking,  &
            saveSol, reset, cId, iId, sortContainers, &
            getAvContainers, setMaxItems_

contains

! ******************************************************************
! ******************************************************************

  subroutine resetPacking()

    ! This subroutine cancels the current packing and allows a whole
    ! new packing to start using the available items.

    call removeItems(0)

  end subroutine resetPacking

! ******************************************************************
! ******************************************************************

  function remainingItems()

    ! This function return the number of remaining items to be packed.

    implicit none

    ! RETURN
    integer :: remainingItems

    remainingItems = nTItems - iend

  end function remainingItems

! ******************************************************************
! ******************************************************************

  subroutine printStats(elapsedTime)

    ! This subroutine prints final statistics on the screen and also
    ! in an output file.

    implicit none

    ! SCALAR ARGUMENTS
    real(kind=8), intent(in) :: elapsedTime

    ! LOCAL SCALARS
    integer :: i, c
    real(8) :: tiArea, tbArea

    tiArea = 0.0D0
    
    do i = 1, nTItems

       tiArea = tiArea + iWidth_(i) * iLength_(i)

    end do

    c = 0.0D0
    
    do i = 1, nTContainers

       c = cTypeUsed_(i)

       tbArea = tbArea + cWidth_(c) * cLength_(c)

    end do

    write(*,FMT=0080) nTContainers, nTItems, tbArea,  &
         tiArea, (tbArea / tiArea - 1.0D0) * 100.0D0, &
         elapsedTime * 1.0D+02

    ! Save STATS in file

    open(99, FILE=stats_filename)
    
    write(99, FMT=0090) nTContainers, nTItems, tbArea, &
         tiArea, (tbArea / tiArea - 1.0D0) * 100.0D0,  &
         elapsedTime * 1.0D+02

    close(99)

0080 FORMAT(/, /, 'FINAL INFORMATION', /, 17('-'), /, /, &
          'Number of containers:', 35X, I4,/             &
          'Number of items:', 37X, I7,/                  &
          'Total area:', 39X, F10.2, /                   &
          'Total item area:', 34X, F10.2, /,             &
          'Waste ratio (%):', 34X, F10.2, /,             &
          'Elapsed time (in ms):', 19X, F20.6)
0090 FORMAT(I7, ',', I7, ',', F10.2, ',', F10.2, ',', &
          F20.4, ',', F20.6)

  end subroutine printStats

! ******************************************************************
! ******************************************************************

  function evalover(x, i, j)

    ! Evaluates the overlapping between item i and j

    implicit none

    ! SCALAR ARGUMENTS
    integer :: i, j

    ! ARRAY ARGUMENTS
    real(8) :: x(:)

    ! OUTPUT
    real(8) :: evalover

    intent(in) :: i, j, x

    ! LOCAL SCALARS
    integer :: pi, pj

    pi = 2 * (i - 1) + 1

    pj = 2 * (j - 1) + 1

    evalover = max(0.0D0, x(pj    ) + iLength(j) - x(pi    )) * &
               max(0.0D0, x(pi    ) + iLength(i) - x(pj    )) * &
               max(0.0D0, x(pj + 1) + iWidth(j)  - x(pi + 1)) * &
               max(0.0D0, x(pi + 1) + iWidth(i)  - x(pj + 1))

    evalover = evalover ** 2.0D0
    
    return

  end function evalover

! ******************************************************************
! ******************************************************************

  subroutine evaldover(x, i, j, g)

    ! Evaluates the derivatives of the overlapping function between
    ! item i and j

    implicit none

    ! SCALAR ARGUMENTS
    integer :: i, j

    ! ARRAY ARGUMENTS
    real(8) :: g(:), x(:)

    intent(in ) :: i, j, x
    intent(out) :: g

    ! LOCAL SCALARS
    integer :: pi, pj
    real(8) :: t, t1, t2, t3, t4

    pi = 2 * (i - 1) + 1

    pj = 2 * (j - 1) + 1

    t1 = max(0.0D0, x(pj    ) + iLength(j) - x(pi    ))

    t2 = max(0.0D0, x(pi    ) + iLength(i) - x(pj    ))

    t3 = max(0.0D0, x(pj + 1) + iWidth(j)  - x(pi + 1))

    t4 = max(0.0D0, x(pi + 1) + iWidth(i)  - x(pj + 1))


    t = - 2.0D0 * t1 * (t2 * t3 * t4) ** 2.0D0 &
        + 2.0D0 * t2 * (t1 * t3 * t4) ** 2.0D0 

    g(pi    ) = g(pi    ) + t

    g(pj    ) = g(pj    ) - t
                

    t = - 2.0D0 * t3 * (t1 * t2 * t4) ** 2.0D0 &
        + 2.0D0 * t4 * (t1 * t2 * t3) ** 2.0D0

    g(pi + 1) = g(pi + 1) + t

    g(pj + 1) = g(pj + 1) - t
    
  end subroutine evaldover
  
! ******************************************************************
! ******************************************************************

  subroutine setCurrContainer(c)

    ! This subroutine sets the current container and exports its
    ! dimensions

    ! SCALAR ARGUMENTS
    integer, intent(in) :: c

    if ( c .le. 0 .or. c .gt. nContainers ) then

       write(*,*) 'Wrong container number'

       stop

    end if

    currContainer = c

    cWidth = cWidth_(c)

    cLength = cLength_(c)

    cId = cId_(c)

  end subroutine setCurrContainer

! ******************************************************************
! ******************************************************************

  subroutine reduction(numberOfSolutions, csvoutput)

    ! This subroutine applies the reduction heuristic. It uses the
    ! values given by vector 'maxItems' to quickly eliminates items of
    ! the same type.

    ! TODO: It is a good idea to identify when different items have
    ! the same sizes.

    implicit none

    ! SCALAR ARGUMENTS
    character(80), intent(in) :: csvoutput
    integer, intent(out) :: numberOfSolutions

    ! LOCAL SCALARS
    integer :: c, qot, curr_item, i, tmpIt
    character(80) :: filename

    ! LOCAL ARRAYS
    real(8) :: x(2 * nItems)

    numberOfSolutions = 1

    do curr_item = 1,4

       ! Count the number of items

       c = 0

       do i = 1, nItems

          if ( iType(i) .eq. curr_item ) c = c + 1

       end do

       ! Calculate the number of containers
       
       qot = INT(c / maxitems(curr_item))
       
       ! Com 'gordura'
       ! qot = qot - 1 ! It can be negative

       c = 0

       do i = 1, nItems

          if ( iType(i) .eq. curr_item ) then

             if ( c .gt. qot * maxitems(curr_item) ) exit

             c = c + 1

             call swap(x, iWidth, iLength, iType, iNumber,iId, i, c)

          end if

       end do

       ! Draw pattern

       write(*,*) 'Eliminating', max(0, qot) * maxitems(curr_item), 'items of ', &
            'type', curr_item, 'in', max(0, qot), 'containers of type',          &
            conttype(curr_item), '.'

       do i = 1, qot

          write(filename, FMT="('sol',I0.3,'.asy')") numberOfSolutions

          call drawPattern(filename, maxitems(curr_item), iWidth(1), &
                           iLength(1), conttype(curr_item))

          cTypeUsed_(numberOfSolutions) = conttype(curr_item)

          ! TODO: improve saveSol

          tmpIt = nItems
          
          nItems = maxitems(curr_item)
       
          call saveSol(csvoutput)

          nItems = tmpIt

          numberOfSolutions = numberOfSolutions + 1

       end do

       ! Update the number of containers

       nTContainers = numberOfSolutions - 1

       ! Remove items

       if ( qot .gt. 0 ) call removeItems(qot * maxitems(curr_item))

    end do

  end subroutine reduction

! ******************************************************************
! ******************************************************************

  subroutine drawPattern(filename, nit, itwid, itlen, container)

    ! This subroutine draws a pre-optimized pattern for the given item
    ! type. This pattern was found by the heuristic procedure of
    ! subroutine 'reduction'. It is an easy way to set up the current
    ! solution data and call subroutine 'drawSol'.
    !
    ! filename: the output filename
    !
    ! nit: number of items of the current type
    !
    ! itwid: item's width
    !
    ! itlen: item's length
    !
    ! container: type of the container onto which the items will be
    !            packed

    implicit none

    ! SCALAR ARGUMENTS
    integer :: nit, container
    real(8) :: itwid, itlen
    character(80) :: filename

    intent(in) :: nit, container, itwid, itlen, filename

    ! LOCAL ARRAYS
    real(8) :: x(2 * nit)

    ! LOCAL SCALARS
    integer :: i, prevNItems
    real(8) :: dx, dy

    call setCurrContainer(container)

    dx = 0.0D0

    dy = 0.0D0

    do i = 1, nit

       if ( dy + itwid .gt. cWidth ) then 

          dx = dx + itlen

          dy = 0.0D0

       end if

       x(2 * (i - 1) + 1) = dx
       
       x(2 * i) = dy

       dy = dy + itwid

    end do

    prevNItems = nItems

    nItems = nit
    
    call drawSol(x, filename, .false.)

    nItems = prevNItems

  end subroutine drawPattern
  
! ******************************************************************
! ******************************************************************

  subroutine sortItems(x)

    ! This subroutine sort items in ascending form according to their
    ! area.

    implicit none

    ! ARRAY ARGUMENTS
    real(8), intent(inout) :: x(:)

    ! LOCAL SCALARS
    integer :: i, j, min_j,k
    real(8) :: curr_area, min_area    
    !I tried change the priority
!!$    do k=nContainers,1,-1
!!$    
    do i = 1, nItems - 1

!!$       		if ( iId(i) .eq. cId_(k)) then
!!$
       min_area = iWidth(i) * iLength(i)

       min_j    = i
       
       do j = i + 1, nItems

          curr_area = iWidth(j) * iLength(j)

          if ( (iId(j) .lt. iId(min_j)) .or. &
               ((iId(j) .eq. iId(min_j)) .and. &
                (curr_area .le. min_area)) ) then

             min_area = curr_area

             min_j    = j

          end if

       end do

       if ( min_j .ne. i ) then
          
          call swap(x, iWidth, iLength, iType, iNumber, iId, i, min_j)

       end if
!!$
!!$	       end if

    end do

!!$    end do
!!$
  end subroutine sortItems

! ******************************************************************
! ******************************************************************

  subroutine initialpoint(x, s, strip)

    ! This subroutine sets up an random initial position of the items,
    ! in order to solve a non-linear programming problem.
    !
    ! x: On output, it contains the position of the items to be
    !    packed
    !
    ! s: the seed to be used to call the random intrinsic functions
    !
    ! strip: if '.true.', the problem of minimizing a strip is
    !        considered, which means that the last position of vector
    !        'x' is the length of the strip and also has to be
    !        randomly initialized.

    implicit none

    ! SCALAR ARGUMENTS
    integer, intent(in ) :: s
    logical, intent(in ) :: strip

    ! ARRAY ARGUMENTS
    real(8), intent(out) :: x(:)

    ! LOCAL SCALARS
    integer :: i, j, nseed, itmp, ri
    real(8) :: rnumber, cl, maxd, dx, dy

    ! LOCAL ARRAYS
    integer, allocatable :: seed(:), ritems(:)

    ! Initialize the random structure

    call random_seed(SIZE=nseed)

    allocate(seed(nseed), ritems(nItems))

    do i = 1,nseed
       seed(i) = s
    end do

    call random_seed(PUT=seed)

    deallocate(seed)

    ! Select the items with the largest area first.  If a random
    ! initial point is wanted, then comment this procedure and
    ! uncomment the random procedure below.

    do i = 1, nItems

       rItems(i) = nItems - (i - 1)

    end do

!!$    ! Randomly select the order of the items
!!$
!!$    do i = 1, nItems
!!$
!!$       call random_number(rnumber)
!!$
!!$       ri = i + INT((nItems - i) * rnumber)
!!$
!!$       itmp = rItems(i)
!!$
!!$       rItems(i) = rItems(ri)
!!$
!!$       rItems(ri) = itmp
!!$
!!$    end do

    ! Allocate items in random order with low overlapping

    dy = 0.0D0

    dx = 0.0D0

    maxd = 0.0D0

    do i = 1, nItems

       j = rItems(i)

       if ( dy + iWidth(j) .gt. cWidth ) then 

          call random_number(rnumber)

          dx = dx + maxd

          dy = 0.0D0

          maxd = 0.0D0

       end if

       x(2 * (j - 1) + 1) = dx
       
       x(2 * j) = dy

       call random_number(rnumber)

       dy = dy + iWidth(j)

       maxd = max(maxd, iLength(j))

    end do

    if ( strip ) x(2 * nItems + 1) = dx + maxd

    deallocate(ritems)

  end subroutine initialpoint

! ******************************************************************
! ******************************************************************

  subroutine setMaxItems_(itemType, itemId, itemL, itemW, c, nItms)

    ! This subroutine calculates the maximum number of items of type
    ! 'itemType' that can be packed onto the largest available
    ! container. It automatically initializes internal vectors
    ! 'maxItems' and 'contType'.

    implicit none

    ! SCALAR ARGUMENTS
    integer :: itemType, itemId, c, nItms
    real(kind=8) :: itemL, itemW

    intent(in ) :: itemType, itemId, itemL, itemW
    intent(out) :: c, nItms

    ! LOCAL ARRAYS
    integer :: lC(nContainers)
    
    ! LOCAL SCALARS
    integer :: i, maxW, maxL

    do i = 1, nContainers
       
       lC(i) = i
       
    end do

    call sortContainers(nContainers, lC)

    do i = nContainers, 1, -1

       c = lC(i)
       
       if ( itemId .le. cId_(c) ) then
       
          maxW = INT(cWidth_(c) / itemW)

          maxL = INT(cLength_(c) / itemL)
    
          nItms = maxW * maxL

          exit

       end if

    end do

  end subroutine setMaxItems_

! ******************************************************************
! ******************************************************************

  subroutine loadData(filename)

    ! This subroutine loads the problem's data and initializes all the
    ! structure of the packing problem.
    !
    ! filename: the name of the data file, which contains the number
    !           of each type of item to be packed

    implicit none

    ! LOCAL SCALARS
    integer :: i, t, iprev, k
    character(80) :: filename

    ! LOCAL ARRAYS
    integer, allocatable :: types(:),tId(:), tcl(:)
    real(8), allocatable :: tW(:), tL(:)

    ! Container data

    open(99, FILE=c_filename)

    read(99, *) nContainers

    allocate(clength_(nContainers), cWidth_(nContainers), cId_(nContainers), &
             tcl(nContainers))

    do i = 1, nContainers

       read(99, *) cLength_(i), cWidth_(i), cId_(i)

       tcl(i) = i

    end do

    close(99)

!!$    ! Sort containers according to our rules.
!!$    !
!!$    !I don't know if this is a good idea. It can save some
!!$    ! computation, but should be discussed.
!!$    
!!$    call sortContainers(nContainers, tcl)
!!$
!!$    do i = 1, nContainers
!!$
!!$       if (tcl(i) .eq. i) continue
!!$
!!$       call dswap(cLength_, i, tcl(i))
!!$
!!$       call dswap(cWidth_, i, tcl(i))
!!$
!!$       call iswap(cId_, i, tcl(i))
!!$
!!$       ! Since each position of 'tcl' is the position (AND identifier)
!!$       ! of a container, when the container moves, due a swap, we have
!!$       ! to change its index in 'tcl'. This should be done just here, because
!!$       ! we are changing the real container's properties.
!!$       do k = i + 1, nContainers
!!$
!!$          if (tcl(k) .eq. i) then
!!$
!!$             tcl(k) = tcl(i)
!!$
!!$             exit
!!$
!!$          end if             
!!$
!!$       end do         
!!$
!!$    end do
    
    currContainer = 1
    
    ! Item data

    open(99, FILE=i_filename)

    read(99, *) nTypes

    ! TODO: test allocation error
    allocate(types(nTypes), tL(nTypes), tW(nTypes), maxItems(nTypes), &
             contType(nTypes), tId(nTypes))

    ! Load items sizes and initializes the maximum number of items in
    ! the largest container
    ! We inserted the iId input here. Note that the weight option 
    ! was excluded

    do t = 1, nTypes

       read(99, *) tL(t), tW(t), tId(t)

       call setMaxItems_(t, tId(t), tL(t), tW(t), &
                         contType(t), maxItems(t))

    end do

    close(99)

    ! Read the number of items

    open(99, FILE=filename)

    nTItems = 0

    do t = 1, nTypes
{'fraction_non_alphanumeric': 0.19242211163998268, 'fraction_numerical': 0.017741237559498052, 'mean_word_length': 2.297690181039864, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7406516', 'n_tokens_mistral': 12710, 'n_tokens_neox': 11678, 'n_words': 3548}