scale_prof.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_prof
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: prof_setup
  public :: prof_setprefx
  public :: prof_rapstart
  public :: prof_rapend
  public :: prof_rapreport

#ifdef PAPI
  public :: prof_papi_rapstart
  public :: prof_papi_rapstop
  public :: prof_papi_rapreport
#endif

  public :: prof_valcheck

  interface prof_valcheck
     module procedure prof_valcheck_sp_1d
     module procedure prof_valcheck_sp_2d
     module procedure prof_valcheck_sp_3d
     module procedure prof_valcheck_sp_4d
     module procedure prof_valcheck_sp_5d
     module procedure prof_valcheck_sp_6d
     module procedure prof_valcheck_dp_1d
     module procedure prof_valcheck_dp_2d
     module procedure prof_valcheck_dp_3d
     module procedure prof_valcheck_dp_4d
     module procedure prof_valcheck_dp_5d
     module procedure prof_valcheck_dp_6d
  end interface prof_valcheck

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: get_rapid

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer,                private, parameter :: prof_rapnlimit = 300
  character(len=H_SHORT), private            :: prof_prefix    = ''
  integer,                private            :: prof_rapnmax   = 0
  character(len=H_SHORT), private            :: prof_rapname(prof_rapnlimit)
  integer,                private            :: prof_grpnmax   = 0
  character(len=H_SHORT), private            :: prof_grpname(prof_rapnlimit)
  integer,                private            :: prof_grpid  (prof_rapnlimit)
  real(DP),               private            :: prof_raptstr(prof_rapnlimit)
  real(DP),               private            :: prof_rapttot(prof_rapnlimit)
  integer,                private            :: prof_rapnstr(prof_rapnlimit)
  integer,                private            :: prof_rapnend(prof_rapnlimit)
  integer,                private            :: prof_raplevel(prof_rapnlimit)

  integer,                private, parameter :: prof_default_rap_level = 2
  integer,                private            :: prof_rap_level         = 2
  logical,                private            :: prof_mpi_barrier       = .false.

#ifdef PAPI
  integer(DP),            private            :: prof_papi_flops     = 0
  real(SP),               private            :: prof_papi_real_time = 0.0
  real(SP),               private            :: prof_papi_proc_time = 0.0
  real(SP),               private            :: prof_papi_mflops    = 0.0
  integer,                private            :: prof_papi_check
