Class dc_test
In: dc_test.f90

Overview

Fortran 90/95 におけるテストプログラム作成を補助するための モジュールです.

List

Compare :正答とチェックすべき値とを照合する.

Usage

Compare サブルーチンは以下のように用います. answer に正答を与え, check に照合すべき値を与えます. answercheck には文字型, 整数型, 単精度実数型, 倍精度実数型, 論理型の変数および 配列 (1 〜 7次元) を与えることができます. 2 つの引数の型および次元数は一致している必要があります.

  call Compare('Title', answer='foo', check=str1)

もしも answercheck の値, もしくは配列のサイズが異なる場合, テストプログラムはエラーを返して終了します.

具体例

具体例は以下の通りです.

     use dc_types
     use dc_test
     character(STRING):: str1
     integer:: int1
     real:: numr1(2)
     real(DP):: numd1(2,3)
     logical:: y_n

     str1 = "foo"
     call Compare('Character', answer='foo', check=str1)
     int1 = 1
     call Compare('Integer', answer=1, check=int1)
     numr1(:) = (/0.00123, 0.2/)
     call Compare('Float', answer=(/0.00123, 0.2/), check=numr1)
     y_n = .true.
     call Compare('Logical', answer=.true., check=y_n)
     numd1(1,:) = (/19.432d0, 75.3d0, 3.183d0/)
     numd1(2,:) = (/0.023d0, 0.9d0, 328.2d0/)
     call Compare('Double precision 1', &
       & answer=(/19.432d0, 75.3d0, 3.183d0/), check=numd1(1,:))
     call Compare('Double precision 2', &
       & answer=(/0.023d0, 0.9d0, 238.5d0/), check=numd1(2,:))
     end

上記の例では, 最後のテストで敢えて間違った answer を与えているので, 以下のようなメッセージを出力してプログラムは強制終了します.

     *** MESSAGE [DCCompare] *** Checking Character OK
     *** MESSAGE [DCCompare] *** Checking Integer OK
     *** MESSAGE [DCCompare] *** Checking Float OK
     *** MESSAGE [DCCompare] *** Checking Logical OK
     *** MESSAGE [DCCompare] *** Checking Double precision 1 OK
     *** Error [DCCompare] *** Checking Double precision 2 FAILURE

      check(3) =  328.2
        is INCORRECT
      Correct answer is answer(3) =  238.5

Methods

Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare   Compare  

Included Modules

dc_types sysdep

Public Instance methods

Subroutine :
item :character(*), intent(in)
answer :character(*), intent(in)
check :character(*), intent(in)

[Source]

  subroutine DCCompareChar0(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar0
Subroutine :
item :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)

[Source]

  subroutine DCCompareInt0(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt0
Subroutine :
item :character(*), intent(in)
answer :logical, intent(in)
check :logical, intent(in)

[Source]

  subroutine DCCompareLogical0(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar0(item, answer_str, check_str)

                                        

  end subroutine DCCompareLogical0
Subroutine :
item :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble0(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 = .not. answer == check
    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble0
Subroutine :
item :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)

[Source]

  subroutine DCCompareReal0(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    real, intent(in):: answer
    real, intent(in):: check
    logical :: err_flag
    character(STRING) :: pos_str
    real :: wrong, right

                                        

                    

  continue
    err_flag = .false.

                    
    err_flag = .not. answer == check
    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal0
Subroutine :
item :character(*), intent(in)
answer(:) :character(*), intent(in)
check(:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar1(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar1
Subroutine :
item :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)

[Source]

  subroutine DCCompareInt1(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt1
Subroutine :
item :character(*), intent(in)
answer(:) :logical, intent(in)
check(:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical1(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar1(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical1
Subroutine :
item :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble1(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble1
Subroutine :
item :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)

[Source]

  subroutine DCCompareReal1(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal1
Subroutine :
item :character(*), intent(in)
answer(:,:) :character(*), intent(in)
check(:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar2(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar2
Subroutine :
item :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt2(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt2
Subroutine :
item :character(*), intent(in)
answer(:,:) :logical, intent(in)
check(:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical2(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar2(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical2
Subroutine :
item :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble2(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble2
Subroutine :
item :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal2(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal2
Subroutine :
item :character(*), intent(in)
answer(:,:,:) :character(*), intent(in)
check(:,:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar3(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar3
Subroutine :
item :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt3(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt3
Subroutine :
item :character(*), intent(in)
answer(:,:,:) :logical, intent(in)
check(:,:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical3(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar3(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical3
Subroutine :
item :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble3(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble3
Subroutine :
item :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal3(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal3
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:) :character(*), intent(in)
check(:,:,:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar4(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar4
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt4(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt4
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:) :logical, intent(in)
check(:,:,:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical4(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar4(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical4
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble4(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble4
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal4(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal4
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar5(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar5
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt5(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt5
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical5(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar5(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical5
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble5(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble5
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal5(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal5
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar6(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar6
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt6(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt6
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical6(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar6(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical6
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble6(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble6
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal6(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal6
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:,:) :character(*), intent(in)

[Source]

  subroutine DCCompareChar7(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', trim(wrong)
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', trim(right)

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareChar7
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)

[Source]

  subroutine DCCompareInt7(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareInt7
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:,:) :logical, intent(in)

[Source]

  subroutine DCCompareLogical7(item, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: item
    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 DCCompareChar7(item, answer_str, check_str)

                        deallocate(answer_str, answer_tmp, answer_str_tmp)
    deallocate(check_str, check_tmp, check_str_tmp)
                    

  end subroutine DCCompareLogical7
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)

[Source]

  subroutine DCCompareDouble7(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareDouble7
Subroutine :
item :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)

[Source]

  subroutine DCCompareReal7(item, answer, check)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: item
    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 [DCCompare] *** Checking ' // trim(item) // ' 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 [DCCompare] *** Checking ' // trim(item) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // ' = ', wrong
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct answer is answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [DCCompare] *** Checking ' // trim(item) // ' OK'
    end if


  end subroutine DCCompareReal7

[Validate]