scale_debug.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_debug
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: check
  public :: valcheck

  interface valcheck
     module procedure valcheck_1d
     module procedure valcheck_2d
     module procedure valcheck_3d
  end interface valcheck

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  integer, public :: debug_domain_num = 0

  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine check( &
       current_line, &
       v             )
    use scale_prc, only: &
       prc_abort
    use scale_const, only: &
       const_undef
    implicit none

    integer,  intent(in) :: current_line
    real(RP), intent(in) :: v
    !---------------------------------------------------------------------------

    call prof_rapstart('Debug', 1)

    if ( .NOT. ( abs(v) < abs(const_undef) ) ) then
       log_error("CHECK",*) 'uninitialized value at line:', current_line
       call abort
    end if

    call prof_rapend  ('Debug', 1)

    return
  end subroutine check

  !-----------------------------------------------------------------------------
  subroutine valcheck_1d( &
       var,          &
       valmin,       &
       valmax,       &
       varname,      &
       current_file, &
       current_line  )
    use scale_prc, only: &
       prc_abort, &
       prc_myrank
    implicit none

    real(RP),         intent(in) :: var(:)
    real(RP),         intent(in) :: valmin
    real(RP),         intent(in) :: valmax
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: current_file
    integer,          intent(in) :: current_line

    logical :: invalid_value
    integer :: k, kstr, kend
    !---------------------------------------------------------------------------

    call prof_rapstart('Debug', 1)

    kstr = lbound( var(:), 1 )
    kend = ubound( var(:), 1 )

    invalid_value = .false.
    do k = kstr, kend
       if (      var(k)*0.0_rp /= 0.0_rp &
            .OR. var(k)        <  valmin &
            .OR. var(k)        >  valmax ) then
           invalid_value = .true.
           exit
       endif
    enddo

    if ( invalid_value ) then
       log_error("VALCHECK_1D",*) 'invalid value:', trim(varname), &
                  '(', prc_myrank, ',', k, ')=', var(k)
       log_error_cont(*) 'in file   : ', trim(current_file), ', at line : ', current_line
       log_error_cont(*) 'in domain : ', debug_domain_num
       call prc_abort
    endif

    call prof_rapend  ('Debug', 1)

    return
  end subroutine valcheck_1d

  !-----------------------------------------------------------------------------
  subroutine valcheck_2d( &
       var,          &
       valmin,       &
       valmax,       &
       varname,      &
       current_file, &
       current_line  )
    use scale_prc, only: &
       prc_abort, &
       prc_myrank
    implicit none

    real(RP),         intent(in) :: var(:,:)
    real(RP),         intent(in) :: valmin
    real(RP),         intent(in) :: valmax
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: current_file
    integer,          intent(in) :: current_line

    logical :: invalid_value
    integer :: k, kstr, kend
    integer :: i, istr, iend
    !---------------------------------------------------------------------------

    call prof_rapstart('Debug', 1)

    kstr = lbound( var(:,:), 1 )
    kend = ubound( var(:,:), 1 )

    istr = lbound( var(:,:), 2 )
    iend = ubound( var(:,:), 2 )

    invalid_value = .false.
    outer:do i = istr, iend
          do k = kstr, kend
             if (      var(k,i)*0.0_rp /= 0.0_rp &
                  .OR. var(k,i)        <  valmin &
                  .OR. var(k,i)        >  valmax ) then
                 invalid_value = .true.
                 exit outer
             endif
          enddo
          enddo outer

    if ( invalid_value ) then
       log_error("VALCHECK_2D",*) 'invalid value:', trim(varname), &
                  '(', prc_myrank, ',', k, ',', i, ')=', var(k,i)
       log_error_cont(*) 'in file   : ', trim(current_file), ', at line : ', current_line
       log_error_cont(*) 'in domain : ', debug_domain_num
       call prc_abort
    endif

    call prof_rapend  ('Debug', 1)

    return
  end subroutine valcheck_2d

  !-----------------------------------------------------------------------------
  subroutine valcheck_3d( &
       var,          &
       valmin,       &
       valmax,       &
       varname,      &
       current_file, &
       current_line  )
    use scale_prc, only: &
       prc_abort, &
       prc_myrank
    implicit none

    real(RP),         intent(in) :: var(:,:,:)
    real(RP),         intent(in) :: valmin
    real(RP),         intent(in) :: valmax
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: current_file
    integer,          intent(in) :: current_line

    logical :: invalid_value
    integer :: k, kstr, kend
    integer :: i, istr, iend
    integer :: j, jstr, jend
    !---------------------------------------------------------------------------

    call prof_rapstart('Debug', 1)

    kstr = lbound( var(:,:,:), 1 )
    kend = ubound( var(:,:,:), 1 )

    istr = lbound( var(:,:,:), 2 )
    iend = ubound( var(:,:,:), 2 )

    jstr = lbound( var(:,:,:), 3 )
    jend = ubound( var(:,:,:), 3 )

    invalid_value = .false.
    outer:do j = jstr, jend
          do i = istr, iend
          do k = kstr, kend
             if (      var(k,i,j)*0.0_rp /= 0.0_rp &
                  .OR. var(k,i,j)        <  valmin &
                  .OR. var(k,i,j)        >  valmax ) then
                 invalid_value = .true.
                 exit outer
             endif
          enddo
          enddo
          enddo outer

    if ( invalid_value ) then
       log_error("VALCHECK_3D",*) 'Invalid value:', trim(varname), &
                  '(', prc_myrank, ',', k, ',', i, ',', j, ')=', var(k,i,j)
       log_error_cont(*) 'in file   : ', trim(current_file), ', at line : ', current_line
       log_error_cont(*) 'in domain : ', debug_domain_num
       call prc_abort
    endif

    call prof_rapend  ('Debug', 1)

    return
  end subroutine valcheck_3d

end module scale_debug