!--
! *** Caution!! ***
! 
! This file is generated from "dc_test.rb2f90" by Ruby 1.8.2.
! Please do not edit this file directly.
!
! [JAPANESE]
!
! ※※※ 注意!!! ※※※
!
! このファイルは "dc_test.rb2f90" から Ruby 1.8.2
! によって自動生成されたファイルです.
! このファイルを直接編集しませんようお願い致します.
!
!
!++
!
!== Test module
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dc_test.f90,v 1.7 2006/07/19 08:17:56 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20070305 $
! Copyright:: Copyright (C) GFD Dennou Club, 2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_test
!

module dc_test
  !
  !== Overview
  !
  ! Fortran 90/95 におけるテストプログラム作成を補助するための
  ! モジュールです.
  !
  !== List
  !
  ! Compare     :: 正答とチェックすべき値とを照合する.
  !
  !== Usage
  !
  ! Compare サブルーチンは以下のように用います.
  ! *answer* に正答を与え, *check* に照合すべき値を与えます.
  ! *answer* と *check* には文字型, 整数型, 単精度実数型, 倍精度実数型,
  ! 論理型の変数および
  ! 配列 (1 〜 7次元) を与えることができます.
  ! 2 つの引数の型および次元数は一致している必要があります.
  !
  !   call Compare('Title', answer='foo', check=str1)
  !
  ! もしも *answer* と *check* の値, もしくは配列のサイズが異なる場合,
  ! テストプログラムはエラーを返して終了します.
  !
  !=== 具体例
  !
  ! 具体例は以下の通りです.
  !
  !      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
  !
  !
  use dc_types, only : STRING, DP
  implicit none
  private
  public Compare

  interface Compare
                                              module procedure DCCompareChar0
                      
    module procedure DCCompareChar1
                      
    module procedure DCCompareChar2
                      
    module procedure DCCompareChar3
                      
    module procedure DCCompareChar4
                      
    module procedure DCCompareChar5
                      
    module procedure DCCompareChar6
                      
    module procedure DCCompareChar7
                      
                    
                          module procedure DCCompareInt0
                      
    module procedure DCCompareInt1
                      
    module procedure DCCompareInt2
                      
    module procedure DCCompareInt3
                      
    module procedure DCCompareInt4
                      
    module procedure DCCompareInt5
                      
    module procedure DCCompareInt6
                      
    module procedure DCCompareInt7
                      
                    
                          module procedure DCCompareReal0
                      
    module procedure DCCompareReal1
                      
    module procedure DCCompareReal2
                      
    module procedure DCCompareReal3
                      
    module procedure DCCompareReal4
                      
    module procedure DCCompareReal5
                      
    module procedure DCCompareReal6
                      
    module procedure DCCompareReal7
                      
                    
                          module procedure DCCompareDouble0
                      
    module procedure DCCompareDouble1
                      
    module procedure DCCompareDouble2
                      
    module procedure DCCompareDouble3
                      
    module procedure DCCompareDouble4
                      
    module procedure DCCompareDouble5
                      
    module procedure DCCompareDouble6
                      
    module procedure DCCompareDouble7
                      
                    

                        module procedure DCCompareLogical0
                    
    module procedure DCCompareLogical1
                    
    module procedure DCCompareLogical2
                    
    module procedure DCCompareLogical3
                    
    module procedure DCCompareLogical4
                    
    module procedure DCCompareLogical5
                    
    module procedure DCCompareLogical6
                    
    module procedure DCCompareLogical7
                    

  end interface

contains


  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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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


  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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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
end module dc_test

!--
! vi:set readonly sw=4 ts=8:
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++
