dc_test::assertequal Interface Reference

Public Member Functions
subroutine	dctestassertequalchar0 (message, answer, check)
subroutine	dctestassertequalchar1 (message, answer, check)
subroutine	dctestassertequalchar2 (message, answer, check)
subroutine	dctestassertequalchar3 (message, answer, check)
subroutine	dctestassertequalchar4 (message, answer, check)
subroutine	dctestassertequalchar5 (message, answer, check)
subroutine	dctestassertequalchar6 (message, answer, check)
subroutine	dctestassertequalchar7 (message, answer, check)
subroutine	dctestassertequalint0 (message, answer, check)
subroutine	dctestassertequalint1 (message, answer, check)
subroutine	dctestassertequalint2 (message, answer, check)
subroutine	dctestassertequalint3 (message, answer, check)
subroutine	dctestassertequalint4 (message, answer, check)
subroutine	dctestassertequalint5 (message, answer, check)
subroutine	dctestassertequalint6 (message, answer, check)
subroutine	dctestassertequalint7 (message, answer, check)
subroutine	dctestassertequalreal0 (message, answer, check)
subroutine	dctestassertequalreal1 (message, answer, check)
subroutine	dctestassertequalreal2 (message, answer, check)
subroutine	dctestassertequalreal3 (message, answer, check)
subroutine	dctestassertequalreal4 (message, answer, check)
subroutine	dctestassertequalreal5 (message, answer, check)
subroutine	dctestassertequalreal6 (message, answer, check)
subroutine	dctestassertequalreal7 (message, answer, check)
subroutine	dctestassertequaldouble0 (message, answer, check)
subroutine	dctestassertequaldouble1 (message, answer, check)
subroutine	dctestassertequaldouble2 (message, answer, check)
subroutine	dctestassertequaldouble3 (message, answer, check)
subroutine	dctestassertequaldouble4 (message, answer, check)
subroutine	dctestassertequaldouble5 (message, answer, check)
subroutine	dctestassertequaldouble6 (message, answer, check)
subroutine	dctestassertequaldouble7 (message, answer, check)
subroutine	dctestassertequallogical0 (message, answer, check)
subroutine	dctestassertequallogical1 (message, answer, check)
subroutine	dctestassertequallogical2 (message, answer, check)
subroutine	dctestassertequallogical3 (message, answer, check)
subroutine	dctestassertequallogical4 (message, answer, check)
subroutine	dctestassertequallogical5 (message, answer, check)
subroutine	dctestassertequallogical6 (message, answer, check)
subroutine	dctestassertequallogical7 (message, answer, check)
subroutine	dctestassertequalreal0digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal1digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal2digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal3digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal4digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal5digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal6digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequalreal7digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble0digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble1digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble2digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble3digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble4digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble5digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble6digits (message, answer, check, significant_digits, ignore_digits)
subroutine	dctestassertequaldouble7digits (message, answer, check, significant_digits, ignore_digits)

Detailed Description

Definition at line 160 of file dc_test.f90.

Member Function/Subroutine Documentation

dctestassertequalchar0()

subroutine dc_test::assertequal::dctestassertequalchar0	(	character(*), intent(in)	message,
		character(*), intent(in)	answer,
		character(*), intent(in)	check
	)

Definition at line 395 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer
    character(*), intent(in):: check
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                                        
 
                                                                
                    
 
  continue
    err_flag = .false.
 
                    
        err_flag = .not. trim(answer) == trim(check)
    
    wrong = check
    right = answer
    pos_str = ''
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequalchar1()

subroutine dc_test::assertequal::dctestassertequalchar1	(	character(*), intent(in)	message,
		character(*), dimension(:), intent(in)	answer,
		character(*), dimension(:), intent(in)	check
	)