#endif

  character(len=7),       private            :: prof_header
  character(len=16),      private            :: prof_item
  real(DP),               private            :: prof_max
  real(DP),               private            :: prof_min
  real(DP),               private            :: prof_sum

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine prof_setup
    use scale_prc, only: &
       prc_abort
    implicit none

    namelist / param_prof / &
         prof_rap_level, &
         prof_mpi_barrier

    integer :: ierr

    log_newline
    log_info("PRF_setup",*) 'Setup'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_prof,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("PROF_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("PROF_setup",*) 'Not appropriate names in namelist PARAM_PROF. Check!'
       call prc_abort
    endif
    log_nml(param_prof)

    log_newline
    log_info("PROF_setup",*) 'Rap output level              = ', prof_rap_level
    log_info("PROF_setup",*) 'Add MPI_barrier in every rap? = ', prof_mpi_barrier

    prof_prefix = ''

    return
  end subroutine prof_setup

  !-----------------------------------------------------------------------------
  subroutine prof_setprefx( &
       prefxname )
    implicit none

    character(len=*), intent(in) :: prefxname

    !---------------------------------------------------------------------------

    if ( prefxname == '' ) then !--- no prefix
       prof_prefix = ''
    else
       prof_prefix = trim(prefxname)//'_'
    endif

    return
  end subroutine prof_setprefx

  !-----------------------------------------------------------------------------
  subroutine prof_rapstart( rapname_base, level )
    use scale_prc, only: &
       prc_mpibarrier, &
       prc_mpitime
    implicit none

    character(len=*), intent(in)           :: rapname_base
    integer,          intent(in), optional :: level

    character(len=H_SHORT) :: rapname

    integer :: id
    integer :: level_
    integer :: tn
    !$ integer :: omp_get_thread_num
    !---------------------------------------------------------------------------

    tn = 0
    !$ tn = omp_get_thread_num()
    if ( tn > 0 ) return

    if ( present(level) ) then
       level_ = level
    else
       level_ = prof_default_rap_level
    endif

    if( level_ > prof_rap_level ) return

    rapname = trim(prof_prefix)//trim(rapname_base)

    id = get_rapid( rapname, level_ )

    if(prof_mpi_barrier) call prc_mpibarrier

    prof_raptstr(id) = prc_mpitime()
    prof_rapnstr(id) = prof_rapnstr(id) + 1

    !LOG_INFO("PROF_rapstart",'(1x,A,I8)') rapname, PROF_rapnstr(id)
    !call flush(IO_FID_LOG)

#ifdef FAPP
    call fapp_start( trim(prof_grpname(get_grpid(rapname))), id, level_ )
#endif
#ifdef FINEPA
    call start_collection( rapname )
#endif

    return
  end subroutine prof_rapstart

  !-----------------------------------------------------------------------------
  subroutine prof_rapend( rapname_base, level )
    use scale_prc, only: &
       prc_mpibarrier, &
       prc_mpitime
    implicit none

    character(len=*), intent(in)           :: rapname_base
    integer,          intent(in), optional :: level

    character(len=H_SHORT) :: rapname

    integer :: id
    integer :: level_
    integer :: tn
    !$ integer :: omp_get_thread_num
    !---------------------------------------------------------------------------

    tn = 0
    !$ tn = omp_get_thread_num()
    if ( tn > 0 ) return

    if ( present(level) ) then
       if( level > prof_rap_level ) return
    endif

    rapname = trim(prof_prefix)//trim(rapname_base)

    id = get_rapid( rapname, level_ )

    if( level_ > prof_rap_level ) return

    if(prof_mpi_barrier) call prc_mpibarrier

    prof_rapttot(id) = prof_rapttot(id) + ( prc_mpitime()-prof_raptstr(id) )
    prof_rapnend(id) = prof_rapnend(id) + 1

#ifdef FINEPA
    call stop_collection( rapname )
#endif
#ifdef FAPP
    call fapp_stop( trim(prof_grpname(prof_grpid(id))), id, level_ )
#endif

    return
  end subroutine prof_rapend

  !-----------------------------------------------------------------------------
  subroutine prof_rapreport
    use scale_prc, only: &
       prc_mpitimestat, &
       prc_ismaster
    implicit none

    real(DP) :: avgvar(prof_rapnlimit)
    real(DP) :: maxvar(prof_rapnlimit)
    real(DP) :: minvar(prof_rapnlimit)
    integer  :: maxidx(prof_rapnlimit)
    integer  :: minidx(prof_rapnlimit)

    integer :: id, gid
    integer :: fid
    !---------------------------------------------------------------------------

    do id = 1, prof_rapnmax
       if ( prof_rapnstr(id) /= prof_rapnend(id) ) then
           log_warn("PROF_rapreport",*) 'Mismatch Report',id,prof_rapname(id),prof_rapnstr(id),prof_rapnend(id)
       endif
    enddo

    log_newline
    log_info("PROF_rapreport",'(1x,A,I2,A)') 'Computational Time Report (Rap level = ', prof_rap_level, ')'

    if ( io_log_allnode ) then ! report for each node

       do gid = 1, prof_rapnmax
          do id = 1, prof_rapnmax
             if (       prof_raplevel(id) <= prof_rap_level &
                  .AND. prof_grpid(id) == gid            ) then
                log_info_cont('(1x,A,I3.3,A,A,A,F10.3,A,I9)') &
                              'ID=',id,' : ',prof_rapname(id),' T=',prof_rapttot(id),' N=',prof_rapnstr(id)
             endif
          enddo
       enddo

    else

       call prc_mpitimestat( avgvar(1:prof_rapnmax), &
                             maxvar(1:prof_rapnmax), &
                             minvar(1:prof_rapnmax), &
                             maxidx(1:prof_rapnmax), &
                             minidx(1:prof_rapnmax), &
                             prof_rapttot(1:prof_rapnmax)  )

       fid = -1
       if ( io_log_suppress ) then ! report to STDOUT
          if ( prc_ismaster ) then
             write(*,*) 'INFO  [PROF_rapreport] Computational Time Report'
             fid = io_fid_stdout ! master node
          endif
       else
          if ( io_l ) fid = io_fid_log
       endif

       do gid = 1, prof_rapnmax
          do id = 1, prof_rapnmax
             if (       prof_raplevel(id) <= prof_rap_level &
                  .AND. prof_grpid(id) == gid            &
                  .AND. fid > 0                             ) then
                write(fid,'(6x,A,I3.3,3A,F10.3,A,F10.3,A,I5,2A,F10.3,A,I5,2A,I9)') &
                          'ID=',id,' : ',prof_rapname(id), &
                          ' T(avg)=',avgvar(id), &
                          ', T(max)=',maxvar(id),'[',maxidx(id),']', &
                          ', T(min)=',minvar(id),'[',minidx(id),']', &
                          ', N=',prof_rapnstr(id)
             endif
          enddo
       enddo

    endif

    return
  end subroutine prof_rapreport

#ifdef PAPI
  !-----------------------------------------------------------------------------
  subroutine prof_papi_rapstart
    implicit none
    !---------------------------------------------------------------------------

    call papif_flops( prof_papi_real_time, prof_papi_proc_time, prof_papi_flops, prof_papi_mflops, prof_papi_check )

    return
  end subroutine prof_papi_rapstart

  !-----------------------------------------------------------------------------
  subroutine prof_papi_rapstop
    implicit none
    !---------------------------------------------------------------------------

    call papif_flops( prof_papi_real_time, prof_papi_proc_time, prof_papi_flops, prof_papi_mflops, prof_papi_check )

    return
  end subroutine prof_papi_rapstop

  !-----------------------------------------------------------------------------
  subroutine prof_papi_rapreport
    use scale_prc, only: &
       prc_mpitimestat, &
       prc_nprocs,      &
       prc_ismaster
    implicit none

    real(DP) :: avgvar(3)
    real(DP) :: maxvar(3)
    real(DP) :: minvar(3)
    integer  :: maxidx(3)
    integer  :: minidx(3)

    real(DP) :: zerosw
    real(DP) :: PROF_PAPI_gflop
    real(DP) :: statistics(3)
    !---------------------------------------------------------------------------

    prof_papi_gflop = real(PROF_PAPI_flops,kind=8) / 1024.0_DP**3

    if ( io_log_allnode ) then ! report for each node

       log_newline
       log_info("PROF_PAPI_rapreport",*) 'PAPI Report [Local PE information]'
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') 'Real time          [sec] : ', prof_papi_real_time
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') 'CPU  time          [sec] : ', prof_papi_proc_time
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') 'FLOP             [GFLOP] : ', prof_papi_gflop
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') 'FLOPS by PAPI   [GFLOPS] : ', prof_papi_mflops/1024.0_dp
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') 'FLOP / CPU Time [GFLOPS] : ', prof_papi_gflop/prof_papi_proc_time

    else
       statistics(1) = real(prof_papi_real_time,kind=8)
       statistics(2) = real(prof_papi_proc_time,kind=8)
       statistics(3) = prof_papi_gflop

       call prc_mpitimestat( avgvar(1:3), &
                             maxvar(1:3), &
                             minvar(1:3), &
                             maxidx(1:3), &
                             minidx(1:3), &
                             statistics(1:3)  )

       zerosw = 0.5_dp - sign(0.5_dp,maxvar(2)-1.d-12) ! if maxvar(2) = 0 then zerosw = 1

       log_newline
       log_info("PROF_PAPI_rapreport",*) 'PAPI Report'
       log_info("PROF_PAPI_rapreport",'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  'Real time [sec]',' T(avg)=',avgvar(1), &
                  ', T(max)=',maxvar(1),'[',maxidx(1),']',', T(min)=',minvar(1),'[',minidx(1),']'
       log_info("PROF_PAPI_rapreport",'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  'CPU  time [sec]',' T(avg)=',avgvar(2), &
                  ', T(max)=',maxvar(2),'[',maxidx(2),']',', T(min)=',minvar(2),'[',minidx(2),']'
       log_info("PROF_PAPI_rapreport",'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  'FLOP    [GFLOP]',' N(avg)=',avgvar(3), &
                  ', N(max)=',maxvar(3),'[',maxidx(3),']',', N(min)=',minvar(3),'[',minidx(3),']'
       log_newline
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3,A,I6,A)') &
                  'TOTAL FLOP    [GFLOP] : ', avgvar(3)*prc_nprocs, '(',prc_nprocs,' PEs)'
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') &
                  'FLOPS        [GFLOPS] : ', avgvar(3)*prc_nprocs * ( 1.0_dp-zerosw ) / ( maxvar(2)+zerosw )
       log_info("PROF_PAPI_rapreport",'(1x,A,F15.3)') &
                  'FLOPS per PE [GFLOPS] : ', avgvar(3)            * ( 1.0_dp-zerosw ) / ( maxvar(2)+zerosw )
       log_newline

       if ( io_log_suppress ) then ! report to STDOUT
          if ( prc_ismaster ) then ! master node
             write(*,*)
             write(*,*) '*** PAPI Report'
             write(*,'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  '*** Real time [sec]',' T(avg)=',avgvar(1), &
                  ', T(max)=',maxvar(1),'[',maxidx(1),']',', T(min)=',minvar(1),'[',minidx(1),']'
             write(*,'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  '*** CPU  time [sec]',' T(avg)=',avgvar(2), &
                  ', T(max)=',maxvar(2),'[',maxidx(2),']',', T(min)=',minvar(2),'[',minidx(2),']'
             write(*,'(1x,A,A,F10.3,A,F10.3,A,I5,A,A,F10.3,A,I5,A,A,I7)') &
                  '*** FLOP    [GFLOP]',' N(avg)=',avgvar(3), &
                  ', N(max)=',maxvar(3),'[',maxidx(3),']',', N(min)=',minvar(3),'[',minidx(3),']'
             write(*,*)
             write(*,'(1x,A,F15.3,A,I6,A)') &
                  '*** TOTAL FLOP    [GFLOP] : ', avgvar(3)*prc_nprocs, '(',prc_nprocs,' PEs)'
             write(*,'(1x,A,F15.3)') &
                  '*** FLOPS        [GFLOPS] : ', avgvar(3)*prc_nprocs * ( 1.0_dp-zerosw ) / ( maxvar(2)+zerosw )
             write(*,'(1x,A,F15.3)') &
                  '*** FLOPS per PE [GFLOPS] : ', avgvar(3)            * ( 1.0_dp-zerosw ) / ( maxvar(2)+zerosw )
          endif
       endif
    endif

    return
  end subroutine prof_papi_rapreport
#endif

  !-----------------------------------------------------------------------------
  function get_rapid( rapname, level ) result(id)
    implicit none

    character(len=*), intent(in)    :: rapname
    integer,          intent(inout) :: level

    character (len=H_SHORT) :: trapname

    integer :: id
    !---------------------------------------------------------------------------

    trapname  = trim(rapname)

    do id = 1, prof_rapnmax
       if ( trapname == prof_rapname(id) ) then
          level = prof_raplevel(id)
          return
       endif
    enddo

    prof_rapnmax     = prof_rapnmax + 1
    id               = prof_rapnmax
    prof_rapname(id) = trapname

    prof_rapnstr(id) = 0
    prof_rapnend(id) = 0
    prof_rapttot(id) = 0.0_dp

    prof_grpid(id) = get_grpid(trapname)
    prof_raplevel(id) = level

    return
  end function get_rapid

  !-----------------------------------------------------------------------------
  function get_grpid( rapname ) result(gid)
    implicit none

    character(len=*), intent(in)    :: rapname

    character(len=H_SHORT) :: grpname

    integer :: gid
    integer :: idx
    !---------------------------------------------------------------------------

    idx = index(rapname," ")
    if ( idx > 1 ) then
       grpname = rapname(1:idx-1)
    else
       grpname = rapname
    endif

    do gid = 1, prof_grpnmax
       if( grpname == prof_grpname(gid) ) return
    enddo

    prof_grpnmax      = prof_grpnmax + 1
    gid               = prof_grpnmax
    prof_grpname(gid) = grpname

    return
  end function get_grpid

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_1d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_1D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_1d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_2d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_2D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_2d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_3d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_3D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_3d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_4d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_4D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_4d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_5d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:,:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_5D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_5d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_sp_6d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(SP),         intent(in) :: var(:,:,:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_SP_6D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_sp_6d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_1d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_1D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_1d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_2d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_2D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_2d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_3d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_3D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_3d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_4d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_4D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_4d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_5d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:,:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_5D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_5d

  !-----------------------------------------------------------------------------
  subroutine prof_valcheck_dp_6d( &
       header,  &
       varname, &
       var      )
    implicit none

    character(len=*), intent(in) :: header
    character(len=*), intent(in) :: varname
    real(DP),         intent(in) :: var(:,:,:,:,:,:)
    !---------------------------------------------------------------------------

    prof_header = trim(header)
    prof_item   = trim(varname)
    prof_max    = real(maxval(var),kind=dp)
    prof_min    = real(minval(var),kind=dp)
    prof_sum    = real(sum   (var),kind=dp)
    log_info("PROF_valcheck_DP_6D",'(1x,A,A7,A,A16,3(A,ES24.16))') &
    '+',prof_header,'[',prof_item,'] max=',prof_max,',min=',prof_min,',sum=',prof_sum

    return
  end subroutine prof_valcheck_dp_6d

end module scale_prof