! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later

! DJM - 2017-05-09 - added #ifdef USE_MPIINPLACE cpp directive to     *
! enable declaration of a gridunc0 array if required by MPI code in   *
! mpi_mod.f90                                                         *
!                                                                     *
!**********************************************************************

module unc_mod

  use par_mod, only:dp,dep_prec,nclassunc

  implicit none

  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: gridunc
  real(dep_prec),allocatable, dimension (:,:,:)         :: gridcnt
#ifdef USE_MPIINPLACE
#else
  ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
  ! then an aux array is needed for parallel grid reduction
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: gridunc0
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: griduncn0
#endif
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: griduncn
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygridunc
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygriduncn
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: wetgridunc
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: wetgriduncn
#ifdef _OPENMP
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:,:) :: gridunc_omp
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:,:) :: griduncn_omp
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: drygridunc_omp
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: drygriduncn_omp
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgridunc_omp
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgriduncn_omp
  real(dep_prec),allocatable, dimension (:,:,:,:)       :: gridcnt_omp
#endif
! For sum of individual contributions, used for the MPI version
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygridunc0
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygriduncn0
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: wetgridunc0
  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: wetgriduncn0

contains

subroutine alloc_grid_unc()
  use com_mod

  implicit none

  integer :: stat

  ! gridunc,griduncn        uncertainty of outputted concentrations
  allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, &
       maxpointspec_act,nclassunc,nageclass),stat=stat)
  if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
  allocate(gridcnt(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
  if (stat.ne.0) write(*,*)'ERROR: could not allocate gridcnt'
#ifdef _OPENMP
  allocate(gridunc_omp(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, &
       maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
  if (stat.ne.0) then
    write(*,*)'ERROR: could not allocate gridunc_omp'
    write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.'
    error stop
  endif
  allocate(gridcnt_omp(0:numxgrid-1,0:numygrid-1,numzgrid,numthreads_grid),stat=stat)
  if (stat.ne.0) then
    write(*,*)'ERROR: could not allocate gridcnt_omp'
    write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.'
    error stop
  endif
#endif
  if (ldirect.gt.0) then
    allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc'
    allocate(drygridunc(0:numxgrid-1,0:numygrid-1,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc'
#ifdef _OPENMP
    allocate(wetgridunc_omp(0:numxgrid-1,0:numygrid-1,nspec, &
         maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc_omp'
    allocate(drygridunc_omp(0:numxgrid-1,0:numygrid-1,nspec, &
         maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc_omp'
#endif
  endif

#ifdef USE_MPIINPLACE
#else
! Extra field for totals at MPI root process
  if (lroot.and.mpi_mode.gt.0) then
! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
! then an aux array is needed for parallel grid reduction
    allocate(gridunc0(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
  else if (.not.lroot.and.mpi_mode.gt.0) then
    allocate(gridunc0(1,1,1,1,1,1,1),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
  end if
#endif
  if (ldirect.gt.0) then
    if (lroot.and.mpi_mode.gt.0) then
      allocate(wetgridunc0(0:numxgrid-1,0:numygrid-1,nspec, &
           maxpointspec_act,nclassunc,nageclass),stat=stat)
      if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc0'
      allocate(drygridunc0(0:numxgrid-1,0:numygrid-1,nspec, &
           maxpointspec_act,nclassunc,nageclass),stat=stat)
      if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc0'

  ! allocate a dummy to avoid compilator complaints
    else if (.not.lroot.and.mpi_mode.gt.0) then
      allocate(wetgridunc0(1,1,1,1,1,1),stat=stat)
      allocate(drygridunc0(1,1,1,1,1,1),stat=stat)
    end if
  end if

  if (lroot) then
    write (*,*) 'Allocating fields for global output (x,y): ', &
      numxgrid,numygrid
  end if

end subroutine alloc_grid_unc

subroutine alloc_grid_unc_nest()
  use com_mod

  implicit none

  integer :: stat

  ! gridunc,griduncn        uncertainty of outputted concentrations
  allocate(griduncn(0:numxgridn-1,0:numygridn-1,numzgrid,nspec, &
       maxpointspec_act,nclassunc,nageclass),stat=stat)
  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
#ifdef _OPENMP
  allocate(griduncn_omp(0:numxgridn-1,0:numygridn-1,numzgrid,nspec, &
       maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc_omp'
#endif

  if (ldirect.gt.0) then
    allocate(wetgriduncn(0:numxgridn-1,0:numygridn-1,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested wetgridunc'
    allocate(drygriduncn(0:numxgridn-1,0:numygridn-1,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested drygridunc'
#ifdef _OPENMP
    allocate(wetgriduncn_omp(0:numxgridn-1,0:numygridn-1,nspec, &
         maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested wetgridunc_omp'
    allocate(drygriduncn_omp(0:numxgridn-1,0:numygridn-1,nspec, &
         maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested drygriduncn_omp'
#endif
  endif

#ifdef USE_MPIINPLACE
#else
  ! Extra field for totals at MPI root process
  if (lroot.and.mpi_mode.gt.0) then
  ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid_nest(),
  ! then an aux array is needed for parallel grid reduction
    allocate(griduncn0(0:numxgridn-1,0:numygridn-1,numzgrid,nspec, &
         maxpointspec_act,nclassunc,nageclass),stat=stat)
    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
  ! allocate a dummy to avoid compilator complaints
  else if (.not.lroot.and.mpi_mode.gt.0) then
    allocate(griduncn0(1,1,1,1,1,1,1),stat=stat)
  end if
#endif
  if (ldirect.gt.0) then
    if (lroot.and.mpi_mode.gt.0) then
      allocate(wetgriduncn0(0:numxgridn-1,0:numygridn-1,nspec, &
           maxpointspec_act,nclassunc,nageclass),stat=stat)
      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
      allocate(drygriduncn0(0:numxgridn-1,0:numygridn-1,nspec, &
           maxpointspec_act,nclassunc,nageclass),stat=stat)
      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
  !  endif
  ! allocate a dummy to avoid compilator complaints
    else if (.not.lroot.and.mpi_mode.gt.0) then
      allocate(wetgriduncn0(1,1,1,1,1,1),stat=stat)
      allocate(drygriduncn0(1,1,1,1,1,1),stat=stat)
    end if
  end if

  if (lroot) then
    write (*,*) 'Allocating fields for nested output (x,y): ', &
      numxgridn,numygridn
  end if

end subroutine alloc_grid_unc_nest

subroutine deposit_decay()
  ! Accumulated deposited mass radioactively decays
  use com_mod

  implicit none

  integer ::                &
    j,i,                    & ! loop variable over grid
    ks,                     & ! loop variable species
    kp,                     & ! loop variable for maxpointspec_act
    l,                      & ! loop variable over nclassunc
    nage                      ! loop variable over age classes

!$OMP PARALLEL PRIVATE(ks,kp,nage,l,j,i)
!$OMP DO COLLAPSE(2)
  do ks=1,nspec
  do kp=1,maxpointspec_act
    if (decay(ks).gt.0.) then
      do nage=1,nageclass
        do l=1,nclassunc
  ! Mother output grid
          do j=0,numygrid-1
            do i=0,numxgrid-1
              wetgridunc(i,j,ks,kp,l,nage)= &
                   wetgridunc(i,j,ks,kp,l,nage)* &
                   exp(-1.*outstep*decay(ks))
              drygridunc(i,j,ks,kp,l,nage)= &
                   drygridunc(i,j,ks,kp,l,nage)* &
                   exp(-1.*outstep*decay(ks))
            end do
          end do
  ! Nested output grid
          if (nested_output.eq.1) then
            do j=0,numygridn-1
              do i=0,numxgridn-1
                wetgriduncn(i,j,ks,kp,l,nage)= &
                     wetgriduncn(i,j,ks,kp,l,nage)* &
                     exp(-1.*outstep*decay(ks))
                drygriduncn(i,j,ks,kp,l,nage)= &
                     drygriduncn(i,j,ks,kp,l,nage)* &
                     exp(-1.*outstep*decay(ks))
              end do
            end do
          endif
        end do
      end do
    endif
  end do
  end do
!$OMP END DO
!$OMP END PARALLEL
end subroutine deposit_decay

end module unc_mod