meanprofiles.F90

Go to the documentation of this file.

module meanprofiles_mod
  use monc_component_mod, only : component_descriptor_type
  use state_mod, only : model_state_type
  use grids_mod, only : x_index, y_index, z_index
  use datadefn_mod, only : default_precision, precision_type
  use mpi, only : mpi_sum, mpi_in_place
  implicit none

#ifndef TEST_MODE
  private
#endif

  integer :: start_x, end_x, start_y, end_y, bar_fields

  real(kind=DEFAULT_PRECISION) :: rnhpts
  real(kind=DEFAULT_PRECISION), dimension(:,:), allocatable :: bartmp

  public meanprofiles_get_descriptor
contains

  type(component_descriptor_type) function meanprofiles_get_descriptor()
    meanprofiles_get_descriptor%name="mean_profiles"
    meanprofiles_get_descriptor%version=0.1
    meanprofiles_get_descriptor%initialisation=>init_callback
    meanprofiles_get_descriptor%timestep=>timestep_callback
    meanprofiles_get_descriptor%finalisation=>finalisation_callback
  end function meanprofiles_get_descriptor

  subroutine init_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state

    bar_fields=0

    rnhpts=1.0_default_precision/real(current_state%global_grid%size(x_index)*current_state%global_grid%size(y_index))

    start_x=current_state%local_grid%local_domain_start_index(x_index)
    end_x=current_state%local_grid%local_domain_end_index(X_INDEX)
    start_y=current_state%local_grid%local_domain_start_index(y_index)
    end_y=current_state%local_grid%local_domain_end_index(Y_INDEX)

#ifdef U_ACTIVE
    if (.not. current_state%continuation_run) then
      allocate(current_state%global_grid%configuration%vertical%olubar(current_state%local_grid%size(z_index)),&
           current_state%global_grid%configuration%vertical%olzubar(current_state%local_grid%size(z_index)))
    end if
    allocate(current_state%global_grid%configuration%vertical%savolubar(current_state%local_grid%size(z_index)))
    bar_fields=bar_fields+2
#endif
#ifdef V_ACTIVE
    if (.not. current_state%continuation_run) then
      allocate(current_state%global_grid%configuration%vertical%olvbar(current_state%local_grid%size(z_index)),&
           current_state%global_grid%configuration%vertical%olzvbar(current_state%local_grid%size(z_index)))
    end if
    allocate(current_state%global_grid%configuration%vertical%savolvbar(current_state%local_grid%size(z_index)))
    bar_fields=bar_fields+2
#endif
    if (current_state%th%active) then
      if (.not. current_state%continuation_run) then
        allocate(current_state%global_grid%configuration%vertical%olthbar(current_state%local_grid%size(z_index)),&
             current_state%global_grid%configuration%vertical%olzthbar(current_state%local_grid%size(z_index)))
      end if
      bar_fields=bar_fields+2
    end if
    if (current_state%number_q_fields .gt. 0) then
      bar_fields=bar_fields+(current_state%number_q_fields*2)
      if (.not. current_state%continuation_run) then
        allocate(current_state%global_grid%configuration%vertical%olqbar(current_state%local_grid%size(z_index), &
             current_state%number_q_fields), current_state%global_grid%configuration%vertical%olzqbar(&
             current_state%local_grid%size(z_index), current_state%number_q_fields))
      end if
    end if
    allocate(bartmp(current_state%local_grid%size(z_index), bar_fields))

    ! Do the initial calculation for the first timestep
    if (.not. current_state%continuation_run) call calculate_mean_profiles(current_state)
  end subroutine init_callback

  subroutine timestep_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state

    current_state%global_grid%configuration%vertical%savolubar=current_state%global_grid%configuration%vertical%olubar
    current_state%global_grid%configuration%vertical%savolvbar=current_state%global_grid%configuration%vertical%olvbar

    call calculate_mean_profiles(current_state)
  end subroutine timestep_callback

  subroutine finalisation_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state

    if (allocated(bartmp)) deallocate(bartmp)    
  end subroutine finalisation_callback

  subroutine calculate_mean_profiles(current_state)
    type(model_state_type), target, intent(inout) :: current_state

    integer :: bar_index, i
    
    call calculate_sum_profiles(current_state)

    bar_index=1
#ifdef U_ACTIVE
    current_state%global_grid%configuration%vertical%olubar(:)=bartmp(:, bar_index)*rnhpts
    current_state%global_grid%configuration%vertical%olzubar(:)=bartmp(:, bar_index+1)*rnhpts
    bar_index=bar_index+2
#endif
#ifdef V_ACTIVE
    current_state%global_grid%configuration%vertical%olvbar(:)=bartmp(:, bar_index)*rnhpts
    current_state%global_grid%configuration%vertical%olzvbar(:)=bartmp(:, bar_index+1)*rnhpts
    bar_index=bar_index+2
#endif
    if (current_state%th%active) then
      current_state%global_grid%configuration%vertical%olthbar(:)=bartmp(:, bar_index)*rnhpts
      current_state%global_grid%configuration%vertical%olzthbar(:)=bartmp(:, bar_index+1)*rnhpts
      bar_index=bar_index+2
    end if
    do i=1,current_state%number_q_fields
      if (current_state%q(i)%active) then
        current_state%global_grid%configuration%vertical%olqbar(:, i)=bartmp(:, bar_index)*rnhpts
        current_state%global_grid%configuration%vertical%olzqbar(:, i)=bartmp(:, bar_index+1)*rnhpts
        bar_index=bar_index+2
      end if
    end do

  end subroutine calculate_mean_profiles    

  subroutine calculate_sum_profiles(current_state)
    type(model_state_type), intent(inout) :: current_state

    integer :: k, n, bar_index, ierr    
    
    do k=current_state%local_grid%local_domain_start_index(z_index), current_state%local_grid%local_domain_end_index(z_index)
      bar_index=1
#ifdef U_ACTIVE
      bartmp(k, bar_index)=sum(current_state%u%data(k, start_y:end_y, start_x:end_x))
      bartmp(k, bar_index+1)=sum(current_state%zu%data(k, start_y:end_y, start_x:end_x))
      bar_index=bar_index+2
#endif
#ifdef V_ACTIVE
      bartmp(k, bar_index)=sum(current_state%v%data(k, start_y:end_y, start_x:end_x))
      bartmp(k, bar_index+1)=sum(current_state%zv%data(k, start_y:end_y, start_x:end_x))      
      bar_index=bar_index+2
#endif
      if (current_state%th%active) then
        bartmp(k, bar_index)=sum(current_state%th%data(k, start_y:end_y, start_x:end_x))
        bartmp(k, bar_index+1)=sum(current_state%zth%data(k, start_y:end_y, start_x:end_x))
        bar_index=bar_index+2
      end if
      do n=1,current_state%number_q_fields
        if (current_state%q(n)%active) then
          bartmp(k, bar_index)=sum(current_state%q(n)%data(k, start_y:end_y, start_x:end_x))
          bartmp(k, bar_index+1)=sum(current_state%zq(n)%data(k, start_y:end_y, start_x:end_x))
          bar_index=bar_index+2
        end if
      end do
    end do

    call mpi_allreduce(mpi_in_place, bartmp, bar_fields*current_state%local_grid%size(z_index), precision_type, mpi_sum, &
         current_state%parallel%monc_communicator, ierr)
  end subroutine calculate_sum_profiles
end module meanprofiles_mod