conditional_diagnostics_whole.F90

Go to the documentation of this file.

 
!  Using the totalled values from Part 1, averages the results over the horizontal domain,
!  creating profiles of the requested diagnostics under the requested conditions and .not. conditions.
!  The "area" diagnostic is a special case, recording the fraction of the domain meeting the associated
!  condition and .not. condition.
module conditional_diagnostics_whole_mod
  use monc_component_mod, only : component_descriptor_type
  use state_mod, only : model_state_type
 
  use conditional_diagnostics_column_mod, only : conddiags_tot, ncond, ndiag, gpts_total, requested_area
  use grids_mod, only : z_index
  use datadefn_mod, only : precision_type, default_precision
  use mpi, only : mpi_sum, mpi_in_place, mpi_int, mpi_real, mpi_double, mpi_comm
  use missing_data_mod, only: rmdi
  use optionsdatabase_mod, only : options_get_integer
 
 
  implicit none
 
#ifndef TEST_MODE
  private
#endif
 
  integer :: diagnostic_generation_frequency
 
  public conditional_diagnostics_whole_get_descriptor
 
contains
 
 
  type(component_descriptor_type) function conditional_diagnostics_whole_get_descriptor()
    conditional_diagnostics_whole_get_descriptor%name="conditional_diagnostics_whole"
    conditional_diagnostics_whole_get_descriptor%version=0.1
    conditional_diagnostics_whole_get_descriptor%initialisation=>initialisation_callback
    conditional_diagnostics_whole_get_descriptor%timestep=>timestep_callback
    conditional_diagnostics_whole_get_descriptor%finalisation=>finalisation_callback
  end function conditional_diagnostics_whole_get_descriptor
 
 
  subroutine initialisation_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state
 
    ! Save the sampling_frequency to force diagnostic calculation on select time steps
    diagnostic_generation_frequency=options_get_integer(current_state%options_database, "sampling_frequency")
 
  end subroutine initialisation_callback
 
 
  subroutine timestep_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state
    integer :: k,cnc,dnc,ierr
    real(kind=default_precision) :: temp
 
    if (.not. mod(current_state%timestep, diagnostic_generation_frequency) == 0) return
 
    if (current_state%parallel%my_rank == 0) then
      call mpi_reduce(mpi_in_place , conddiags_tot, ncond*2*ndiag*current_state%local_grid%size(z_index), &
                      precision_type, mpi_sum, 0, current_state%parallel%monc_communicator, ierr)
    else
      call mpi_reduce(conddiags_tot, conddiags_tot, ncond*2*ndiag*current_state%local_grid%size(z_index), &
                      precision_type, mpi_sum, 0, current_state%parallel%monc_communicator, ierr)
    end if
 
    do dnc = 1, ndiag
      if (dnc /= requested_area) then
        do cnc = 1, ncond
          do k = 2, current_state%local_grid%size(z_index) - 1
            temp = conddiags_tot(k,cnc,requested_area)
            if (temp .gt. 0) then
              conddiags_tot(k,cnc,dnc) = conddiags_tot(k,cnc,dnc) / temp
            else
              conddiags_tot(k,cnc,dnc) = rmdi
            end if
          end do ! k
        end do ! cnc over ncond*2
      end if ! check requested_area
    end do ! dnc over ndiag
 
    conddiags_tot(:,:,requested_area) = conddiags_tot(:,:,requested_area) / gpts_total
 
    conddiags_tot(1,:,:) = rmdi
    conddiags_tot(current_state%local_grid%size(z_index),:,:) = rmdi
 
    conddiags_tot = conddiags_tot / current_state%parallel%processes
 
    call mpi_bcast(conddiags_tot,  ncond*2*ndiag*current_state%local_grid%size(z_index), &
                   precision_type, 0, current_state%parallel%monc_communicator, ierr)
 
  end subroutine timestep_callback
 
  
  subroutine finalisation_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state
 
  end subroutine finalisation_callback
 
end module conditional_diagnostics_whole_mod