!
!  Copyright 2017 SALMON developers
!
!  Licensed under the Apache License, Version 2.0 (the "License");
!  you may not use this file except in compliance with the License.
!  You may obtain a copy of the License at
!
!      http://www.apache.org/licenses/LICENSE-2.0
!
!  Unless required by applicable law or agreed to in writing, software
!  distributed under the License is distributed on an "AS IS" BASIS,
!  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
!  See the License for the specific language governing permissions and
!  limitations under the License.
!
!This file is "diag.f"
!This file contain two subroutines.
!SUBROUTINE diag
!SUBROUTINE hermit_jacobi(n,ar,ai,vr,vi,er)

!--------10--------20--------30--------40--------50--------60--------70--------80--------90--------100-------110-------120-------130
Subroutine diag_omp
  use Global_Variables
  use timer
  use omp_lib
  use hpsi, only: hpsi_omp_KB_GS
  use projector
  implicit none
  integer,parameter :: matz=1
  integer           :: ik,ib1,ib2
  integer           :: thr_id

!LAPACK
  integer                :: lwork,info
  complex(8),allocatable :: za(:,:)
  complex(8),allocatable :: work_lp(:)
  real(8),allocatable    :: rwork(:),w(:)
#ifdef __FUJITSU
  complex(8),allocatable :: zutmp(:,:,:)
  integer                :: ithr
#else
  complex(8),allocatable :: zutmp(:,:)
#endif

  lwork=6*NB
  thr_id=0

  call timer_begin(LOG_DIAG)
  call update_projector(kac)

! FIXME: For Fujitsu's parallelized BLAS routines, the application crashes when
!        invoking a routine under OpenMP parallelized loop.
!        However, for many-core processors, outermost loop must be parallelized
!        due to OpenMP overheads.
#ifdef __FUJITSU
  allocate(za(NB,NB),zutmp(NL,NB,0:NUMBER_THREADS-1))
  allocate(work_lp(lwork),rwork(3*NB-2),w(NB))
  do ik=NK_s,NK_e
!$omp parallel private(thr_id)
!$ thr_id = omp_get_thread_num()
!$omp do private(ib1,ib2)
    do ib1=1,NB
      tpsi_omp(1:NL,thr_id)=zu_GS(1:NL,ib1,ik)
      call hpsi_omp_KB_GS(ik,tpsi_omp(:,thr_id),ttpsi_omp(:,thr_id),htpsi_omp(:,thr_id))
      do ib2=ib1+1,NB
        za(ib2,ib1)=sum(conjg(zu_GS(:,ib2,ik))*htpsi_omp(:,thr_id))*Hxyz
        za(ib1,ib2)=conjg(za(ib2,ib1))
      end do
      za(ib1,ib1)=real(sum(conjg(zu_GS(:,ib1,ik))*htpsi_omp(:,thr_id))*Hxyz)
    end do
!$omp end do
!$omp end parallel
    call zheev('V', 'U', NB, za, NB, w, work_lp, lwork, rwork, info)

    zutmp=0.d0
!$omp parallel private(thr_id)
!$ thr_id = omp_get_thread_num()
!$omp do private(ib1,ib2) collapse(2)
    do ib1=1,NB
    do ib2=1,NB
      zutmp(:,ib1,thr_id)=zutmp(:,ib1,thr_id)+zu_GS(:,ib2,ik)*za(ib2,ib1)
    end do
    end do
!$omp end parallel

    Zu_GS(:,:,ik)=0.d0
    do ithr=0,NUMBER_THREADS-1
      zu_GS(:,:,ik)=Zu_GS(:,:,ik)+zutmp(:,:,ithr)
    end do
    esp(:,ik)=w(:)
  enddo
  deallocate(za,zutmp,work_lp,rwork)
#else

!  if( NK_e-NK_s+1 .lt. NB ) then !change as you like

  select case (omp_loop)
  case('k')

  !!---Openmp is for k-points---

!$omp parallel private(thr_id,za,zutmp,work_lp,rwork,w)
!$ thr_id = omp_get_thread_num()
  allocate(za(NB,NB),zutmp(NL,NB))
  allocate(work_lp(lwork),rwork(3*NB-2),w(NB))
!$omp do private(ik,ib1,ib2)
  do ik=NK_s,NK_e
    do ib1=1,NB
      tpsi_omp(1:NL,thr_id)=zu_GS(1:NL,ib1,ik)
      call hpsi_omp_KB_GS(ik,tpsi_omp(:,thr_id),ttpsi_omp(:,thr_id),htpsi_omp(:,thr_id))
      do ib2=ib1+1,NB
        za(ib2,ib1)=sum(conjg(zu_GS(:,ib2,ik))*htpsi_omp(:,thr_id))*Hxyz
        za(ib1,ib2)=conjg(za(ib2,ib1))
      end do
      za(ib1,ib1)=real(sum(conjg(zu_GS(:,ib1,ik))*htpsi_omp(:,thr_id))*Hxyz)
    end do
    call zheev('V', 'U', NB, za, NB, w, work_lp, lwork, rwork, info)

    zutmp=0.d0
    do ib1=1,NB
    do ib2=1,NB
      zutmp(:,ib1)=zutmp(:,ib1)+zu_GS(:,ib2,ik)*za(ib2,ib1)
    end do
    end do
    zu_GS(:,:,ik)=zutmp(:,:)
    esp(:,ik)=w(:)
  enddo
!$omp end do
  deallocate(za,zutmp,work_lp,rwork)
!$omp end parallel

  case('b')

  !!---Openmp is for band orbital---

  allocate(za(NB,NB),zutmp(NL,NB))
  allocate(work_lp(lwork),rwork(3*NB-2),w(NB))
  do ik=NK_s,NK_e
!$omp parallel private(thr_id)
!$ thr_id = omp_get_thread_num()
!$omp do private(ib1,ib2)
    do ib1=1,NB
      tpsi_omp(1:NL,thr_id)=zu_GS(1:NL,ib1,ik)
      call hpsi_omp_KB_GS(ik,tpsi_omp(:,thr_id),ttpsi_omp(:,thr_id),htpsi_omp(:,thr_id))
      do ib2=ib1+1,NB
        za(ib2,ib1)=sum(conjg(zu_GS(:,ib2,ik))*htpsi_omp(:,thr_id))*Hxyz
        za(ib1,ib2)=conjg(za(ib2,ib1))
      end do
      za(ib1,ib1)=real(sum(conjg(zu_GS(:,ib1,ik))*htpsi_omp(:,thr_id))*Hxyz)
    end do
!$omp end do
!$omp end parallel
    call zheev('V', 'U', NB, za, NB, w, work_lp, lwork, rwork, info)

    zutmp=0.d0
    do ib1=1,NB
    do ib2=1,NB
      zutmp(:,ib1)=zutmp(:,ib1)+zu_GS(:,ib2,ik)*za(ib2,ib1)
    end do
    end do
    zu_GS(:,:,ik)=zutmp(:,:)
    esp(:,ik)=w(:)
  enddo
  deallocate(za,zutmp,work_lp,rwork)

  end select

#endif
  call timer_end(LOG_DIAG)

  return
End Subroutine diag_omp


      SUBROUTINE mpdiv(q,r,u,v,n,m)
      INTEGER m,n,NMAX,MACC
      CHARACTER*1 q(n-m+1),r(m),u(n),v(m)
      PARAMETER (NMAX=8192,MACC=3)
CU    USES mpinv,mpmov,mpmul,mpsub
      INTEGER is
      CHARACTER*1 rr(2*NMAX),s(NMAX)
      if(n+MACC.gt.NMAX)pause 'NMAX too small in mpdiv'
      call mpinv(s,v,n-m+MACC,m)
      call mpmul(rr,s,u,n-m+MACC,n)
      call mpmov(q,rr(2),n-m+1)
      call mpmul(rr,q,v,n-m+1,m)
      call mpsub(is,rr(2),u,rr(2),n)
      if (is.ne.0) pause 'MACC too small in mpdiv'
      call mpmov(r,rr(n-m+2),m)
      return
      END

NR-Functions/Numerical Recipes- Example & Functions/Functions/mpdiv.for


      SUBROUTINE getangle(rval, zval, angle, rcenter, zcenter)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE Vname0
      USE Vname1
      IMPLICIT NONE
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      REAL(rprec), DIMENSION(ntheta, nphi) :: rval, zval, angle
      REAL(rprec), DIMENSION(ntheta) :: rcenter, zcenter
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: i, j, iterate
      REAL(rprec), DIMENSION(nv) ::
     1  rcos, rsin, zcos, zsin, phiangle
      REAL(rprec) :: xc, yc, dnum, denom, delangle
C-----------------------------------------------
c**********************************************************************
c       Compute angle offset consistent with constraint Z1n = Z1,-n
c       Note: This is done iteratively, since elongation is unknown
c**********************************************************************
      DO i = 1, nphi
         DO j = 1, ntheta
            angle(j,i) = twopi*(j - 1)/REAL(ntheta,rprec)
         END DO
      END DO
      DO iterate = 1, 5
         DO i = 1, nphi
            rcos(i) = zero
            rsin(i) = zero
            zcos(i) = zero
            zsin(i) = zero
            DO j = 1, ntheta
               xc = rval(j,i) - rcenter(i)
               yc = zval(j,i) - zcenter(i)
               rcos(i) = rcos(i) + COS(angle(j,i))*xc
               rsin(i) = rsin(i) + SIN(angle(j,i))*xc
               zcos(i) = zcos(i) + COS(angle(j,i))*yc
               zsin(i) = zsin(i) + SIN(angle(j,i))*yc
            END DO
         END DO