Definition at line 440 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:)
    character(*), intent(in):: check(:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:)
    character(STRING), allocatable:: check_fixed_length(:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                        
      &    answer_shape(1)  )  &
      &  )
 
    allocate( check_fixed_length( &
                        
      &    check_shape(1)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right = answer( &
                      
        &    pos(1)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar2()

subroutine dc_test::assertequal::dctestassertequalchar2	(	character(*), intent(in)	message,
		character(*), dimension(:,:), intent(in)	answer,
		character(*), dimension(:,:), intent(in)	check
	)

Definition at line 562 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:)
    character(*), intent(in):: check(:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:)
    character(STRING), allocatable:: check_fixed_length(:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar3()

subroutine dc_test::assertequal::dctestassertequalchar3	(	character(*), intent(in)	message,
		character(*), dimension(:,:,:), intent(in)	answer,
		character(*), dimension(:,:,:), intent(in)	check
	)

Definition at line 694 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:,:)
    character(*), intent(in):: check(:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar4()

subroutine dc_test::assertequal::dctestassertequalchar4	(	character(*), intent(in)	message,
		character(*), dimension(:,:,:,:), intent(in)	answer,
		character(*), dimension(:,:,:,:), intent(in)	check
	)

Definition at line 844 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:,:,:)
    character(*), intent(in):: check(:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar5()

subroutine dc_test::assertequal::dctestassertequalchar5	(	character(*), intent(in)	message,
		character(*), dimension(:,:,:,:,:), intent(in)	answer,
		character(*), dimension(:,:,:,:,:), intent(in)	check
	)

Definition at line 1012 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:,:,:,:)
    character(*), intent(in):: check(:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar6()

subroutine dc_test::assertequal::dctestassertequalchar6	(	character(*), intent(in)	message,
		character(*), dimension(:,:,:,:,:,:), intent(in)	answer,
		character(*), dimension(:,:,:,:,:,:), intent(in)	check
	)

Definition at line 1198 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:,:,:,:,:)
    character(*), intent(in):: check(:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5), &
                        
      &    answer_shape(6)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5), &
                        
      &    check_shape(6)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalchar7()

subroutine dc_test::assertequal::dctestassertequalchar7	(	character(*), intent(in)	message,
		character(*), dimension(:,:,:,:,:,:,:), intent(in)	answer,
		character(*), dimension(:,:,:,:,:,:,:), intent(in)	check
	)

Definition at line 1402 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    character(*), intent(in):: answer(:,:,:,:,:,:,:)
    character(*), intent(in):: check(:,:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    character(STRING):: wrong, right
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    
 
                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:,:,:)
                      
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
                      
    allocate( answer_fixed_length( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5), &
                        
      &    answer_shape(6), &
                        
      &    answer_shape(7)  )  &
      &  )
 
    allocate( check_fixed_length( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5), &
                        
      &    check_shape(6), &
                        
      &    check_shape(7)  )  &
      &  )
 
    answer_fixed_length = answer
    check_fixed_length = check
 
    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble0()

subroutine dc_test::assertequal::dctestassertequaldouble0	(	character(*), intent(in)	message,
		real(dp), intent(in)	answer,
		real(dp), intent(in)	check
	)

Definition at line 3712 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                                        
 
                    
 
  continue
    err_flag = .false.
 
                    
        err_flag = abs(answer - check) > 0.0_dp
    
    wrong = check
    right = answer
    pos_str = ''
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequaldouble0digits()

