!-----------------------------------------------------------------
!
!  This file is (or was) part of SPLASH, a visualisation tool
!  for Smoothed Particle Hydrodynamics written by Daniel Price:
!
!  http://users.monash.edu.au/~dprice/splash
!
!  SPLASH comes with ABSOLUTELY NO WARRANTY.
!  This is free software; and you are welcome to redistribute
!  it under the terms of the GNU General Public License
!  (see LICENSE file for details) and the provision that
!  this notice remains intact. If you modify this file, please
!  note section 2a) of the GPLv2 states that:
!
!  a) You must cause the modified files to carry prominent notices
!     stating that you changed the files and the date of any change.
!
!  Copyright (C) 2005-2012 Daniel Price. All rights reserved.
!  Contact: daniel.price@monash.edu
!
!-----------------------------------------------------------------

module mem_allocation
 implicit none

contains
!----------------------------------------------------------------------------
!
!  memory allocation/reallocation for main data arrays
!
!  the global parameters maxpart, maxstep and maxcol are set to
!  the dimensions allocated
!
!----------------------------------------------------------------------------
subroutine alloc(npartin,nstep,ncolumnsin,mixedtypes)
 use particle_data
 implicit none
 integer, intent(in) :: npartin,nstep,ncolumnsin
 logical, intent(in), optional :: mixedtypes
 integer :: maxpartold,maxstepold,maxcolold
 integer :: ierr,ncolumns
 logical :: reallocate,reallocate_part,reallocate_step,reallocate_itype
 integer, dimension(:), allocatable :: icolourmetemp
 integer(kind=int1), dimension(:,:), allocatable :: iamtypetemp
 integer, dimension(:,:), allocatable :: npartoftypetemp
 real, dimension(:,:), allocatable :: masstypetemp
 real, dimension(:), allocatable :: timetemp, gammatemp
 real, dimension(:,:,:), allocatable :: dattemp
 real, dimension(:,:), allocatable :: headervalstemp
!
!--check for errors in input
!
 if (npartin <= 0) then
    print*,'allocate: error in input, npartin = ',npartin
    return
 endif
 if (nstep <= 0) then
    print*,'allocate: error in input, nstep = ',nstep
    return
 endif
 if (ncolumnsin < 0) then
    print*,'allocate: error in input, ncolumns = ',ncolumnsin
    return
 elseif (ncolumnsin==0) then
    print*,'WARNING: allocate: ncolumns = 0 in input'
 endif
 !--do nothing if array sizes are the same
 if (npartin==maxpart .and. ncolumnsin==maxcol .and. nstep==maxstep) then
    return
 endif
!
!--save array sizes
!
 if (npartin < maxpart) print "(a)",' WARNING: # particles < previous in allocate'
 if (nstep < maxstep) print "(a)",' WARNING: # steps < previous in allocate'
!--at the moment ncolumns cannot be decreased (due to calc_quantities)
 if (ncolumnsin < maxcol) then
    ncolumns = maxcol
    !!print "(a)",' WARNING: # columns < previous in allocate'
 else
    ncolumns = ncolumnsin
 endif

 maxpartold = min(maxpart,npartin)
 maxstepold = min(maxstep,nstep)
 maxcolold = min(maxcol,ncolumns)

 reallocate = .false.
 reallocate_part = .false.
 reallocate_step = .false.
 reallocate_itype = .false.
!
!--if re-allocating, copy arrays to temporary versions
!
 ierr = 0
 if (allocated(dat)) then
    reallocate = .true.
    if (maxpart /= npartin) reallocate_part = .true.
    if (maxstep /= nstep) reallocate_step = .true.

    if (npartin > 1000000) print 10,'> reallocating memory:',npartin,nstep,ncolumns
10  format (a,' parts = ',i10,' steps = ',i6,' cols = ',i4)
    allocate(dattemp(maxpartold,maxcolold,maxstepold), stat=ierr)
    if (ierr /= 0) stop 'error allocating memory (dattemp)'

    if (reallocate_part) then
       allocate(icolourmetemp(maxpartold),stat=ierr)
       if (ierr /= 0) stop 'error allocating memory (icolourmetemp)'
       icolourmetemp(1:maxpartold) = icolourme(1:maxpartold)
       deallocate(icolourme)
    endif

    dattemp = dat
    deallocate(dat)

    if (allocated(iamtype)) then ! should always be true
       !--if iamtype has meaningful contents and reallocation is necessary
       reallocate_itype = (reallocate_part .or. reallocate_step) .and. (size(iamtype(:,1))==maxpartold)
       if (reallocate_itype) then
          allocate(iamtypetemp(maxpartold,maxstepold), stat=ierr)
          if (ierr /= 0) stop 'error allocating memory (iamtypetemp)'
          iamtypetemp(1:maxpartold,1:maxstepold) = iamtype(1:maxpartold,1:maxstepold)
          deallocate(iamtype)

       elseif (present(mixedtypes)) then
          !--if iamtype has size 1 or 0 but should be allocated here,
          !  deallocate so we can give it correct size
          if (mixedtypes .and. size(iamtype(:,1)) < maxpart) deallocate(iamtype)
       endif
    endif

    if (reallocate_step) then
       allocate(npartoftypetemp(maxparttypes,maxstep),stat=ierr)
       if (ierr /= 0) stop 'error allocating memory (npartoftypetemp)'
       npartoftypetemp = npartoftype
       deallocate(npartoftype)

       allocate(masstypetemp(maxparttypes,maxstep),stat=ierr)
       if (ierr /= 0) stop 'error allocating memory (npartoftypetemp)'
       masstypetemp = masstype
       deallocate(masstype)

       allocate(timetemp(maxstep),gammatemp(maxstep),stat=ierr)
       if (ierr /= 0) stop 'error allocating memory (timetemp,gammatemp)'
       timetemp = time
       gammatemp = gamma
       deallocate(time,gamma)

       allocate(headervalstemp(maxhdr,maxstep))
       if (ierr /= 0) stop 'error allocating memory (hdrvalstemp)'
       headervalstemp = headervals
    endif

 else
    if (npartin > 1000000) print 10,'> allocating memory:',npartin,nstep,ncolumns
    maxpart = npartin
    maxstep = nstep
    maxcol = ncolumns
 endif


 maxpart = npartin
 maxstep = nstep
 maxcol = ncolumns