c**********************************************************************
c       Compute new angles starting from offset phiangle(i)
c**********************************************************************
         dnum = zero
         denom = zero
         dnum = SUM(zsin(:nphi))
         denom = SUM(rcos(:nphi))
         IF (denom .ne. zero) THEN
            elongate = dnum/denom
         ELSE
            elongate = 1.E10
         END IF

         delangle = zero
         DO i = 1, nphi
            phiangle(i) = ATAN2(elongate*zcos(i)-rsin(i),
     1                          elongate*zsin(i)+rcos(i))
            delangle = MAX(delangle,ABS(phiangle(i)))
            angle(:,i) = angle(:,i) + phiangle(i)
         END DO
         IF (delangle < 0.02_dp) EXIT
      END DO
      WRITE (*, 1010) elongate, raxis(1), zaxis(1)
      WRITE (3, 1010) elongate, raxis(1), zaxis(1)
      WRITE (*, 1020) ntheta, nphi
      WRITE (3, 1020) ntheta, nphi
      WRITE (*, 1030) mpol1, ntor
      WRITE (3, 1030) mpol1, ntor
 1010 FORMAT(' Average elongation = ',1pe10.4,/,' Raxis = ',1pe12.4,
     1   ' Zaxis = ',1pe12.4)
 1020 FORMAT(' Number of Theta Points Matched = ',i5,/,
     1   ' Number of Phi Planes = ',i5)
 1030 FORMAT(' Max Poloidal Mode Number = ',i5,/,
     1   ' Max Toroidal Mode Number = ',i5)

      END SUBROUTINE getangle


MODULE oSRF_Parameters

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds, ONLY: fp
  ! Disable implicit typing
  IMPLICIT NONE

  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE

  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &

  ! Planck coefficient parameters
  ! ...Dimension
  INTEGER, PUBLIC, PARAMETER :: N_PLANCK_COEFFS = 2
  ! ...First Planck function constant (C1) scale factors. Units of C1 are W.m^2.
  !    Length scaling: To convert to W/(m^2.cm^-4) requires a scaling of m->cm,
  !                    which is 100, to the fourth power, which is 1.0e+08.
  !    Power scaling:  To convert to mW.m^2 requires a scaling of 1000.
  REAL(fp), PUBLIC, PARAMETER :: C1_LENGTH_SCALE_FACTOR = 1.0e+08_fp
  REAL(fp), PUBLIC, PARAMETER :: C1_POWER_SCALE_FACTOR  = 1.0e+03_fp
  REAL(fp), PUBLIC, PARAMETER :: C1_SCALE_FACTOR = C1_LENGTH_SCALE_FACTOR * C1_POWER_SCALE_FACTOR
  ! ...Second Planck function constant (C2) scale factor. Units of C2 are K.m,
  !    So to convert to K.cm, a scaling of 100 is applied.
  REAL(fp), PUBLIC, PARAMETER :: C2_SCALE_FACTOR = 100.0_fp

  ! Polychromatic coefficient parameters
  ! ...Dimension. Currently, default is a linear fit, y = a + b*x
  INTEGER, PUBLIC, PARAMETER :: N_POLY_COEFFS = 2
  ! ...Temperature settings
  REAL(fp), PUBLIC, PARAMETER :: D_TEMP   = 5.0_fp    ! ** Changing any of these values
  REAL(fp), PUBLIC, PARAMETER :: MIN_TEMP = 150.0_fp  ! ** will generate different numbers
  REAL(fp), PUBLIC, PARAMETER :: MAX_TEMP = 340.0_fp  ! ** for the polychromatic coeffs.
  INTEGER , PUBLIC, PARAMETER :: N_TEMPS  = INT((MAX_TEMP-MIN_TEMP)/D_TEMP + 1.5_fp)

  ! Tolerance values for comparisons
  REAL(fp), PUBLIC, PARAMETER :: INTEGRATE_TOLERANCE    = 1.0e-11_fp
  REAL(fp), PUBLIC, PARAMETER :: CONVOLVE_TOLERANCE     = 1.0e-11_fp
  REAL(fp), PUBLIC, PARAMETER :: EFFECTIVE_T_TOLERANCE  = 1.0e-11_fp
  REAL(fp), PUBLIC, PARAMETER :: POLY_COEFF_TOLERANCE   = 1.0e-11_fp
  REAL(fp), PUBLIC, PARAMETER :: F0_TOLERANCE           = 1.0e-11_fp
  REAL(fp), PUBLIC, PARAMETER :: PLANCK_COEFF_TOLERANCE = 1.0e-18_fp

  ! Flag specific parameters. Include file auto-generated by gen_flag_procedures.rb
  INCLUDE 'oSRF_Flag_Parameters.inc'

END MODULE oSRF_Parameters


! { dg-do run }
!
! Testcase for pr57117

implicit none

  type :: ti
    integer :: i
  end type

  class(ti), allocatable :: x(:,:), z(:)
  integer :: i

  allocate(x(3,3))
  x%i = reshape([( i, i = 1, 9 )], [3, 3])
  allocate(z(9), source=reshape(x, (/ 9 /)))

  if (any( z%i /= [( i, i = 1, 9 )])) call abort()
  deallocate (x, z)
end


!-----------------------------------------
! Implementation of the SPSA algorithm:
!-----------------------------------------

module spsa_routine
use other_routines
implicit none
contains

subroutine spsa (f, theta_k, random_number_distribution, filename, &
      a, c, alpha, gama, convergence, niter, define_a_using_B, B_multiplier)

   ! interface for the abstract function:
   interface
      real(kind=8) function f(var)
         real(kind=8), allocatable, dimension (:), intent(in) :: var
         real(kind=8) :: x, y
      end function
   end interface

   ! variables for the spsa algorithm:
   real(kind=8), allocatable, dimension(:), intent(inout) :: theta_k
   real(kind=8), intent(inout) :: a
   real(kind=8), intent(in) :: c, convergence
   real(kind=8), intent(in) :: B_multiplier ! B = B_multiplier * niter
   real(kind=8), intent(in) :: alpha, gama
   character(len=9), intent(in) :: random_number_distribution
   character(len=1), intent(in) :: define_a_using_B
   integer, intent(in) :: niter
   real(kind=8), allocatable, dimension(:) :: del_k
   real(kind=8), allocatable, dimension(:) :: coords_plus, coords_minus
   real(kind=8), allocatable, dimension(:) :: gradient
   real(kind=8) :: ak, ck, B, mfact, test
   real(kind=8) :: L_plus, L_minus, L_new, L_old ! objective function
   integer :: p ! number of varibles to be optimized
   integer :: k ! counter for the steps in the spsa procedure

   ! for seeding the random number generator:
   integer, allocatable, dimension(:) :: seed
   integer :: ns

   ! for naming the output files:
   character(len=5), intent(in) :: filename
   character(len=10) :: filename1

   !counter:
   integer :: i

   !---------------------------------
   ! Initial operations:
   !---------------------------------

   B = B_multiplier*dble(niter)
   if ( define_a_using_B .eq. 'Y') then
      a = a * (( B + 1.0d0)**alpha)
   end if

   ! allocate the random perturbation vector, the vectors to hold the two
   ! sets of perturbed coordinates, and the gradient vector:
   p = size(theta_k)
   allocate (del_k(p), coords_plus(p), coords_minus(p), gradient(p))

   ! initialize the random number generator:
   call random_seed(size=ns)
   allocate (seed(ns))
   do i = 1, ns
      seed(i) = i
   end do
   write(*,*) "seed:", seed
   call random_seed(put=seed)

   !------------------------
   ! The SPSA peocedure:
   !------------------------

   open (unit=2, file=filename, status='new', action='write')

   k = 1 ! counter
   test = 1.0d0
   L_old = f(theta_k)
   write (2,*) theta_k, L_old

   do while (test .gt. convergence)

      ! compute the k-th gain coefficients (step size)
      ak = a / ((B + k + 1)**alpha)
      ck = c / ((k + 1)**gama)

      ! compute the simultaneous perturbation vector:
      if (random_number_distribution == 'bern_dist') then
         call bernoulli_distribution (del_k)
      else if (random_number_distribution == 'split_uni') then
         call split_uniform (del_k)
      else
         write(*,*) 'no distribution function selected'
         stop
      end if

      ! compute the perturbed coordinates:
      do i = 1, p
         coords_plus(i) = theta_k(i) + ck*del_k(i)
         coords_minus(i) = theta_k(i) - ck*del_k(i)
      end do

      ! evaluate the function with the perturbed coordinates:
      L_plus = f(coords_plus)
      L_minus = f(coords_minus)

      ! determine the gradient:
      mfact = (L_plus - L_minus) / (2*ck) ! multiplicative factor
      do i = 1, p
         gradient(i) = mfact * (1/del_k(i))
      end do
      write(9,*) k, gradient

      ! update the theta estimate:
      do i = 1, p
         theta_k(i) = theta_k(i) - ak*gradient(i)
      end do
      L_new = f(theta_k)
      write (2,*) theta_k, L_new

      ! test for convergence, or termination
      if (k .ge. (niter + niter/3)) exit
      test = dabs(L_new - L_old)
      L_old = L_new
      k = k + 1

   end do
   write(9,*)
   write(9,*) "  k  ", " test "
   write(9,*) k, test

   ! write last point in optimization to a separate file
   filename1 = filename // '_last'
   open (unit=2, file=filename1, status='new', action='write')
   write(2,*) theta_k, L_new
   close(2)

   deallocate (del_k, coords_plus, coords_minus, gradient, seed)

end subroutine spsa

end module spsa_routine


!>
!! @file m_derived_variables.f90
!! @brief Contains module m_derived_variables