subroutine dc_test::assertequal::dctestassertequaldouble0digits	(	character(*), intent(in)	message,
		real(dp), intent(in)	answer,
		real(dp), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 7185 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        real(DP):: answer_max
    real(DP):: answer_min
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    if ( answer < 0.0_dp .and. check < 0.0_dp ) then
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    else
 
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end if
 
    wrong = check
    right_max = answer_max
    right_min = answer_min
    if ( right_max < right_min ) then
      right_tmp = right_max
      right_max = right_min
      right_min = right_tmp
    end if
 
    err_flag = .not. (answer_max > check .and. check > answer_min)
 
    pos_str = ''
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequaldouble1()

subroutine dc_test::assertequal::dctestassertequaldouble1	(	character(*), intent(in)	message,
		real(dp), dimension(:), intent(in)	answer,
		real(dp), dimension(:), intent(in)	check
	)

Definition at line 3756 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right = answer( &
                      
        &    pos(1)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble1digits()

subroutine dc_test::assertequal::dctestassertequaldouble1digits	(	character(*), intent(in)	message,
		real(dp), dimension(:), intent(in)	answer,
		real(dp), dimension(:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 7277 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
    real(DP), allocatable:: answer_max(:)
    real(DP), allocatable:: answer_min(:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( check_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( both_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_max( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_min( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right_max = answer_max( &
                      
        &    pos(1)  )
 
      right_min = answer_min( &
                      
        &    pos(1)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble2()

subroutine dc_test::assertequal::dctestassertequaldouble2	(	character(*), intent(in)	message,
		real(dp), dimension(:,:), intent(in)	answer,
		real(dp), dimension(:,:), intent(in)	check
	)

Definition at line 3862 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble2digits()

subroutine dc_test::assertequal::dctestassertequaldouble2digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:), intent(in)	answer,
		real(dp), dimension(:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 7462 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
    real(DP), allocatable:: answer_max(:,:)
    real(DP), allocatable:: answer_min(:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble3()

subroutine dc_test::assertequal::dctestassertequaldouble3	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:), intent(in)	check
	)

Definition at line 3976 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble3digits()

subroutine dc_test::assertequal::dctestassertequaldouble3digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 7661 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
    real(DP), allocatable:: answer_max(:,:,:)
    real(DP), allocatable:: answer_min(:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble4()

subroutine dc_test::assertequal::dctestassertequaldouble4	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:), intent(in)	check
	)

Definition at line 4104 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble4digits()

subroutine dc_test::assertequal::dctestassertequaldouble4digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 7886 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble5()

subroutine dc_test::assertequal::dctestassertequaldouble5	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:), intent(in)	check
	)

Definition at line 4246 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble5digits()

subroutine dc_test::assertequal::dctestassertequaldouble5digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 8137 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble6()

subroutine dc_test::assertequal::dctestassertequaldouble6	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:,:), intent(in)	check
	)

Definition at line 4402 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble6digits()

subroutine dc_test::assertequal::dctestassertequaldouble6digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 8414 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble7()

subroutine dc_test::assertequal::dctestassertequaldouble7	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:,:,:), intent(in)	check
	)

Definition at line 4572 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0_dp
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequaldouble7digits()

subroutine dc_test::assertequal::dctestassertequaldouble7digits	(	character(*), intent(in)	message,
		real(dp), dimension(:,:,:,:,:,:,:), intent(in)	answer,
		real(dp), dimension(:,:,:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 8717 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    answer_negative = answer < 0.0_dp
    check_negative = check < 0.0_dp
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_dp &
        &       + 0.1_dp ** significant_digits ) &
        & + 0.1_dp ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0_dp &
        &       - 0.1_dp ** significant_digits ) &
        & - 0.1_dp ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint0()

subroutine dc_test::assertequal::dctestassertequalint0	(	character(*), intent(in)	message,
		integer, intent(in)	answer,
		integer, intent(in)	check
	)

Definition at line 1624 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer
    integer, intent(in):: check
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                                        
 
                    
 
  continue
    err_flag = .false.
 
                    
        err_flag = .not. answer == check
    
    wrong = check
    right = answer
    pos_str = ''
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequalint1()

subroutine dc_test::assertequal::dctestassertequalint1	(	character(*), intent(in)	message,
		integer, dimension(:), intent(in)	answer,
		integer, dimension(:), intent(in)	check
	)

Definition at line 1668 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:)
    integer, intent(in):: check(:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right = answer( &
                      
        &    pos(1)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint2()

subroutine dc_test::assertequal::dctestassertequalint2	(	character(*), intent(in)	message,
		integer, dimension(:,:), intent(in)	answer,
		integer, dimension(:,:), intent(in)	check
	)

Definition at line 1774 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:)
    integer, intent(in):: check(:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint3()

subroutine dc_test::assertequal::dctestassertequalint3	(	character(*), intent(in)	message,
		integer, dimension(:,:,:), intent(in)	answer,
		integer, dimension(:,:,:), intent(in)	check
	)

Definition at line 1888 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:)
    integer, intent(in):: check(:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint4()

subroutine dc_test::assertequal::dctestassertequalint4	(	character(*), intent(in)	message,
		integer, dimension(:,:,:,:), intent(in)	answer,
		integer, dimension(:,:,:,:), intent(in)	check
	)

Definition at line 2016 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:)
    integer, intent(in):: check(:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint5()

subroutine dc_test::assertequal::dctestassertequalint5	(	character(*), intent(in)	message,
		integer, dimension(:,:,:,:,:), intent(in)	answer,
		integer, dimension(:,:,:,:,:), intent(in)	check
	)

Definition at line 2158 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint6()

subroutine dc_test::assertequal::dctestassertequalint6	(	character(*), intent(in)	message,
		integer, dimension(:,:,:,:,:,:), intent(in)	answer,
		integer, dimension(:,:,:,:,:,:), intent(in)	check
	)

Definition at line 2314 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalint7()

subroutine dc_test::assertequal::dctestassertequalint7	(	character(*), intent(in)	message,
		integer, dimension(:,:,:,:,:,:,:), intent(in)	answer,
		integer, dimension(:,:,:,:,:,:,:), intent(in)	check
	)

Definition at line 2484 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    integer:: wrong, right
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
                      
                          judge = answer == check
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequallogical0()

subroutine dc_test::assertequal::dctestassertequallogical0	(	character(*), intent(in)	message,
		logical, intent(in)	answer,
		logical, intent(in)	check
	)

Definition at line 4755 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer
    logical, intent(in):: check
 
                        character(STRING):: answer_str
    character(STRING):: check_str
                    
 
 
  continue
 
                    
    if (answer) then
      answer_str = ".true."
    else
      answer_str = ".false."
    end if
 
    if (check) then
      check_str = ".true."
    else
      check_str = ".false."
    end if
 
                    
 
    call dctestassertequalchar0(message, answer_str, check_str)
 
                                        
 

References dc_types::string.

dctestassertequallogical1()

subroutine dc_test::assertequal::dctestassertequallogical1	(	character(*), intent(in)	message,
		logical, dimension(:), intent(in)	answer,
		logical, dimension(:), intent(in)	check
	)

Definition at line 4789 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:)
    logical, intent(in):: check(:)
 
                        integer:: answer_shape(1), check_shape(1), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:)
    character(STRING), allocatable:: check_str(:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( check_str( &
                      
      &    check_shape(1)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar1(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical2()

subroutine dc_test::assertequal::dctestassertequallogical2	(	character(*), intent(in)	message,
		logical, dimension(:,:), intent(in)	answer,
		logical, dimension(:,:), intent(in)	check
	)

Definition at line 4855 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:)
    logical, intent(in):: check(:,:)
 
                        integer:: answer_shape(2), check_shape(2), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:)
    character(STRING), allocatable:: check_str(:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar2(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical3()

subroutine dc_test::assertequal::dctestassertequallogical3	(	character(*), intent(in)	message,
		logical, dimension(:,:,:), intent(in)	answer,
		logical, dimension(:,:,:), intent(in)	check
	)

Definition at line 4923 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:)
    logical, intent(in):: check(:,:,:)
 
                        integer:: answer_shape(3), check_shape(3), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:)
    character(STRING), allocatable:: check_str(:,:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar3(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical4()

subroutine dc_test::assertequal::dctestassertequallogical4	(	character(*), intent(in)	message,
		logical, dimension(:,:,:,:), intent(in)	answer,
		logical, dimension(:,:,:,:), intent(in)	check
	)

Definition at line 4995 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:)
    logical, intent(in):: check(:,:,:,:)
 
                        integer:: answer_shape(4), check_shape(4), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar4(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical5()

subroutine dc_test::assertequal::dctestassertequallogical5	(	character(*), intent(in)	message,
		logical, dimension(:,:,:,:,:), intent(in)	answer,
		logical, dimension(:,:,:,:,:), intent(in)	check
	)

Definition at line 5071 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:)
 
                        integer:: answer_shape(5), check_shape(5), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar5(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical6()

subroutine dc_test::assertequal::dctestassertequallogical6	(	character(*), intent(in)	message,
		logical, dimension(:,:,:,:,:,:), intent(in)	answer,
		logical, dimension(:,:,:,:,:,:), intent(in)	check
	)

Definition at line 5151 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:,:)
 
                        integer:: answer_shape(6), check_shape(6), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5), &
                      
      &    check_shape(6)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar6(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequallogical7()

subroutine dc_test::assertequal::dctestassertequallogical7	(	character(*), intent(in)	message,
		logical, dimension(:,:,:,:,:,:,:), intent(in)	answer,
		logical, dimension(:,:,:,:,:,:,:), intent(in)	check
	)

Definition at line 5235 of file dc_test.f90.

    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:,:,:)
 
                        integer:: answer_shape(7), check_shape(7), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:,:,:)
                    
 
 
  continue
 
                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)
 
    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do
 
    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do
 
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    allocate( answer_str( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( check_str( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5), &
                      
      &    check_shape(6), &
                      
      &    check_shape(7)  )  &
      &  )
 
    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)
 
                    
 
    call dctestassertequalchar7(message, answer_str, check_str)
 
                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    
 

References dc_types::string.

dctestassertequalreal0()

subroutine dc_test::assertequal::dctestassertequalreal0	(	character(*), intent(in)	message,
		real, intent(in)	answer,
		real, intent(in)	check
	)

Definition at line 2668 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                                        
 
                    
 
  continue
    err_flag = .false.
 
                    
        err_flag = abs(answer - check) > 0.0
    
    wrong = check
    right = answer
    pos_str = ''
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequalreal0digits()

subroutine dc_test::assertequal::dctestassertequalreal0digits	(	character(*), intent(in)	message,
		real, intent(in)	answer,
		real, intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 5324 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        real:: answer_max
    real:: answer_min
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    if ( answer < 0.0 .and. check < 0.0 ) then
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    else
 
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end if
 
    wrong = check
    right_max = answer_max
    right_min = answer_min
    if ( right_max < right_min ) then
      right_tmp = right_max
      right_max = right_min
      right_min = right_tmp
    end if
 
    err_flag = .not. (answer_max > check .and. check > answer_min)
 
    pos_str = ''
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), and dc_types::string.

Here is the call graph for this function:

dctestassertequalreal1()

subroutine dc_test::assertequal::dctestassertequalreal1	(	character(*), intent(in)	message,
		real, dimension(:), intent(in)	answer,
		real, dimension(:), intent(in)	check
	)

Definition at line 2712 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right = answer( &
                      
        &    pos(1)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal1digits()

subroutine dc_test::assertequal::dctestassertequalreal1digits	(	character(*), intent(in)	message,
		real, dimension(:), intent(in)	answer,
		real, dimension(:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 5416 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
    real, allocatable:: answer_max(:)
    real, allocatable:: answer_min(:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( judge_rev( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( check_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( both_negative( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_max( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    allocate( answer_min( &
                      
      &    answer_shape(1)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                      
        &    pos(1)  )
 
      right_max = answer_max( &
                      
        &    pos(1)  )
 
      right_min = answer_min( &
                      
        &    pos(1)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
 
      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal2()

subroutine dc_test::assertequal::dctestassertequalreal2	(	character(*), intent(in)	message,
		real, dimension(:,:), intent(in)	answer,
		real, dimension(:,:), intent(in)	check
	)

Definition at line 2818 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal2digits()

subroutine dc_test::assertequal::dctestassertequalreal2digits	(	character(*), intent(in)	message,
		real, dimension(:,:), intent(in)	answer,
		real, dimension(:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 5601 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
    real, allocatable:: answer_max(:,:)
    real, allocatable:: answer_min(:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal3()

subroutine dc_test::assertequal::dctestassertequalreal3	(	character(*), intent(in)	message,
		real, dimension(:,:,:), intent(in)	answer,
		real, dimension(:,:,:), intent(in)	check
	)

Definition at line 2932 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal3digits()

subroutine dc_test::assertequal::dctestassertequalreal3digits	(	character(*), intent(in)	message,
		real, dimension(:,:,:), intent(in)	answer,
		real, dimension(:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 5800 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
    real, allocatable:: answer_max(:,:,:)
    real, allocatable:: answer_min(:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal4()

subroutine dc_test::assertequal::dctestassertequalreal4	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:), intent(in)	check
	)

Definition at line 3060 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal4digits()

subroutine dc_test::assertequal::dctestassertequalreal4digits	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 6025 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal5()

subroutine dc_test::assertequal::dctestassertequalreal5	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:), intent(in)	check
	)

Definition at line 3202 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal5digits()

subroutine dc_test::assertequal::dctestassertequalreal5digits	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 6276 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal6()

subroutine dc_test::assertequal::dctestassertequalreal6	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:,:), intent(in)	check
	)

Definition at line 3358 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal6digits()

subroutine dc_test::assertequal::dctestassertequalreal6digits	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 6553 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal7()

subroutine dc_test::assertequal::dctestassertequalreal7	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:,:,:), intent(in)	check
	)

Definition at line 3528 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    
 
                    
 
  continue
    err_flag = .false.
 
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
                      
                          judge = abs(answer - check) <= 0.0
                      
 
                      
 
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right = answer( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
 
                    
 
 
    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

dctestassertequalreal7digits()

subroutine dc_test::assertequal::dctestassertequalreal7digits	(	character(*), intent(in)	message,
		real, dimension(:,:,:,:,:,:,:), intent(in)	answer,
		real, dimension(:,:,:,:,:,:,:), intent(in)	check,
		integer, intent(in)	significant_digits,
		integer, intent(in)	ignore_digits
	)

Definition at line 6856 of file dc_test.f90.

    use sysdep, only: abortprogram
    use dc_types, only: string, token
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp
 
                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:,:,:)
                    
  continue
    err_flag = .false.
 
    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call abortprogram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)
 
    consist_shape = answer_shape == check_shape
 
    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'
 
      call abortprogram('')
    end if
 
 
    allocate( mask_array( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( judge_rev( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( check_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( both_negative( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_max( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    allocate( answer_min( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )
 
    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
 
    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)
 
      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where
 
    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)
 
    if (err_flag) then
 
      wrong = check( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right_max = answer_max( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      right_min = answer_min( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )
 
      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if
 
                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      
 
      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'
 
    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)
 
                    
 
    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)
 
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max
 
      call abortprogram('')
    else
      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'
    end if
 
 

References sysdep::abortprogram(), dc_types::string, and dc_types::token.

Here is the call graph for this function:

---

The documentation for this interface was generated from the following file:

• /build/gtool5-1.0.0~rc5/debian/build-parallel/src/dc_utils/dc_test.f90