!
!--main data array
!
 allocate(dat(maxpart,maxcol,maxstep), stat=ierr)
 if (ierr /= 0) then
    print*,' parts = ',maxpart,' columns = ',maxcol,' steps = ',maxstep
    stop 'error allocating memory for dat array'
 endif

 if (reallocate) then
    dat(1:maxpartold,1:maxcolold,1:maxstepold) = dattemp(1:maxpartold,1:maxcolold,1:maxstepold)
    deallocate(dattemp)
 else
    dat = 0.
 endif
!
!--type array if necessary
!
 if (present(mixedtypes)) then
    if (mixedtypes .and. .not.allocated(iamtype)) then
       allocate(iamtype(maxpart,maxstep), stat=ierr)
       if (ierr /= 0) stop 'error allocating memory for type array'
       iamtype = 1
       !--copy contents if reallocating
       if (reallocate_itype) then
          iamtype(1:maxpartold,1:maxstepold) = iamtypetemp(1:maxpartold,1:maxstepold)
          deallocate(iamtypetemp)
       endif
    elseif (.not.mixedtypes) then
       !--if called with mixedtypes explictly false, deallocate itype array
       if (allocated(iamtype)) deallocate(iamtype)
    endif
 elseif (reallocate_itype) then
    !--if called without mixedtypes, preserve contents of itype array
    allocate(iamtype(maxpart,maxstep), stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for type array'
    iamtype = 1

    iamtype(1:maxpartold,1:maxstepold) = iamtypetemp(1:maxpartold,1:maxstepold)
    deallocate(iamtypetemp)
 endif
 !--make sure iamtype is always allocated for safety, just with size=1 if not used
 if (.not.allocated(iamtype)) then
    allocate(iamtype(1,maxstep),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for type array (1)'
 endif
!
!--particle arrays
!
 if (.not.allocated(icolourme) .or. reallocate_part) then
    allocate(icolourme(maxpart),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for icolourme array'
    icolourme = 1

    if (reallocate_part) then
       icolourme(1:maxpartold) = icolourmetemp(1:maxpartold)
       deallocate(icolourmetemp)
    endif
 endif
!
!--other arrays
!
 if (.not.allocated(npartoftype)) then
    allocate(npartoftype(maxparttypes,maxstep),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for header arrays'

    allocate(masstype(maxparttypes,maxstep),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for header arrays'

    allocate(time(maxstep),gamma(maxstep),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for header arrays'

    allocate(headervals(maxhdr,maxstep),stat=ierr)
    if (ierr /= 0) stop 'error allocating memory for header arrays'

    npartoftype = 0
    masstype = 0.
    time = time_not_read_val ! initialise like this so we know if has not been read
    gamma = 0.
    headervals = 0.

    if (reallocate_step) then
       npartoftype(:,1:maxstepold) = npartoftypetemp(:,1:maxstepold)
       masstype(:,1:maxstepold) = masstypetemp(:,1:maxstepold)
       time(1:maxstepold) = timetemp(1:maxstepold)
       gamma(1:maxstepold) = gammatemp(1:maxstepold)
       headervals(:,1:maxstepold) = headervalstemp(:,1:maxstepold)
       deallocate(npartoftypetemp,masstypetemp)
       deallocate(timetemp,gammatemp)
       deallocate(headervalstemp)
    endif
 endif

 return
end subroutine alloc


!-----------------------------------------
!
!  deallocation of remaining memory
!  (for tidiness - not strictly necessary)
!
!-----------------------------------------
subroutine deallocate_all
 use particle_data, only:dat,icolourme,iamtype,npartoftype,masstype,&
                         time,gamma,headervals
 implicit none

 if (allocated(dat)) deallocate(dat)
 if (allocated(icolourme)) deallocate(icolourme)
 if (allocated(iamtype)) deallocate(iamtype)
 if (allocated(npartoftype)) deallocate(npartoftype)
 if (allocated(masstype)) deallocate(masstype)
 if (allocated(time)) deallocate(time)
 if (allocated(gamma)) deallocate(gamma)
 if (allocated(headervals)) deallocate(headervals)

 return
end subroutine deallocate_all

end module mem_allocation