!> @brief This module features subroutines that allow for the derivation of
!!              numerous flow variables from the conservative and primitive ones.
!!              Currently, the available derived variables include the unadvected
!!              volume fraction, specific heat ratio, liquid stiffness, speed of
!!              sound, vorticity and the numerical Schlieren function.
MODULE m_derived_variables

    ! Dependencies =============================================================
    USE m_derived_types         !< Definitions of the derived types

    USE m_global_parameters     !< Global parameters for the code

    USE m_mpi_proxy             !< Message passing interface (MPI) module proxy

    USE m_data_output           !< Data output module

    USE m_time_steppers         !< Time-stepping algorithms
    ! ==========================================================================

    IMPLICIT NONE

    PRIVATE; PUBLIC :: s_initialize_derived_variables_module   , &
                       s_initialize_derived_variables          , &
                       s_compute_derived_variables             , &
                       s_finalize_derived_variables_module

    !> @name Finite-difference coefficients
    !! Finite-difference (fd) coefficients in x-, y- and z-coordinate directions.
    !! Note that because sufficient boundary information is available for all the
    !! active coordinate directions, the centered family of the finite-difference
    !! schemes is used.
    !> @{
    REAL(KIND(0d0)), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: fd_coeff_x
    REAL(KIND(0d0)), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: fd_coeff_y
    REAL(KIND(0d0)), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: fd_coeff_z
    !> @}

    CONTAINS

        !>  Computation of parameters, allocation procedures, and/or
        !!      any other tasks needed to properly setup the module
        SUBROUTINE s_initialize_derived_variables_module() ! ----------------------

            ! Allocating the variables which will store the coefficients of the
            ! centered family of finite-difference schemes. Note that sufficient
            ! space is allocated so that the coefficients up to any chosen order
            ! of accuracy may be bookkept. However, if higher than fourth-order
            ! accuracy coefficients are wanted, the formulae required to compute
            ! these coefficients will have to be implemented in the subroutine
            ! s_compute_finite_difference_coefficients.

            ! Allocating centered finite-difference coefficients
            IF (probe_wrt) THEN
                ALLOCATE( fd_coeff_x(-fd_number : fd_number, 0:m))
                IF (n > 0) THEN
                    ALLOCATE(fd_coeff_y(-fd_number : fd_number, 0:n))
                    IF (p > 0) THEN
                        ALLOCATE(fd_coeff_z(-fd_number : fd_number, 0:p))
                    END IF
                END IF
            END IF

        END SUBROUTINE s_initialize_derived_variables_module ! --------------------

        !> Allocate and open derived variables. Computing FD coefficients.
        SUBROUTINE s_initialize_derived_variables() ! -----------------------------

            ! Opening and writing header of CoM and flow probe files
            IF (proc_rank == 0) THEN
                IF (ANY(com_wrt)) THEN
                    CALL s_open_com_files()
                END IF
                IF (ANY(cb_wrt)) THEN
                    CALL s_open_cb_files()
                END IF
                IF (probe_wrt) THEN
                    CALL s_open_probe_files()
                END IF
            END IF

            ! Computing centered finite difference coefficients
            IF (probe_wrt) THEN
                CALL s_compute_finite_difference_coefficients(m,x_cc,fd_coeff_x)
                IF (n > 0) THEN
                    CALL s_compute_finite_difference_coefficients(n,y_cc,fd_coeff_y)
                    IF (p > 0) THEN
                        CALL s_compute_finite_difference_coefficients(p,z_cc,fd_coeff_z)
                    END IF
                END IF
            END IF

        END SUBROUTINE s_initialize_derived_variables ! -----------------------------

        !> Writes coherent body information, communication files, and probes.
        !!  @param t_step Current time-step
        SUBROUTINE s_compute_derived_variables(t_step) ! -----------------------

            INTEGER, INTENT(IN) :: t_step

            INTEGER :: i,j,k !< Generic loop iterators

            ! IF ((ANY(com_wrt) .OR. ANY(cb_wrt) .OR. probe_wrt) .AND. (t_step > t_step_start + 2)) THEN
            IF ((ANY(com_wrt) .OR. ANY(cb_wrt) .OR. probe_wrt) ) THEN
                IF (ANY(com_wrt)) THEN
                    CALL s_derive_center_of_mass(q_prim_ts(0)%vf, &
                                                 q_prim_ts(1)%vf, &
                                                 q_prim_ts(2)%vf, &
                                                 q_prim_ts(3)%vf, &
                                                 q_com)
                    CALL s_derive_higher_moments(q_prim_ts(0)%vf, moments)
                    CALL s_write_com_files(t_step,q_com,moments)
                END IF

                IF (ANY(cb_wrt)) THEN
                    CALL s_derive_fluid_bounds(q_prim_ts(0)%vf, bounds)
                    CALL s_derive_coherent_body(q_prim_ts(0)%vf, cb_mass)
                    CALL s_derive_centerline(q_prim_ts(0)%vf, cntrline)
                    CALL s_write_cb_files(t_step,cb_mass,bounds,cntrline)
                END IF

                IF (probe_wrt) THEN
                    CALL s_derive_acceleration_component(1, q_prim_ts(0)%vf, &
                                                            q_prim_ts(1)%vf, &
                                                            q_prim_ts(2)%vf, &
                                                            q_prim_ts(3)%vf, &
                                                            x_accel)
                    IF (n > 0) THEN
                        CALL s_derive_acceleration_component(2, q_prim_ts(0)%vf, &
                                                                q_prim_ts(1)%vf, &
                                                                q_prim_ts(2)%vf, &
                                                                q_prim_ts(3)%vf, &
                                                                y_accel)
                        IF (p > 0) THEN
                            CALL s_derive_acceleration_component(3, q_prim_ts(0)%vf, &
                                                                    q_prim_ts(1)%vf, &
                                                                    q_prim_ts(2)%vf, &
                                                                    q_prim_ts(3)%vf, &
                                                                    z_accel)
                        END IF
                    END IF

                    DO k = 0, p
                        DO j = 0, n
                            DO i = 0, m
                                IF (p > 0) THEN
                                    accel_mag(i,j,k) = SQRT(x_accel(i,j,k)**2d0 + &
                                                            y_accel(i,j,k)**2d0 + &
                                                            z_accel(i,j,k)**2d0)
                                ELSEIF (n > 0) THEN
                                    accel_mag(i,j,k) = SQRT(x_accel(i,j,k)**2d0 + &
                                                            y_accel(i,j,k)**2d0)
                                ELSE
                                    accel_mag(i,j,k) = x_accel(i,j,k)
                                END IF
                            END DO
                        END DO
                    END DO

                    CALL s_write_probe_files(t_step,q_cons_ts(1)%vf,accel_mag)
                END IF
            END IF

        END SUBROUTINE s_compute_derived_variables ! ---------------------------

        !>  The purpose of this subroutine is to compute the finite-
        !!      difference coefficients for the centered schemes utilized
        !!      in computations of first order spatial derivatives in the
        !!      s-coordinate direction. The s-coordinate direction refers
        !!      to the x-, y- or z-coordinate direction, depending on the
        !!      subroutine's inputs. Note that coefficients of up to 4th
        !!      order accuracy are available.
        !!  @param q Number of cells in the s-coordinate direction
        !!  @param s_cc Locations of the cell-centers in the s-coordinate direction
        !!  @param fd_coeff_s Finite-diff. coefficients in the s-coordinate direction
        SUBROUTINE s_compute_finite_difference_coefficients(    q,s_cc, fd_coeff_s  )

            INTEGER, INTENT(IN) :: q

            REAL(KIND(0d0)), &
            DIMENSION(-buff_size:q+buff_size), &
            INTENT(IN) :: s_cc

            REAL(KIND(0d0)), &
            DIMENSION(-fd_number:fd_number,0:q), &
            INTENT(INOUT) :: fd_coeff_s

            INTEGER :: i !< Generic loop iterator

            ! Computing the 1st order finite-difference coefficients
            IF(fd_order == 1) THEN
                DO i = 0, q
                    fd_coeff_s(-1,i) =  0d0
                    fd_coeff_s( 0,i) = -1d0 / (s_cc(i+1) - s_cc(i))
                    fd_coeff_s( 1,i) = -fd_coeff_s(0,i)
                END DO

            ! Computing the 2nd order finite-difference coefficients
            ELSEIF(fd_order == 2) THEN
                DO i = 0, q
                    fd_coeff_s(-1,i) = -1d0 / (s_cc(i+1) - s_cc(i-1))
                    fd_coeff_s( 0,i) =  0d0
                    fd_coeff_s( 1,i) = -fd_coeff_s(-1,i)
                END DO

            ! Computing the 4th order finite-difference coefficients
            ELSE
                DO i = 0, q
                    fd_coeff_s(-2,i) =  1d0 / (s_cc(i-2) - 8d0*s_cc(i-1) - s_cc(i+2) + 8d0*s_cc(i+1))
                    fd_coeff_s(-1,i) = -8d0 * fd_coeff_s(-2,i)
                    fd_coeff_s( 0,i) =  0d0
                    fd_coeff_s( 1,i) = -fd_coeff_s(-1,i)
                    fd_coeff_s( 2,i) = -fd_coeff_s(-2,i)
                END DO

            END IF

        END SUBROUTINE s_compute_finite_difference_coefficients ! --------------

        !> This subroutine receives as inputs the indicator of the
        !!      component of the acceleration that should be outputted and
        !!      the primitive variables. From those inputs, it proceeds
        !!      to calculate values of the desired acceleration component,
        !!      which are subsequently stored in derived flow quantity
        !!      storage variable, q_sf.
        !!  @param i Acceleration component indicator
        !!  @param q_prim_vf Primitive variables
        !!  @param q_prim_vf1 Primitive variables
        !!  @param q_prim_vf2 Primitive variables
        !!  @param q_prim_vf3 Primitive variables
        !!  @param q_sf Acceleration component
        SUBROUTINE s_derive_acceleration_component(i, q_prim_vf, q_prim_vf1, &
                            q_prim_vf2, q_prim_vf3, q_sf) ! ----------

            INTEGER, INTENT(IN) :: i

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf1
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf2
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf3

            REAL(KIND(0d0)), DIMENSION(0:m,0:n,0:p), INTENT(OUT) :: q_sf

            INTEGER :: j,k,l,r !< Generic loop iterators

            ! Computing the acceleration component in the x-coordinate direction
            IF(i == 1) THEN
                DO l = 0, p
                    DO k = 0, n
                        DO j = 0, m

                            q_sf(j,k,l) = (11d0*q_prim_vf(mom_idx%beg)%sf(j,k,l) &
                                        - 18d0*q_prim_vf1(mom_idx%beg)%sf(j,k,l) &
                                        +  9d0*q_prim_vf2(mom_idx%beg)%sf(j,k,l) &
                                        -  2d0*q_prim_vf3(mom_idx%beg)%sf(j,k,l) ) / (6d0*dt)

                            DO r = -fd_number, fd_number
                                IF ( n == 0) THEN ! 1D simulation
                                    q_sf(j,k,l) = q_sf(j,k,l) &
                                        + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                        q_prim_vf(mom_idx%beg)%sf(r+j, k , l )
                                ELSEIF ( p == 0) THEN ! 2D simulation
                                    q_sf(j,k,l) = q_sf(j,k,l) &
                                        + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                        q_prim_vf(mom_idx%beg)%sf(r+j, k , l ) &
                                        + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                        q_prim_vf(mom_idx%beg)%sf( j ,r+k, l )
                                ELSE ! 3D simulation
                                    IF (grid_geometry == 3) THEN
                                        q_sf(j,k,l) = q_sf(j,k,l) &
                                            + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                            q_prim_vf(mom_idx%beg)%sf(r+j, k , l ) &
                                            + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                            q_prim_vf(mom_idx%beg)%sf( j ,r+k, l ) &
                                            + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                            q_prim_vf(mom_idx%beg)%sf( j , k ,r+l)/y_cc(k)
                                    ELSE
                                        q_sf(j,k,l) = q_sf(j,k,l) &
                                            + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                            q_prim_vf(mom_idx%beg)%sf(r+j, k , l ) &
                                            + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                            q_prim_vf(mom_idx%beg)%sf( j ,r+k, l ) &
                                            + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                            q_prim_vf(mom_idx%beg)%sf( j , k ,r+l)
                                    END IF
                                END IF
                            END DO
                        END DO
                    END DO
                END DO

            ! Computing the acceleration component in the y-coordinate direction
            ELSEIF(i == 2) THEN
                DO l = 0, p
                    DO k = 0, n
                        DO j = 0, m

                            q_sf(j,k,l) = (11d0*q_prim_vf(mom_idx%beg+1)%sf(j,k,l) &
                                        - 18d0*q_prim_vf1(mom_idx%beg+1)%sf(j,k,l) &
                                        +  9d0*q_prim_vf2(mom_idx%beg+1)%sf(j,k,l) &
                                        -  2d0*q_prim_vf3(mom_idx%beg+1)%sf(j,k,l) ) / (6d0*dt)

                            DO r = -fd_number, fd_number
                                IF ( p == 0) THEN ! 2D simulation
                                    q_sf(j,k,l) = q_sf(j,k,l) &
                                        + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                        q_prim_vf(mom_idx%beg+1)%sf(r+j, k , l ) &
                                        + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                        q_prim_vf(mom_idx%beg+1)%sf( j ,r+k, l )
                                ELSE ! 3D simulation
                                    IF (grid_geometry == 3) THEN
                                        q_sf(j,k,l) = q_sf(j,k,l) &
                                            + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                            q_prim_vf(mom_idx%beg+1)%sf(r+j, k , l ) &
                                            + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                            q_prim_vf(mom_idx%beg+1)%sf( j ,r+k, l ) &
                                            + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                            q_prim_vf(mom_idx%beg+1)%sf( j , k ,r+l)/y_cc(k) &
                                            -(q_prim_vf( mom_idx%end )%sf(j,k,l)**2d0)/y_cc(k)
                                    ELSE
                                        q_sf(j,k,l) = q_sf(j,k,l) &
                                            + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                            q_prim_vf(mom_idx%beg+1)%sf(r+j, k , l ) &
                                            + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                            q_prim_vf(mom_idx%beg+1)%sf( j ,r+k, l ) &
                                            + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                            q_prim_vf(mom_idx%beg+1)%sf( j , k ,r+l)
                                    END IF
                                END IF
                            END DO
                        END DO
                    END DO
                END DO

            ! Computing the acceleration component in the z-coordinate direction
            ELSE
                DO l = 0, p
                    DO k = 0, n
                        DO j = 0, m
                            q_sf(j,k,l) = (11d0*q_prim_vf(mom_idx%end)%sf(j,k,l) &
                                        - 18d0*q_prim_vf1(mom_idx%end)%sf(j,k,l) &
                                        +  9d0*q_prim_vf2(mom_idx%end)%sf(j,k,l) &
                                        -  2d0*q_prim_vf3(mom_idx%end)%sf(j,k,l) ) / (6d0*dt)

                            DO r = -fd_number, fd_number
                                IF (grid_geometry == 3) THEN
                                    q_sf(j,k,l) = q_sf(j,k,l) &
                                        + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                        q_prim_vf(mom_idx%end)%sf(r+j, k , l ) &
                                        + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                        q_prim_vf(mom_idx%end)%sf( j ,r+k, l ) &
                                        + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                        q_prim_vf(mom_idx%end)%sf( j , k ,r+l)/y_cc(k) &
                                        +(q_prim_vf( mom_idx%end )%sf(j,k,l) * &
                                        q_prim_vf(mom_idx%beg+1)%sf(j,k,l))/y_cc(k)
                                ELSE
                                    q_sf(j,k,l) = q_sf(j,k,l) &
                                        + q_prim_vf( mom_idx%beg )%sf(j,k,l)*fd_coeff_x(r,j) * &
                                        q_prim_vf(mom_idx%end)%sf(r+j, k , l ) &
                                        + q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*fd_coeff_y(r,k) * &
                                        q_prim_vf(mom_idx%end)%sf( j ,r+k, l ) &
                                        + q_prim_vf( mom_idx%end )%sf(j,k,l)*fd_coeff_z(r,l) * &
                                        q_prim_vf(mom_idx%end)%sf( j , k ,r+l)
                                END IF
                            END DO
                        END DO
                    END DO
                END DO
            END IF

        END SUBROUTINE s_derive_acceleration_component ! --------------------------

        !> This subroutine is used together with the volume fraction
        !!      model and when called upon, it computes the location of
        !!      of the center of mass for each fluid from the inputted
        !!      primitive variables, q_prim_vf. The computed location
        !!      is then written to a formatted data file by the root
        !!      process.
        !!  @param q_prim_vf Primitive variables
        !!  @param q_prim_vf1 Primitive variables
        !!  @param q_prim_vf2 Primitive variables
        !!  @param q_prim_vf3 Primitive variables
        !!  @param q_com Mass,x-location,y-location,z-location,x-velocity,y-velocity,z-velocity,
        !!  x-acceleration, y-acceleration, z-acceleration, weighted
        SUBROUTINE s_derive_center_of_mass(q_prim_vf,q_prim_vf1,q_prim_vf2,q_prim_vf3,q_com)

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf1
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf2
            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf3
            REAL(KIND(0d0)), DIMENSION(num_fluids,10), INTENT(INOUT) :: q_com

            REAL(KIND(0d0)) :: xbeg,xend,ybeg,yend,zbeg,zend !<
            !! Maximum and minimum values of cell boundaries in each direction used in check for
            !! reflective BC in computation of center of mass

            INTEGER :: i,j,k,l !< Generic loop iterators

            REAL(KIND(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce

            REAL(KIND(0d0)) :: dV !< Discrete cell volume

            REAL(KIND(0d0)) :: cart_u_x,  cart_u_y, &
                               cart_u_x1, cart_u_y1,&
                               cart_u_x2, cart_u_y2,&
                               cart_u_x3, cart_u_y3 !<
            !! Cartesian velocities

            IF (n == 0)  THEN !1D simulation

                DO i = 1,num_fluids !Loop over individual fluids
                    IF (com_wrt(i)) THEN
                        q_com(i,:) = 0d0
                        DO l = 0, p !Loop over grid
                            DO k = 0, n
                                DO j = 0, m

                                    dV = dx(j)

                                    ! Mass
                                    q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV
                                    ! x-location weighted
                                    q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j)
                                    ! x-velocity weighted
                                    q_com(i,5) = q_com(i,5) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg)%sf(j,k,l)
                                    ! x-acceleration weighted
                                    q_com(i,8) = q_com(i,8) + dV*(  11d0*( q_prim_vf(i)%sf(j,k,l) &
                                                    * q_prim_vf(mom_idx%beg)%sf(j,k,l)) &
                                                    - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg)%sf(j,k,l)) &
                                                    +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg)%sf(j,k,l)) &
                                                    -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg)%sf(j,k,l)))/(6d0*dt)
                                END DO
                            END DO
                        END DO
                        ! Sum all components across all processors using MPI_ALLREDUCE
                        IF (num_procs > 1) THEN
                            tmp = q_com(i,1)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,1))
                            tmp = q_com(i,2)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,2))
                            tmp = q_com(i,5)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,5))
                            tmp = q_com(i,8)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,8))
                        END IF

                        ! Compute quotients
                        q_com(i,2) = q_com(i,2)/q_com(i,1)
                        q_com(i,5) = q_com(i,5)/q_com(i,1)
                        q_com(i,8) = q_com(i,8)/q_com(i,1)
                    END IF
                END DO

            ELSEIF (p == 0) THEN !2D simulation

                DO i = 1,num_fluids !Loop over individual fluids
                    IF (com_wrt(i)) THEN
                        q_com(i,:) = 0d0
                        DO l = 0, p !Loop over grid
                            DO k = 0, n
                                DO j = 0, m

                                    dV = dx(j)*dy(k)

                                    ! Mass
                                    q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV
                                    ! x-location weighted
                                    q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j)
                                    ! y-location weighted
                                    q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k)
                                    ! x-velocity weighted
                                    q_com(i,5) = q_com(i,5) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg)%sf(j,k,l)
                                    ! y-velocity weighted
                                    q_com(i,6) = q_com(i,6) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg+1)%sf(j,k,l)
                                    ! x-acceleration weighted
                                    q_com(i,8) = q_com(i,8) + dV* &
                                        (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%beg)%sf(j,k,l)) &
                                        - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg)%sf(j,k,l)) &
                                        +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg)%sf(j,k,l)) &
                                        -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg)%sf(j,k,l)))/(6d0*dt)
                                    ! y-acceleration weighted
                                    q_com(i,9) = q_com(i,9) + dV * &
                                        (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%beg+1)%sf(j,k,l)) &
                                        - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg+1)%sf(j,k,l)) &
                                        +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg+1)%sf(j,k,l)) &
                                        -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg+1)%sf(j,k,l)))/(6d0*dt)
                                END DO
                            END DO
                        END DO
                        ! Sum all components across all processors using MPI_ALLREDUCE
                        IF (num_procs > 1) THEN
                            tmp = q_com(i,1)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,1))
                            tmp = q_com(i,2)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,2))
                            tmp = q_com(i,3)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,3))
                            tmp = q_com(i,5)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,5))
                            tmp = q_com(i,6)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,6))
                            tmp = q_com(i,8)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,8))
                            tmp = q_com(i,9)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,9))
                        END IF

                        ! Compute quotients
                        q_com(i,2) = q_com(i,2)/q_com(i,1)
                        q_com(i,3) = q_com(i,3)/q_com(i,1)
                        q_com(i,5) = q_com(i,5)/q_com(i,1)
                        q_com(i,6) = q_com(i,6)/q_com(i,1)
                        q_com(i,8) = q_com(i,8)/q_com(i,1)
                        q_com(i,9) = q_com(i,9)/q_com(i,1)
                    END IF
                END DO

            ELSE !3D simulation

                DO i = 1,num_fluids !Loop over individual fluids
                    IF (com_wrt(i)) THEN
                        q_com(i,:) = 0d0
                        DO l = 0, p !Loop over grid
                            DO k = 0, n
                                DO j = 0, m
                                    IF (grid_geometry == 3) THEN

                                        dV = (2d0*y_cb(k-1)*dy(k) + dy(k)**2d0)/2d0*dx(j)*dz(l)
                                        cart_u_x  =  q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*COS(z_cc(l)) - &
                                            q_prim_vf(mom_idx%end)%sf(j,k,l)*SIN(z_cc(l))
                                        cart_u_y  =  q_prim_vf(mom_idx%beg+1)%sf(j,k,l)*SIN(z_cc(l)) + &
                                            q_prim_vf(mom_idx%end)%sf(j,k,l)*COS(z_cc(l))
                                        cart_u_x1 = q_prim_vf1(mom_idx%beg+1)%sf(j,k,l)*COS(z_cc(l)) - &
                                            q_prim_vf1(mom_idx%end)%sf(j,k,l)*SIN(z_cc(l))
                                        cart_u_y1 = q_prim_vf1(mom_idx%beg+1)%sf(j,k,l)*SIN(z_cc(l)) + &
                                            q_prim_vf1(mom_idx%end)%sf(j,k,l)*COS(z_cc(l))
                                        cart_u_x2 = q_prim_vf2(mom_idx%beg+1)%sf(j,k,l)*COS(z_cc(l)) - &
                                            q_prim_vf2(mom_idx%end)%sf(j,k,l)*SIN(z_cc(l))
                                        cart_u_y2 = q_prim_vf2(mom_idx%beg+1)%sf(j,k,l)*SIN(z_cc(l)) + &
                                            q_prim_vf2(mom_idx%end)%sf(j,k,l)*COS(z_cc(l))
                                        cart_u_x3 = q_prim_vf3(mom_idx%beg+1)%sf(j,k,l)*COS(z_cc(l)) - &
                                            q_prim_vf3(mom_idx%end)%sf(j,k,l)*SIN(z_cc(l))
                                        cart_u_y3 = q_prim_vf3(mom_idx%beg+1)%sf(j,k,l)*SIN(z_cc(l)) + &
                                            q_prim_vf3(mom_idx%end)%sf(j,k,l)*COS(z_cc(l))

                                        ! Mass
                                        q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV
                                        ! x-location weighted
                                        q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k)*COS(z_cc(l))
                                        ! y-location weighted
                                        q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k)*SIN(z_cc(l))
                                        ! z-location weighted
                                        q_com(i,4) = q_com(i,4) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j)
                                        ! x-velocity weighted
                                        q_com(i,5) = q_com(i,5) + q_prim_vf(i)%sf(j,k,l)*dV*cart_u_x
                                        ! y-velocity weighted
                                        q_com(i,6) = q_com(i,6) + q_prim_vf(i)%sf(j,k,l)*dV*cart_u_y
                                        ! z-velocity weighted
                                        q_com(i,7) = q_com(i,7) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg)%sf(j,k,l)
                                        ! x-acceleration weighted
                                        q_com(i,8) = q_com(i,8) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)*cart_u_x ) &
                                            - 18d0*(q_prim_vf1(i)%sf(j,k,l)*cart_u_x1) &
                                            +  9d0*(q_prim_vf2(i)%sf(j,k,l)*cart_u_x2) &
                                            -  2d0*(q_prim_vf3(i)%sf(j,k,l)*cart_u_x3))/(6d0*dt)
                                        ! y-acceleration weighted
                                        q_com(i,9) = q_com(i,9) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)*cart_u_y ) &
                                                - 18d0*(q_prim_vf1(i)%sf(j,k,l)*cart_u_y1) &
                                                +  9d0*(q_prim_vf2(i)%sf(j,k,l)*cart_u_y2) &
                                                -  2d0*(q_prim_vf3(i)%sf(j,k,l)*cart_u_y3))/(6d0*dt)
                                        ! z-acceleration weighted
                                        q_com(i,10) = q_com(i,10) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%beg)%sf(j,k,l)) &
                                            - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg)%sf(j,k,l)) &
                                            +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg)%sf(j,k,l)) &
                                            -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg)%sf(j,k,l)))/(6d0*dt)
                                    ELSE

                                        dV = dx(j)*dy(k)*dz(l)

                                        ! Mass
                                        q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV
                                        ! x-location weighted
                                        q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j)
                                        ! y-location weighted
                                        q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k)
                                        ! z-location weighted
                                        q_com(i,4) = q_com(i,4) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l)
                                        ! x-velocity weighted
                                        q_com(i,5) = q_com(i,5) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg)%sf(j,k,l)
                                        ! y-velocity weighted
                                        q_com(i,6) = q_com(i,6) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%beg+1)%sf(j,k,l)
                                        ! z-velocity weighted
                                        q_com(i,7) = q_com(i,7) + q_prim_vf(i)%sf(j,k,l)*dV*q_prim_vf(mom_idx%end)%sf(j,k,l)
                                        ! x-acceleration weighted
                                        q_com(i,8) = q_com(i,8) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%beg)%sf(j,k,l)) &
                                            - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg)%sf(j,k,l)) &
                                            +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg)%sf(j,k,l)) &
                                            -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg)%sf(j,k,l)))/(6d0*dt)
                                        ! y-acceleration weighted
                                        q_com(i,9) = q_com(i,9) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%beg+1)%sf(j,k,l)) &
                                            - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%beg+1)%sf(j,k,l)) &
                                            +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%beg+1)%sf(j,k,l)) &
                                            -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%beg+1)%sf(j,k,l)))/(6d0*dt)
                                        ! z-acceleration weighted
                                        q_com(i,10) = q_com(i,10) + dV * &
                                            (  11d0*( q_prim_vf(i)%sf(j,k,l)* q_prim_vf(mom_idx%end)%sf(j,k,l)) &
                                            - 18d0*(q_prim_vf1(i)%sf(j,k,l)*q_prim_vf1(mom_idx%end)%sf(j,k,l)) &
                                            +  9d0*(q_prim_vf2(i)%sf(j,k,l)*q_prim_vf2(mom_idx%end)%sf(j,k,l)) &
                                            -  2d0*(q_prim_vf3(i)%sf(j,k,l)*q_prim_vf3(mom_idx%end)%sf(j,k,l)))/(6d0*dt)
                                    END IF
                                END DO
                            END DO
                        END DO
                        ! Sum all components across all processors using MPI_ALLREDUCE
                        IF (num_procs > 1) THEN
                            tmp = q_com(i,1)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,1))
                            tmp = q_com(i,2)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,2))
                            tmp = q_com(i,3)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,3))
                            tmp = q_com(i,4)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,4))
                            tmp = q_com(i,5)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,5))
                            tmp = q_com(i,6)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,6))
                            tmp = q_com(i,7)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,7))
                            tmp = q_com(i,8)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,8))
                            tmp = q_com(i,9)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,9))
                            tmp = q_com(i,10)
                            CALL s_mpi_allreduce_sum(tmp,q_com(i,10))
                        END IF

                        ! Compute quotients
                        q_com(i,2) = q_com(i,2)/q_com(i,1)
                        q_com(i,3) = q_com(i,3)/q_com(i,1)
                        q_com(i,4) = q_com(i,4)/q_com(i,1)
                        q_com(i,5) = q_com(i,5)/q_com(i,1)
                        q_com(i,6) = q_com(i,6)/q_com(i,1)
                        q_com(i,7) = q_com(i,7)/q_com(i,1)
                        q_com(i,8) = q_com(i,8)/q_com(i,1)
                        q_com(i,9) = q_com(i,9)/q_com(i,1)
                        q_com(i,10) = q_com(i,10)/q_com(i,1)
                    END IF
                END DO

            END IF

            ! Find computational domain boundaries
            IF (num_procs > 1) THEN
                CALL s_mpi_allreduce_min(MINVAL(x_cb(-1:m)),xbeg)
                CALL s_mpi_allreduce_max(MAXVAL(x_cb(-1:m)),xend)
                IF (n > 0) THEN
                    CALL s_mpi_allreduce_min(MINVAL(y_cb(-1:n)),ybeg)
                    CALL s_mpi_allreduce_max(MAXVAL(y_cb(-1:n)),yend)
                    IF (p > 0) THEN
                        CALL s_mpi_allreduce_min(MINVAL(z_cb(-1:p)),zbeg)
                        CALL s_mpi_allreduce_max(MAXVAL(z_cb(-1:p)),zend)
                    END IF
                END IF
            ELSE
                xbeg = MINVAL(x_cb(-1:m))
                xend = MAXVAL(x_cb(-1:m))
                IF (n > 0) THEN
                    ybeg = MINVAL(y_cb(-1:n))
                    yend = MAXVAL(y_cb(-1:n))
                    IF (p > 0) THEN
                        zbeg = MINVAL(z_cb(-1:p))
                        zend = MAXVAL(z_cb(-1:p))
                    END IF
                END IF
            END IF

            DO i = 1, num_fluids
                IF (com_wrt(i)) THEN
                    ! Check for reflective BC in x-direction
                    IF (bc_x_glb%beg == -2) THEN
                        q_com(i,1) = q_com(i,1)*2d0
                        q_com(i,2) = xbeg
                        q_com(i,5) = 0d0
                        q_com(i,8) = 0d0
                    ELSEIF (bc_x_glb%end == -2) THEN
                        q_com(i,1) = q_com(i,1)*2d0
                        q_com(i,2) = xend
                        q_com(i,5) = 0d0
                        q_com(i,8) = 0d0
                    END IF
                    IF ( n > 0 ) THEN
                        ! Check for reflective BC in y-direction
                        IF (bc_y_glb%beg == -2) THEN
                            q_com(i,1) = q_com(i,1)*2d0
                            q_com(i,3) = ybeg
                            q_com(i,6) = 0d0
                            q_com(i,9) = 0d0
                        ELSEIF (bc_y_glb%end == -2) THEN
                            q_com(i,1) = q_com(i,1)*2d0
                            q_com(i,3) = yend
                            q_com(i,6) = 0d0
                            q_com(i,9) = 0d0
                        END IF
                        IF ( p > 0 ) THEN
                            ! Check for reflective BC in z-direction
                            IF (bc_z_glb%beg == -2) THEN
                                q_com(i,1) = q_com(i,1)*2d0
                                q_com(i,4) = zbeg
                                q_com(i,7) = 0d0
                                q_com(i,10) = 0d0
                            ELSEIF (bc_z_glb%end == -2) THEN
                                q_com(i,1) = q_com(i,1)*2d0
                                q_com(i,4) = zend
                                q_com(i,7) = 0d0
                                q_com(i,10) = 0d0
                            END IF

                        END IF
                    END IF
                END IF
            END DO

        END SUBROUTINE s_derive_center_of_mass ! ----------------------------------

        !>  Subroutine to compute the higher moments in an attempt to find
        !!      the maximal size of the droplet
        !!  @param q_prim_vf Primitive variables
        !!  @param moments Higher moments (2 lateral directions, 5 moment orders)
        SUBROUTINE s_derive_higher_moments(q_prim_vf, moments)

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,2,5), INTENT(INOUT) :: moments

            INTEGER :: i,r !< Generic loop iterators

            ! Using the global boundary conditions, determine method of computing
            ! higher moments for y-direction
            IF (n > 0) THEN
                IF ((bc_y_glb%beg /= -2) .AND. (bc_y_glb%end /= -2)) THEN
                    ! Non-symmetric moments
                    CALL s_non_symmetric_moments(q_prim_vf, moments, 1)
                ELSEIF (((bc_y_glb%beg == -2) .AND. (bc_y_glb%end == -2)) &
                            .OR. &
                    ((bc_y_glb%beg == -1) .AND. (bc_y_glb%end == -1))) THEN
                    PRINT '(A)', 'Periodic boundary conditions in y-direction. ' // &
                        'Cannot compute higher moments. Exiting...'
                    CALL s_mpi_abort()
                ELSE
                    CALL s_symmetric_moments(q_prim_vf, moments, 1)
                END IF

                IF (p > 0) THEN
                    IF ((bc_z_glb%beg /= -2) .AND. (bc_z_glb%end /= -2)) THEN
                        ! Non-symmetric moments
                        CALL s_non_symmetric_moments(q_prim_vf, moments, 2)
                    ELSEIF (((bc_z_glb%beg == -2) .AND. (bc_z_glb%end == -2)) &
                                .OR. &
                        ((bc_z_glb%beg == -1) .AND. (bc_z_glb%end == -1))) THEN
                        PRINT '(A)', 'Periodic boundary conditions in z-direction. ' // &
                            'Cannot compute higher moments. Exiting...'
                        CALL s_mpi_abort()
                    ELSE
                        CALL s_symmetric_moments(q_prim_vf, moments, 2)
                    END IF
                END IF
            ELSE !1D simulation
                DO i = 1,num_fluids !Loop over individual fluids
                    IF (com_wrt(i)) THEN
                        DO r = 1, 5
                            IF (moment_order(r) /= dflt_int) THEN
                                moments(i,:,r) = 0d0
                            ELSE
                                moments(i,:,r) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            END IF

        END SUBROUTINE s_derive_higher_moments ! -----------------------------------------

        !> Compute non-symmetric moments
        !! @param q_prim_vf Primitive variables
        !! @param moments Higher moments(2 lateral directions, 5 moment orders)
        !! @param dir Current lateral direction
        SUBROUTINE s_non_symmetric_moments(q_prim_vf, moments, dir) ! ---------------------

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,2,5), INTENT(INOUT) :: moments
            INTEGER, INTENT(IN) :: dir

            REAL(KIND(0d0)), DIMENSION(num_fluids,5) :: pos_numer, neg_numer, pos_denom, neg_denom !<
            !! Numerator and denominator place holders for computation

            REAL(KIND(0d0)) :: numer_weight     !< Numerator weight
            REAL(KIND(0d0)) :: main_term        !< Constant term in both numerator and denominator
            REAL(KIND(0d0)) :: dV               !< Discrete cell volume
            REAL(KIND(0d0)) :: cart_x, cart_y   !< Cartesian x- and y-locations
            INTEGER :: i,j,k,l,r    !< Generic loop iterators
            REAL(KIND(0d0)) :: tmp  !< Temporary variable to store quantity for mpi_allreduce

            DO i = 1, num_fluids
                IF (com_wrt(i)) THEN
                pos_numer(i,:) = 0d0
                neg_numer(i,:) = 0d0
                pos_denom(i,:) = 0d0
                neg_denom(i,:) = 0d0
                    DO r = 1, 5
                        IF (moment_order(r) /= dflt_int) THEN
                            DO l = 0, p
                                DO k = 0, n
                                    DO j = 0, m
                                        IF (q_prim_vf(i)%sf(j,k,l) > 5d-1) THEN
                                            IF (grid_geometry == 3) THEN
                                                dV = (2d0*y_cb(k-1)*dy(k) + dy(k)**2d0)/2d0*dx(j)*dz(l)
                                                cart_x = y_cc(k)*COS(z_cc(l))
                                                cart_y = y_cc(k)*SIN(z_cc(l))
                                                main_term =       q_prim_vf(i+E_idx)%sf(j,k,l)  * &
                                                           (1d0 - q_prim_vf(i+E_idx)%sf(j,k,l)) * dV
                                                IF ((dir == 1) .AND. (cart_x >= 0d0)) THEN
                                                    numer_weight = cart_x**moment_order(r)

                                                    pos_numer(i,r) = pos_numer(i,r) + numer_weight * main_term
                                                    pos_denom(i,r) = pos_denom(i,r) + main_term
                                                ELSEIF ((dir == 1) .AND. (cart_x < 0d0)) THEN
                                                    numer_weight = cart_x**moment_order(r)

                                                    neg_numer(i,r) = neg_numer(i,r) + numer_weight * main_term
                                                    neg_denom(i,r) = neg_denom(i,r) + main_term
                                                ELSEIF ((dir == 2) .AND. (cart_y >= 0d0)) THEN
                                                    numer_weight = cart_y**moment_order(r)

                                                    pos_numer(i,r) = pos_numer(i,r) + numer_weight * main_term
                                                    pos_denom(i,r) = pos_denom(i,r) + main_term
                                                ELSEIF ((dir == 2) .AND. (cart_y < 0d0)) THEN
                                                    numer_weight = cart_y**moment_order(r)

                                                    neg_numer(i,r) = neg_numer(i,r) + numer_weight * main_term
                                                    neg_denom(i,r) = neg_denom(i,r) + main_term
                                                END IF
                                            ELSE
                                                IF (n > 0) THEN
                                                    main_term =       q_prim_vf(i+E_idx)%sf(j,k,l)  * &
                                                               (1d0 - q_prim_vf(i+E_idx)%sf(j,k,l)) * &
                                                               dx(j)*dy(k)
                                                    IF (p > 0) THEN
                                                        main_term = main_term * dz(l)
                                                    END IF
                                                END IF
                                                IF ((dir == 1) .AND. (y_cc(k) >= 0d0)) THEN
                                                    numer_weight = y_cc(k)**moment_order(r)

                                                    pos_numer(i,r) = pos_numer(i,r) + numer_weight * main_term
                                                    pos_denom(i,r) = pos_denom(i,r) + main_term
                                                ELSEIF ((dir == 1) .AND. (y_cc(k) < 0d0)) THEN
                                                    numer_weight = y_cc(k)**moment_order(r)

                                                    neg_numer(i,r) = neg_numer(i,r) + numer_weight * main_term
                                                    neg_denom(i,r) = neg_denom(i,r) + main_term
                                                ELSEIF ((dir == 2) .AND. (z_cc(l) >= 0d0)) THEN
                                                    numer_weight = z_cc(l)**moment_order(r)

                                                    pos_numer(i,r) = pos_numer(i,r) + numer_weight * main_term
                                                    pos_denom(i,r) = pos_denom(i,r) + main_term
                                                ELSEIF ((dir == 2) .AND. (z_cc(l) < 0d0)) THEN
                                                    numer_weight = z_cc(l)**moment_order(r)

                                                    neg_numer(i,r) = neg_numer(i,r) + numer_weight * main_term
                                                    neg_denom(i,r) = neg_denom(i,r) + main_term
                                                END IF
                                            END IF
                                        END IF
                                    END DO
                                END DO
                            END DO
                            ! Sum all components across all procs using MPI_ALLREDUCE
                            IF (num_procs > 1) THEN
                                tmp = pos_numer(i,r)
                                CALL s_mpi_allreduce_sum(tmp,pos_numer(i,r))
                                tmp = neg_numer(i,r)
                                CALL s_mpi_allreduce_sum(tmp,neg_numer(i,r))
                                tmp = pos_denom(i,r)
                                CALL s_mpi_allreduce_sum(tmp,pos_denom(i,r))
                                tmp = neg_denom(i,r)
                                CALL s_mpi_allreduce_sum(tmp,neg_denom(i,r))
                            END IF
                            ! Compute quotients and sum to get total moment
                            moments(i,dir,r) = (pos_numer(i,r)/pos_denom(i,r))**(1d0/moment_order(r)) + &
                                       (neg_numer(i,r)/neg_denom(i,r))**(1d0/moment_order(r))
                        ELSE
                            moments(i,dir,r) = dflt_real
                        END IF
                    END DO
                END IF
            END DO

        END SUBROUTINE s_non_symmetric_moments ! ------------------------------------------

        !> Compute symmetric moments
        !! @param q_prim_vf Primitive variables
        !! @param moments Higher moments(2 lateral directions, 5 moment orders)
        !! @param dir Current lateral direction
        SUBROUTINE s_symmetric_moments(q_prim_vf, moments, dir) ! ---------------------

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,2,5), INTENT(INOUT) :: moments
            INTEGER, INTENT(IN) :: dir

            REAL(KIND(0d0)), DIMENSION(num_fluids,5) :: numer, denom !<
            !! Numerator and denominator place holders for computation

            REAL(KIND(0d0)) :: numer_weight     !< Numerator weight
            REAL(KIND(0d0)) :: main_term        !< Constant term in both numerator and denominator
            REAL(KIND(0d0)) :: dV               !< Discrete cell volume
            REAL(KIND(0d0)) :: cart_x, cart_y   !< Cartesian x- and y-locations
            REAL(KIND(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce

            INTEGER :: i,j,k,l,r !< Generic loop iterators

            DO i = 1, num_fluids
                IF (com_wrt(i)) THEN
                numer(i,:) = 0d0
                denom(i,:) = 0d0
                    DO r = 1, 5
                        IF (moment_order(r) /= dflt_int) THEN
                            DO l = 0, p
                                DO k = 0, n
                                    DO j = 0, m
                                        IF (q_prim_vf(i)%sf(j,k,l) > 5d-1) THEN
                                            IF (grid_geometry == 3) THEN
                                                dV = (2d0*y_cb(k-1)*dy(k) + dy(k)**2d0)/2d0*dx(j)*dz(l)
                                                cart_x = y_cc(k)*COS(z_cc(l))
                                                cart_y = y_cc(k)*SIN(z_cc(l))
                                                main_term =       q_prim_vf(i+E_idx)%sf(j,k,l)  * &
                                                           (1d0 - q_prim_vf(i+E_idx)%sf(j,k,l)) * dV
                                                IF (dir == 1) THEN
                                                    numer_weight = cart_x**moment_order(r)

                                                    numer(i,r) = numer(i,r) + numer_weight * main_term
                                                    denom(i,r) = denom(i,r) + main_term
                                                ELSEIF (dir == 2) THEN
                                                    numer_weight = cart_y**moment_order(r)

                                                    numer(i,r) = numer(i,r) + numer_weight * main_term
                                                    denom(i,r) = denom(i,r) + main_term
                                                END IF
                                            ELSE
                                                IF (n > 0) THEN
                                                    main_term =       q_prim_vf(i+E_idx)%sf(j,k,l)  * &
                                                               (1d0 - q_prim_vf(i+E_idx)%sf(j,k,l)) * &
                                                               dx(j)*dy(k)
                                                    IF (p > 0) THEN
                                                        main_term = main_term * dz(l)
                                                    END IF
                                                END IF
                                                IF (dir == 1) THEN
                                                    numer_weight = y_cc(k)**moment_order(r)

                                                    numer(i,r) = numer(i,r) + numer_weight * main_term
                                                    denom(i,r) = denom(i,r) + main_term
                                                ELSEIF (dir == 2) THEN
                                                    numer_weight = z_cc(l)**moment_order(r)

                                                    numer(i,r) = numer(i,r) + numer_weight * main_term
                                                    denom(i,r) = denom(i,r) + main_term
                                                END IF
                                            END IF
                                        END IF
                                    END DO
                                END DO
                            END DO
                            ! Sum all components across all procs using MPI_ALLREDUCE
                            IF (num_procs > 1) THEN
                                tmp = numer(i,r)
                                CALL s_mpi_allreduce_sum(tmp,numer(i,r))
                                tmp = denom(i,r)
                                CALL s_mpi_allreduce_sum(tmp,denom(i,r))
                            END IF
                            ! Compute quotients and sum to get total moment
                            moments(i,dir,r) = (numer(i,r)/denom(i,r))**(1d0/moment_order(r))
                        ELSE
                            moments(i,dir,r) = dflt_real
                        END IF
                    END DO
                END IF
            END DO

        END SUBROUTINE s_symmetric_moments ! ------------------------------------------

        !>  This subroutine is used together with the volume fraction model
        !!      and when called upon, it computes the min and max bounds  of the
        !!      fluid in each direction in the domain.
        !!  @param q_prim_vf Primitive variables
        !!  @param bounds Variables storing the min and max bounds  of the fluids
        SUBROUTINE s_derive_fluid_bounds(q_prim_vf, bounds) ! -----------------------

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,5,6), INTENT(INOUT) :: bounds

            REAL(KIND(0d0)) :: cart_x, cart_y, cart_z !< Cartesian x,y,z-locations
            REAL(KIND(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce

            INTEGER :: i,j,k,l,r !< Generic loop iterators

            IF (n == 0) THEN ! 1D simulation
                DO i = 1,num_fluids !Loop over individual fluids
                    IF (cb_wrt(i)) THEN
                        bounds(i,:,1) = -1d0*dflt_real ! 1d6
                        bounds(i,:,2) = dflt_real ! -1d6
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                DO l = 0, p !Loop over grid
                                    DO k = 0, n
                                        DO j = 0, m
                                            IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                .AND. (x_cb(j-1) <= bounds(i,r,1))) THEN
                                                bounds(i,r,1) = x_cb(j-1)
                                            ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (x_cb(j) >= bounds(i,r,2))) THEN
                                                bounds(i,r,2) = x_cb(j)
                                            END IF
                                        END DO
                                    END DO
                                END DO

                                IF (num_procs > 1) THEN
                                    tmp = bounds(i,r,1)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,1))
                                    tmp = bounds(i,r,2)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,2))
                                END IF
                            ELSE
                                bounds(i,r,1) = dflt_real
                                bounds(i,r,2) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            ELSEIF (p == 0) THEN ! 2D simulation
                DO i = 1,num_fluids !Loop over individual fluids
                    IF (cb_wrt(i)) THEN
                        bounds(i,:,1) = -1d0*dflt_real ! 1d6
                        bounds(i,:,2) = dflt_real ! -1d6
                        bounds(i,:,3) = -1d0*dflt_real ! 1d6
                        bounds(i,:,4) = dflt_real ! -1d6
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                DO l = 0, p ! Loop over grid
                                    DO k = 0, n
                                        DO j = 0, m
                                            IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                .AND. (x_cb(j-1) <= bounds(i,r,1))) THEN
                                                bounds(i,r,1) = x_cb(j-1)
                                            ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (x_cb(j) >= bounds(i,r,2))) THEN
                                                bounds(i,r,2) = x_cb(j)
                                            END IF
                                            IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                .AND. (y_cb(k-1) <= bounds(i,r,3))) THEN
                                                bounds(i,r,3) = y_cb(k-1)
                                            ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (y_cb(k) >= bounds(i,r,4))) THEN
                                                bounds(i,r,4) = y_cb(k)
                                            END IF
                                        END DO
                                    END DO
                                END DO

                                IF (num_procs > 1) THEN
                                    tmp = bounds(i,r,1)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,1))
                                    tmp = bounds(i,r,2)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,2))
                                    tmp = bounds(i,r,3)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,3))
                                    tmp = bounds(i,r,4)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,4))
                                END IF
                            ELSE
                                bounds(i,r,1) = dflt_real
                                bounds(i,r,2) = dflt_real
                                bounds(i,r,3) = dflt_real
                                bounds(i,r,4) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            ELSE ! 3D simulation
                DO i = 1,num_fluids !Loop over individual fluids
                    IF (cb_wrt(i)) THEN
                        bounds(i,:,1) = -1d0*dflt_real ! 1d6
                        bounds(i,:,2) = dflt_real ! -1d6
                        bounds(i,:,3) = -1d0*dflt_real ! 1d6
                        bounds(i,:,4) = dflt_real ! -1d6
                        bounds(i,:,5) = -1d0*dflt_real ! 1d6
                        bounds(i,:,6) = dflt_real ! -1d6
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                DO l = 0, p ! Loop over grid
                                    DO k = 0, n
                                        DO j = 0, m
                                            IF (grid_geometry == 3) THEN
                                                cart_x = y_cc(k)*COS(z_cc(l))
                                                cart_y = y_cc(k)*SIN(z_cc(l))
                                                cart_z = x_cc(j)
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_x <= bounds(i,r,1))) THEN
                                                    bounds(i,r,1) = cart_x
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_x >= bounds(i,r,2))) THEN
                                                    bounds(i,r,2) = cart_x
                                                END IF
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_y <= bounds(i,r,3))) THEN
                                                    bounds(i,r,3) = cart_y
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_y >= bounds(i,r,4))) THEN
                                                    bounds(i,r,4) = cart_y
                                                END IF
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_z <= bounds(i,r,5))) THEN
                                                    bounds(i,r,5) = cart_z
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (cart_z >= bounds(i,r,6))) THEN
                                                    bounds(i,r,6) = cart_z
                                                END IF
                                            ELSE
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (x_cb(j-1) <= bounds(i,r,1))) THEN
                                                    bounds(i,r,1) = x_cb(j-1)
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (x_cb(j) >= bounds(i,r,2))) THEN
                                                    bounds(i,r,2) = x_cb(j)
                                                END IF
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (y_cb(k-1) <= bounds(i,r,3))) THEN
                                                    bounds(i,r,3) = y_cb(k-1)
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (y_cb(k) >= bounds(i,r,4))) THEN
                                                    bounds(i,r,4) = y_cb(k)
                                                END IF
                                                IF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (z_cb(l-1) <= bounds(i,r,5))) THEN
                                                    bounds(i,r,5) = z_cb(l-1)
                                                ELSEIF ((q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) &
                                                    .AND. (z_cb(l) >= bounds(i,r,6))) THEN
                                                    bounds(i,r,6) = z_cb(l)
                                                END IF
                                            END IF
                                        END DO
                                    END DO
                                END DO

                                IF (num_procs > 1) THEN
                                    tmp = bounds(i,r,1)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,1))
                                    tmp = bounds(i,r,2)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,2))
                                    tmp = bounds(i,r,3)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,3))
                                    tmp = bounds(i,r,4)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,4))
                                    tmp = bounds(i,r,5)
                                    CALL s_mpi_allreduce_min(tmp,bounds(i,r,5))
                                    tmp = bounds(i,r,6)
                                    CALL s_mpi_allreduce_max(tmp,bounds(i,r,6))
                                END IF
                            ELSE
                                bounds(i,r,1) = dflt_real
                                bounds(i,r,2) = dflt_real
                                bounds(i,r,3) = dflt_real
                                bounds(i,r,4) = dflt_real
                                bounds(i,r,5) = dflt_real
                                bounds(i,r,6) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            END IF

        END SUBROUTINE s_derive_fluid_bounds ! -------------------------------------------

        !>  This subroutine is used together with the volume fraction model
        !!      and when called upon, it computes the total mass of a fluid in the
        !!      entire domain for which the volume fraction is greater than a
        !!      threshold value. This gives the mass of the coherent body.
        !!  @param q_prim_vf Primitive variables
        !!  @param cb_mass Coherent body mass
        SUBROUTINE s_derive_coherent_body(q_prim_vf, cb_mass) ! --------------------------

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,10), INTENT(INOUT) :: cb_mass

            REAL(KIND(0d0)) :: dV  !< Discrete cell volume
            INTEGER :: i,j,k,l,r   !< Generic loop iterators
            REAL(KIND(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce

            DO i = 1,num_fluids !Loop over individual fluids
                IF (cb_wrt(i)) THEN
                    cb_mass(i,:) = 0d0
                    DO r = 1, 5 ! Volume fraction threshold values
                        IF (threshold_mf(r) /= dflt_real) THEN
                            DO l = 0, p !Loop over grid
                                DO k = 0, n
                                    DO j = 0, m
                                        IF (q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) THEN
                                            IF (n == 0) THEN
                                                dV = dx(j)
                                            ELSEIF (p == 0) THEN
                                                dV = dx(j)*dy(k)
                                            ELSE
                                                IF (grid_geometry == 3) THEN
                                                    dV = (2d0*y_cb(k-1)*dy(k) + dy(k)**2d0)/2d0*dx(j)*dz(l)
                                                ELSE
                                                    dV = dx(j)*dy(k)*dz(l)
                                                END IF
                                            END IF
                                            cb_mass(i,r) = cb_mass(i,r) + q_prim_vf(i)%sf(j,k,l)*dV ! Mass
                                            cb_mass(i,r+5) = cb_mass(i,r+5) + dV ! Volume
                                        END IF
                                    END DO
                                END DO
                            END DO

                            IF (num_procs > 1) THEN
                                tmp = cb_mass(i,r)
                                CALL s_mpi_allreduce_sum(tmp,cb_mass(i,r))
                                tmp = cb_mass(i,r+5)
                                CALL s_mpi_allreduce_sum(tmp,cb_mass(i,r+5))
                            END IF
                        ELSE
                            cb_mass(i,r) = dflt_real
                            cb_mass(i,r+5) = dflt_real
                        END IF
                    END DO
                END IF
            END DO

            DO i = 1, num_fluids
                IF (cb_wrt(i)) THEN
                    DO r = 1, 5
                        IF (threshold_mf(r) /= dflt_real) THEN
                            ! Check for reflective BC in x-direction
                            IF (bc_x_glb%beg == -2) THEN
                                cb_mass(i,r) = cb_mass(i,r)*2d0
                                cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                            ELSEIF (bc_x_glb%end == -2) THEN
                                cb_mass(i,r) = cb_mass(i,r)*2d0
                                cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                            END IF
                            IF ( n > 0 ) THEN
                                ! Check for reflective BC in y-direction
                                IF (bc_y_glb%beg == -2) THEN
                                    cb_mass(i,r) = cb_mass(i,r)*2d0
                                    cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                                ELSEIF (bc_y_glb%end == -2) THEN
                                    cb_mass(i,r) = cb_mass(i,r)*2d0
                                    cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                                END IF
                                IF ( p > 0 ) THEN
                                    ! Check for reflective BC in z-direction
                                    IF (bc_z_glb%beg == -2) THEN
                                        cb_mass(i,r) = cb_mass(i,r)*2d0
                                        cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                                    ELSEIF (bc_z_glb%end == -2) THEN
                                        cb_mass(i,r) = cb_mass(i,r)*2d0
                                        cb_mass(i,r+5) = cb_mass(i,r+5)*2d0
                                    END IF

                                END IF
                            END IF
                        END IF
                    END DO
                END IF
            END DO

        END SUBROUTINE s_derive_coherent_body ! ------------------------------

        !>  This subroutine is used together with the volume fraction model
        !!      and when called upon, it computes the centerline length of the
        !!      fluid.
        !!  @param q_prim_vf Primitive variables
        !!  @param cntrline Variables storing the centerline length of the fluids
        SUBROUTINE s_derive_centerline(q_prim_vf, cntrline) ! --------------------------

            TYPE(scalar_field), DIMENSION(sys_size), INTENT(IN) :: q_prim_vf
            REAL(KIND(0d0)), DIMENSION(num_fluids,5), INTENT(INOUT) :: cntrline

            REAL(KIND(0d0)), DIMENSION(5) :: cntrmin, cntrmax !< Placeholders
            REAL(KIND(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce

            INTEGER :: i,j,k,l,r !< Generic loop iterators

            IF (n == 0) THEN ! 1D simulation
                DO i = 1, num_fluids
                    IF (cb_wrt(i)) THEN
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                cntrline(i,r) = 0d0
                            ELSE
                                cntrline(i,r) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            ELSEIF ((p == 0) .OR. (grid_geometry == 3)) THEN ! 2D simulation
                DO i = 1, num_fluids
                    IF (cb_wrt(i)) THEN
                        cntrmin(:) = -1d0*dflt_real
                        cntrmax(:) = dflt_real
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                DO l = 0, p
                                    DO k = 0, n
                                        DO j = 0, m
                                            IF (    (y_cb(k-1) == 0d0) .AND. &
                                                (q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) .AND. &
                                                (x_cb(j-1) <= cntrmin(r)) ) THEN
                                                    cntrmin(r) = x_cb(j-1)
                                            ELSEIF ((y_cb(k-1) == 0d0) .AND. &
                                                (q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) .AND. &
                                                (x_cb(j) >= cntrmax(r)) ) THEN
                                                    cntrmax(r) = x_cb(j)
                                            END IF
                                        END DO
                                    END DO
                                END DO

                                IF (num_procs > 1) THEN
                                    tmp = cntrmin(r)
                                    CALL s_mpi_allreduce_min(tmp,cntrmin(r))
                                    tmp = cntrmax(r)
                                    CALL s_mpi_allreduce_max(tmp,cntrmax(r))
                                END IF

                                cntrline(i,r) = cntrmax(r) - cntrmin(r)
                            ELSE
                                cntrline(i,r) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            ELSE ! 3D simulation
                DO i = 1, num_fluids
                    IF (cb_wrt(i)) THEN
                        cntrmin(:) = -1d0*dflt_real
                        cntrmax(:) = dflt_real
                        DO r = 1, 5
                            IF (threshold_mf(r) /= dflt_real) THEN
                                DO l = 0, p
                                    DO k = 0, n
                                        DO j = 0, m
                                            IF (    (y_cb(k-1) == 0d0) .AND. &
                                                    (z_cb(l-1) == 0d0) .AND. &
                                                (q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) .AND. &
                                                (x_cb(j-1) <= cntrmin(r)) ) THEN
                                                    cntrmin(r) = x_cb(j-1)
                                            ELSEIF ((y_cb(k-1) == 0d0) .AND. &
                                                    (z_cb(l-1) == 0d0) .AND. &
                                                (q_prim_vf(i+E_idx)%sf(j,k,l) >= threshold_mf(r)) .AND. &
                                                (x_cb(j) >= cntrmax(r)) ) THEN
                                                    cntrmax(r) = x_cb(j)
                                            END IF
                                        END DO
                                    END DO
                                END DO

                                IF (num_procs > 1) THEN
                                    tmp = cntrmin(r)
                                    CALL s_mpi_allreduce_min(tmp,cntrmin(r))
                                    tmp = cntrmax(r)
                                    CALL s_mpi_allreduce_max(tmp,cntrmax(r))
                                END IF

                                cntrline(i,r) = cntrmax(r) - cntrmin(r)
                            ELSE
                                cntrline(i,r) = dflt_real
                            END IF
                        END DO
                    END IF
                END DO
            END IF

        END SUBROUTINE s_derive_centerline ! ----------------------------------

        !> Deallocation procedures for the module
        SUBROUTINE s_finalize_derived_variables_module() ! -------------------

            ! Closing CoM and flow probe files
            IF (proc_rank == 0) THEN
                IF (ANY(com_wrt)) THEN
                    CALL s_close_com_files()
                END IF
                IF (ANY(cb_wrt)) THEN
                    CALL s_close_cb_files()
                END IF
                IF (probe_wrt) THEN
                    CALL s_close_probe_files()
                END IF
            END IF

            ! Deallocating the variables that might have been used to bookkeep
            ! the finite-difference coefficients in the x-, y- and z-directions
            IF(ALLOCATED(fd_coeff_x)) DEALLOCATE(fd_coeff_x)
            IF(ALLOCATED(fd_coeff_y)) DEALLOCATE(fd_coeff_y)
            IF(ALLOCATED(fd_coeff_z)) DEALLOCATE(fd_coeff_z)

        END SUBROUTINE s_finalize_derived_variables_module ! -----------------

END MODULE m_derived_variables