!--
! *** 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
! によって自動生成されたファイルです.
! このファイルを直接編集しませんようお願い致します.
!
!
!++
!
!= テストプログラム作成支援
!
!= Support making test programs
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dc_test.f90,v 1.18 2007-09-13 08:57:14 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20080812 $
! Copyright:: Copyright (C) GFD Dennou Club, 2005-2007. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!

module dc_test
  !
  != テストプログラム作成支援
  !
  != Support making test programs
  !
  ! <b>Note that Japanese and English are described in parallel.</b>
  !
  ! Fortran 90/95 におけるテストプログラム作成を補助するための
  ! モジュールです.
  !
  ! {オブジェクト指向スクリプト言語 Ruby}[http://www.ruby-lang.org/]
  ! の {Test::Unit クラス}[http://www.ruby-lang.org/ja/man/?cmd=view;name=Test%3A%3AUnit]
  ! の機能の一部を模倣しています.
  !
  ! This module supports making Fortran 90/95 test programs.
  !
  ! A part of {Test::Unit class}[http://www.ruby-lang.org/ja/man/?cmd=view;name=Test%3A%3AUnit] 
  ! in {Object-oriented programming language Ruby}[http://www.ruby-lang.org/]
  ! is imitated.
  !
  !== Procedures List
  !
  ! AssertEqual        :: 正答とチェックすべき値が等しいことをチェックする.
  ! AssertGreaterThan  :: ある値よりもチェックすべき値が大きいことをチェックする.
  ! AssertLessThan     :: ある値よりもチェックすべき値が小さいことをチェックする.
  ! ------------       :: ------------
  ! AssertEqual        :: It is verified that a examined value is equal to 
  !                       a right answer. 
  ! AssertGreaterThan  :: It is verified that examined value is greater than
  !                       a certain value. 
  ! AssertLessThan     :: It is verified that examined value is less than
  !                       a certain value. 
  !
  !== Usage
  !
  ! AssertEqual サブルーチンの使用例として, 以下に簡単な
  ! テストプログラムを記します. 
  ! *message* にはテストプログラムを実行した際に表示する
  ! 任意の長さの文字列を与えます. 
  ! そして, *answer* には正答を, *check* には照合すべき値を与えます.
  ! *answer* と *check* にはそれぞれ文字型, 整数型, 単精度実数型, 
  ! 倍精度実数型, 論理型の変数および
  ! 配列 (1 〜 7次元) を与えることができます. 
  ! 2 つの引数の型および次元数は一致している必要があります. 
  !
  ! A simple test program is showed as an example of how "AssertEqual" 
  ! subroutine is used as follows. 
  ! Give arbitrary length string to *message*. This string is displayed 
  ! when the test program is execute. 
  ! And give the right answer to *answer*, examined value to *check*. 
  ! Character, integer, simple precision real, double precision real, 
  ! logical variables and arrays (rank 1 - 7) are allowed to 
  ! give to *answer* and *check*. 
  ! The types of *answer* and *check* must be same. 
  !
  !
  !   program test
  !     use dc_test, only: AssertEqual
  !     implicit none
  !     character(32):: str1
  !     real:: r1(2)
  !   
  !     str1 = 'foo'
  !     r1 = (/ 1.0, 2.0 /)
  !     call AssertEqual(message='String test', answer='foo', check=str1)
  !     call AssertEqual(message='Float test', &
  !       & answer=(/1.0, 2.0/), check=r1)
  !   end program test
  !
  !
  ! *check* と *answer* との値, および配列のサイズが一致する場合に
  ! テストプログラムは「Checking <i><*message* に与えられた文字></i> OK」
  ! というメッセージを表示します. プログラムは続行します.
  ! AssertEqual の代わりに AssertGreaterThan を使用する場合には
  ! *check* が *answer* よりも大きい場合,
  ! AssertLessThan を使用する場合には *check* が *answer* よりも小さい場合に
  ! プログラムは続行します.
  !
  ! 一方で *answer* と *check* の値, もしくは配列のサイズが異なる場合には,
  ! テストプログラムは「Checking <i><*message* に与えられた文字></i> FAILURE」
  ! というメッセージを表示します. プログラムはエラーを発生させて終了します.
  ! AssertEqual の代わりに AssertGreaterThan を使用する場合には
  ! *check* が *answer* よりも大きくない場合,
  ! AssertLessThan を使用する場合には *check* が *answer* よりも
  ! 小さくない場合にプログラムは終了します.
  !
  !
  ! When the values and array sizes of *check* and *answer* are same, 
  ! the test program displays a message 
  ! "Checking <i><string given to *message*></i> OK", and the program 
  ! continues. Using "AssertGreaterThan" instead of "AssertEqual", 
  ! the program continues when *check* is greater than *answer*.
  ! Using "AssertLessThan", 
  ! the program continues when *check* is less than *answer*.
  !
  ! On the other hand, when the values or array sizes of *check* and 
  ! *answer* are different, the test program displays a message 
  ! "Checking <i><string given to *message*></i> FAILURE", and the 
  ! program aborts. Using "AssertGreaterThan" instead of "AssertEqual", 
  ! the program aborts when *check* is not greater than *answer*.
  ! Using "AssertLessThan", 
  ! the program aborts when *check* is not less than *answer*.
  ! 
  !
  !=== 精度の指定
  !=== Specification of accuracy
  !
  ! 単精度実数型, 倍精度実数型同士の比較において, 
  ! 丸め誤差や情報落ち誤差を考慮したい場合には, 
  ! 引数 *significant_digits*, *ignore_digits* に整数型を与えてください. 
  ! *significant_digits* には有効数字の桁数を, *ignore_digits* には 
  ! 無視するオーダーを与えます. 以下の例では, 有効数字の桁数を 7 とし, 
  ! 1.0e-6 以下の数値を無視して値の比較を行っています. 
  !
  ! About comparison of single precision reals or double precision reals, 
  ! in order to consider rounding errors and information loss errors, 
  ! specify integer to *significant_digits*, *ignore_digits* arguments. 
  ! Specify significant digits to *significant_digits*, and 
  ! negligible order to *ignore_digits*. 
  ! In the following example, significant digits is 7, and
  ! numerical value less than 1.0e-6 is ignored. 
  !
  !   program test2
  !     use dc_test, only: AssertEqual
  !     implicit none
  !     real:: numd1(2,3)
  !   
  !     numd1 = reshape((/-19.432,  75.3, 3.183, &
  !       &                 0.023,  -0.9, 328.2/), &
  !       &              (/2,3/))
  !   
  !     call AssertEqual( 'Float (single precision) test', &
  !       & answer = numd1, &
  !       & check = ( numd1 / 3.0 ) * 3.0, &
  !       & significant_digits = 7, ignore_digits = -6 )
  !   
  !   end program test2
  !
  !
  !=== 負の値の取り扱い
  !=== Treatment of negative values
  !
  ! 比較される *answer* の値と *check* の値が両方とも負の場合,
  ! AssertGreaterThan および AssertLessThan は 2 つの値の絶対値の
  ! 比較を行います. エラーメッセージは以下のようになります.
  ! オプショナル引数 *negative_support* に .false. を与える場合, 
  ! 絶対値での比較を行いません.
  !
  ! "AssertGreaterThan" and "AssertLessThan" compare absolute values
  ! of *answer* and *check* when both compared two values are negative.
  ! In this case, error message is as follows. 
  ! When an optional argument *negative_support* is .false., 
  ! the comparison with absolute values is not done.
  !
  !   ABSOLUTE value of check(14,1)  =  -1.189774221E-09
  !     is NOT LESS THAN
  !   ABSOLUTE value of answer(14,1) =  -1.189774405E-09
  !
  !
  !=== 使用例
  !=== Example
  !
  ! 使用例は以下の通りです.
  !
  ! Example of use is showed as follows.
  !
  !
  !   program test_sample
  !     use dc_types, only: STRING, DP
  !     use dc_test, only: AssertEqual, AssertGreaterThan, AssertLessThan
  !     implicit none
  !     character(STRING):: str1, str2
  !     real:: r1(2)
  !     integer:: int1
  !     real:: numr1(2)
  !     real(DP):: numd1(2,3), numd2(2,3)
  !     logical:: y_n
  !   continue
  !   
  !     str1 = 'foo'
  !     r1 = (/ 1.0_DP, 2.0_DP /)
  !     call AssertEqual( message = 'String test', answer = 'foo', check = str1 )
  !     call AssertEqual( message = 'Float test', &
  !       & answer = (/1.0e0, 2.0e0/), check = r1 )
  !   
  !     str2 = "foo"
  !     call AssertEqual( 'Character test', answer = 'foo', check = str2 )
  !     int1 = 1
  !     call AssertEqual( 'Integer test', answer = 1, check = int1 )
  !     numr1(:) = (/ 0.001235423, 0.248271 /)
  !     call AssertGreaterThan( 'Float test 1', &
  !       & answer = (/ 0.00061771142, 0.1241354 /), check = numr1 / 2.0 )
  !     call AssertLessThan( 'Float test 2', &
  !       & answer = (/ 0.00061771158, 0.1241358 /), check = numr1 / 2.0 )
  !     y_n = .true.
  !     call AssertEqual( 'Logical test', answer = .true., check = y_n )
  !   
  !     numd1 = reshape( (/ -19.432_DP, 75.3_DP, 3.183_DP, &
  !       &                  0.023_DP,  -0.9_DP, 328.2_DP /), &
  !       &              (/ 2,3 /) )
  !     call AssertGreaterThan( 'Double precision test 1', &
  !       & answer = reshape( (/ -38.8639_DP, 150.5999_DP, 6.365999_DP, &
  !       &                     0.0459999_DP,  -1.7999_DP, 656.3999_DP /), &
  !       &                   (/ 2,3 /) ), &
  !       & check = numd1*2.0_DP )
  !     call AssertLessThan( 'Double precision test 2', &
  !       & answer = reshape( (/ -38.86401_DP, 150.60001_DP,  6.3660001_DP, &
  !       &                     0.04600001_DP, -1.8000001_DP,     656.6_DP /), &
  !       &                   (/ 2,3 /) ), &
  !       & check = numd1*2.0_DP, negative_support=.true. )
  !   
  !     call AssertEqual( 'Double precision test 3', &
  !       & answer = numd1, &
  !       & check = ( numd1 / 3.0_DP ) * 3.0_DP, &
  !       & significant_digits = 10, ignore_digits = -10 )
  !   
  !     numd2 = reshape( (/  19.4e+7_DP,     75.3_DP, 3.18e-7_DP, &
  !       &                   0.023e-7_DP, 0.9e+7_DP,   328.2_DP /), &
  !       &              (/ 2,3 /) )
  !   
  !     call AssertEqual( 'Double precision test 4', &
  !       & answer = numd2, &
  !       & check = ( ( ( numd2 + 0.008_DP - 0.008_DP ) / 1.5_DP ) * 3.0_DP ) / 2.0_DP, &
  !       & significant_digits = 10, ignore_digits = -15 )
  !   
  !     call AssertEqual( 'Double precision test 5', &
  !       & answer = numd2, &
  !       & check = ( ( ( numd2 + 0.008_DP - 0.008_DP ) / 1.5_DP ) * 3.0_DP ) / 2.0_DP, &
  !       & significant_digits = 15, ignore_digits = -19 )
  !   
  !   end program test_sample
  !
  !
  ! 上記の例では, 最後のテストで敢えて小さすぎる値を無視するオーダー
  ! として設定しているため, 以下のようなメッセージを出力して
  ! プログラムは強制終了します.
  !
  ! In above example, too small negligible order is specified on purpose 
  ! in the last test. Then the program displays a following message, 
  ! and aborts.
  !
  !     *** MESSAGE [AssertEQ] *** Checking String test OK
  !     *** MESSAGE [AssertEQ] *** Checking Float test OK
  !     *** MESSAGE [AssertEQ] *** Checking Character test OK
  !     *** MESSAGE [AssertEQ] *** Checking Integer test OK
  !     *** MESSAGE [AssertGT] *** Checking Float test 1 OK
  !     *** MESSAGE [AssertLT] *** Checking Float test 2 OK
  !     *** MESSAGE [AssertEQ] *** Checking Logical test OK
  !     *** MESSAGE [AssertGT] *** Checking Double precision test 1 OK
  !     *** MESSAGE [AssertLT] *** Checking Double precision test 2 OK
  !     *** MESSAGE [AssertEQ] *** Checking Double precision test 3 OK
  !     *** MESSAGE [AssertEQ] *** Checking Double precision test 4 OK
  !     *** Error [AssertEQ] *** Checking Double precision test 5 FAILURE
  !    
  !      check(1,2)  =  3.179999999991523E-07
  !        is NOT EQUAL to
  !                     3.179999999998997E-07  < 
  !      answer(1,2) <  3.180000000001004E-07
  !   
  !
  use dc_types, only : STRING, DP
  implicit none
  private
  public AssertEqual, AssertGreaterThan, AssertLessThan

  interface AssertEqual
                                              module procedure DCTestAssertEqualChar0
                      
    module procedure DCTestAssertEqualChar1
                      
    module procedure DCTestAssertEqualChar2
                      
    module procedure DCTestAssertEqualChar3
                      
    module procedure DCTestAssertEqualChar4
                      
    module procedure DCTestAssertEqualChar5
                      
    module procedure DCTestAssertEqualChar6
                      
    module procedure DCTestAssertEqualChar7
                      
                    
                          module procedure DCTestAssertEqualInt0
                      
    module procedure DCTestAssertEqualInt1
                      
    module procedure DCTestAssertEqualInt2
                      
    module procedure DCTestAssertEqualInt3
                      
    module procedure DCTestAssertEqualInt4
                      
    module procedure DCTestAssertEqualInt5
                      
    module procedure DCTestAssertEqualInt6
                      
    module procedure DCTestAssertEqualInt7
                      
                    
                          module procedure DCTestAssertEqualReal0
                      
    module procedure DCTestAssertEqualReal1
                      
    module procedure DCTestAssertEqualReal2
                      
    module procedure DCTestAssertEqualReal3
                      
    module procedure DCTestAssertEqualReal4
                      
    module procedure DCTestAssertEqualReal5
                      
    module procedure DCTestAssertEqualReal6
                      
    module procedure DCTestAssertEqualReal7
                      
                    
                          module procedure DCTestAssertEqualDouble0
                      
    module procedure DCTestAssertEqualDouble1
                      
    module procedure DCTestAssertEqualDouble2
                      
    module procedure DCTestAssertEqualDouble3
                      
    module procedure DCTestAssertEqualDouble4
                      
    module procedure DCTestAssertEqualDouble5
                      
    module procedure DCTestAssertEqualDouble6
                      
    module procedure DCTestAssertEqualDouble7
                      
                    

                        module procedure DCTestAssertEqualLogical0
                    
    module procedure DCTestAssertEqualLogical1
                    
    module procedure DCTestAssertEqualLogical2
                    
    module procedure DCTestAssertEqualLogical3
                    
    module procedure DCTestAssertEqualLogical4
                    
    module procedure DCTestAssertEqualLogical5
                    
    module procedure DCTestAssertEqualLogical6
                    
    module procedure DCTestAssertEqualLogical7
                    

                                              module procedure DCTestAssertEqualReal0Digits
                      
    module procedure DCTestAssertEqualReal1Digits
                      
    module procedure DCTestAssertEqualReal2Digits
                      
    module procedure DCTestAssertEqualReal3Digits
                      
    module procedure DCTestAssertEqualReal4Digits
                      
    module procedure DCTestAssertEqualReal5Digits
                      
    module procedure DCTestAssertEqualReal6Digits
                      
    module procedure DCTestAssertEqualReal7Digits
                      
                    
                          module procedure DCTestAssertEqualDouble0Digits
                      
    module procedure DCTestAssertEqualDouble1Digits
                      
    module procedure DCTestAssertEqualDouble2Digits
                      
    module procedure DCTestAssertEqualDouble3Digits
                      
    module procedure DCTestAssertEqualDouble4Digits
                      
    module procedure DCTestAssertEqualDouble5Digits
                      
    module procedure DCTestAssertEqualDouble6Digits
                      
    module procedure DCTestAssertEqualDouble7Digits
                      
                    

  end interface

  interface AssertGreaterThan
                                              module procedure DCTestAssertGreaterThanInt0
                      
    module procedure DCTestAssertGreaterThanInt1
                      
    module procedure DCTestAssertGreaterThanInt2
                      
    module procedure DCTestAssertGreaterThanInt3
                      
    module procedure DCTestAssertGreaterThanInt4
                      
    module procedure DCTestAssertGreaterThanInt5
                      
    module procedure DCTestAssertGreaterThanInt6
                      
    module procedure DCTestAssertGreaterThanInt7
                      
                    
                          module procedure DCTestAssertGreaterThanReal0
                      
    module procedure DCTestAssertGreaterThanReal1
                      
    module procedure DCTestAssertGreaterThanReal2
                      
    module procedure DCTestAssertGreaterThanReal3
                      
    module procedure DCTestAssertGreaterThanReal4
                      
    module procedure DCTestAssertGreaterThanReal5
                      
    module procedure DCTestAssertGreaterThanReal6
                      
    module procedure DCTestAssertGreaterThanReal7
                      
                    
                          module procedure DCTestAssertGreaterThanDouble0
                      
    module procedure DCTestAssertGreaterThanDouble1
                      
    module procedure DCTestAssertGreaterThanDouble2
                      
    module procedure DCTestAssertGreaterThanDouble3
                      
    module procedure DCTestAssertGreaterThanDouble4
                      
    module procedure DCTestAssertGreaterThanDouble5
                      
    module procedure DCTestAssertGreaterThanDouble6
                      
    module procedure DCTestAssertGreaterThanDouble7
                      
                    
  end interface

  interface AssertLessThan
                                              module procedure DCTestAssertLessThanInt0
                      
    module procedure DCTestAssertLessThanInt1
                      
    module procedure DCTestAssertLessThanInt2
                      
    module procedure DCTestAssertLessThanInt3
                      
    module procedure DCTestAssertLessThanInt4
                      
    module procedure DCTestAssertLessThanInt5
                      
    module procedure DCTestAssertLessThanInt6
                      
    module procedure DCTestAssertLessThanInt7
                      
                    
                          module procedure DCTestAssertLessThanReal0
                      
    module procedure DCTestAssertLessThanReal1
                      
    module procedure DCTestAssertLessThanReal2
                      
    module procedure DCTestAssertLessThanReal3
                      
    module procedure DCTestAssertLessThanReal4
                      
    module procedure DCTestAssertLessThanReal5
                      
    module procedure DCTestAssertLessThanReal6
                      
    module procedure DCTestAssertLessThanReal7
                      
                    
                          module procedure DCTestAssertLessThanDouble0
                      
    module procedure DCTestAssertLessThanDouble1
                      
    module procedure DCTestAssertLessThanDouble2
                      
    module procedure DCTestAssertLessThanDouble3
                      
    module procedure DCTestAssertLessThanDouble4
                      
    module procedure DCTestAssertLessThanDouble5
                      
    module procedure DCTestAssertLessThanDouble6
                      
    module procedure DCTestAssertLessThanDouble7
                      
                    
  end interface

contains


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

                                        

                                                                
                    

  continue
    err_flag = .false.

                    
    err_flag = .not. trim(answer) == trim(check)
    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar0


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

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:)
    character(STRING), allocatable:: check_fixed_length(:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                        
      &    answer_shape(1)  )  &
      &  )

    allocate( check_fixed_length ( &
                        
      &    check_shape(1)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right = answer ( &
                      
        &    pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar1


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

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:)
    character(STRING), allocatable:: check_fixed_length(:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar2


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

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar3


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

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar4


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

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar5


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

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5), &
                        
      &    answer_shape(6)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5), &
                        
      &    check_shape(6)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar6


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

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    

                                              character(STRING), allocatable:: answer_fixed_length(:,:,:,:,:,:,:)
    character(STRING), allocatable:: check_fixed_length(:,:,:,:,:,:,:)
                      
                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

                      
    allocate( answer_fixed_length ( &
                              &    answer_shape(1), &
                        
      &    answer_shape(2), &
                        
      &    answer_shape(3), &
                        
      &    answer_shape(4), &
                        
      &    answer_shape(5), &
                        
      &    answer_shape(6), &
                        
      &    answer_shape(7)  )  &
      &  )

    allocate( check_fixed_length ( &
                              &    check_shape(1), &
                        
      &    check_shape(2), &
                        
      &    check_shape(3), &
                        
      &    check_shape(4), &
                        
      &    check_shape(5), &
                        
      &    check_shape(6), &
                        
      &    check_shape(7)  )  &
      &  )

    answer_fixed_length = answer
    check_fixed_length = check

    judge = answer_fixed_length == check_fixed_length
    deallocate(answer_fixed_length, check_fixed_length)

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', trim(wrong)
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', trim(right)

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


  end subroutine DCTestAssertEqualChar7


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

                                        

                    

  continue
    err_flag = .false.

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

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt0


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

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right = answer ( &
                      
        &    pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt1


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

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt2


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

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt3


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

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt4


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

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt5


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

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt6


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

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualInt7


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

                                        

                    

  continue
    err_flag = .false.

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

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal0


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

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right = answer ( &
                      
        &    pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal1


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

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal2


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

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal3


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

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal4


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

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal5


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

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal6


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

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualReal7


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

                                        

                    

  continue
    err_flag = .false.

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

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble0


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

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right = answer ( &
                      
        &    pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble1


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

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble2


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

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble3


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

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble4


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

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble5


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

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble6


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

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
                    

                    

  continue
    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

                      
    judge = answer == check

                      

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right = answer ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '  answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertEqualDouble7

  subroutine DCTestAssertEqualLogical0(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer
    logical, intent(in):: check

                        character(STRING):: answer_str
    character(STRING):: check_str
                    


  continue

                    
    if (answer) then
      answer_str = ".true."
    else
      answer_str = ".false."
    end if

    if (check) then
      check_str = ".true."
    else
      check_str = ".false."
    end if

                    

    call DCTestAssertEqualChar0(message, answer_str, check_str)

                                        

  end subroutine DCTestAssertEqualLogical0
  subroutine DCTestAssertEqualLogical1(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:)
    logical, intent(in):: check(:)

                        integer:: answer_shape(1), check_shape(1), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:)
    character(STRING), allocatable:: check_str(:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_str ( &
                      
      &    check_shape(1)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar1(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical1
  subroutine DCTestAssertEqualLogical2(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:)
    logical, intent(in):: check(:,:)

                        integer:: answer_shape(2), check_shape(2), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:)
    character(STRING), allocatable:: check_str(:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar2(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical2
  subroutine DCTestAssertEqualLogical3(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:)
    logical, intent(in):: check(:,:,:)

                        integer:: answer_shape(3), check_shape(3), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:)
    character(STRING), allocatable:: check_str(:,:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar3(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical3
  subroutine DCTestAssertEqualLogical4(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:)
    logical, intent(in):: check(:,:,:,:)

                        integer:: answer_shape(4), check_shape(4), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar4(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical4
  subroutine DCTestAssertEqualLogical5(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:)

                        integer:: answer_shape(5), check_shape(5), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar5(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical5
  subroutine DCTestAssertEqualLogical6(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:,:)

                        integer:: answer_shape(6), check_shape(6), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5), &
                      
      &    check_shape(6)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar6(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical6
  subroutine DCTestAssertEqualLogical7(message, answer, check)
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: message
    logical, intent(in):: answer(:,:,:,:,:,:,:)
    logical, intent(in):: check(:,:,:,:,:,:,:)

                        integer:: answer_shape(7), check_shape(7), i
    logical, allocatable:: answer_tmp(:), check_tmp(:)
    character(STRING), allocatable:: answer_str_tmp(:), check_str_tmp(:)
    character(STRING), allocatable:: answer_str(:,:,:,:,:,:,:)
    character(STRING), allocatable:: check_str(:,:,:,:,:,:,:)
                    


  continue

                    
    allocate(answer_tmp(size(answer)))
    allocate(check_tmp(size(check)))
    allocate(answer_str_tmp(size(answer)))
    allocate(check_str_tmp(size(check)))
    answer_tmp = pack(answer, .true.)
    check_tmp = pack(check, .true.)

    do i = 1, size(answer_tmp)
      if (answer_tmp(i)) then
        answer_str_tmp(i) = '.true.'
      else
        answer_str_tmp(i) = '.false.'
      end if
    end do

    do i = 1, size(check_tmp)
      if (check_tmp(i)) then
        check_str_tmp(i) = '.true.'
      else
        check_str_tmp(i) = '.false.'
      end if
    end do

    answer_shape = shape(answer)
    check_shape = shape(check)

    allocate( answer_str ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_str ( &
                            &    check_shape(1), &
                      
      &    check_shape(2), &
                      
      &    check_shape(3), &
                      
      &    check_shape(4), &
                      
      &    check_shape(5), &
                      
      &    check_shape(6), &
                      
      &    check_shape(7)  )  &
      &  )

    answer_str = reshape(answer_str_tmp, answer_shape)
    check_str = reshape(check_str_tmp, check_shape)

                    

    call DCTestAssertEqualChar7(message, answer_str, check_str)

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

  end subroutine DCTestAssertEqualLogical7

  subroutine DCTestAssertEqualReal0Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        real:: answer_max
    real:: answer_min
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    if ( answer < 0.0 .and. check < 0.0 ) then
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    else

      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end if

    wrong = check
    right_max = answer_max
    right_min = answer_min
    if ( right_max < right_min ) then
      right_tmp = right_max
      right_max = right_min
      right_min = right_tmp
    end if

    err_flag = .not. (answer_max > check .and. check > answer_min)

    pos_str = ''

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal0Digits


  subroutine DCTestAssertEqualReal1Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
    real, allocatable:: answer_max(:)
    real, allocatable:: answer_min(:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_max ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_min ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right_max = answer_max ( &
                      
        &    pos(1)  )

      right_min = answer_min ( &
                      
        &    pos(1)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal1Digits


  subroutine DCTestAssertEqualReal2Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
    real, allocatable:: answer_max(:,:)
    real, allocatable:: answer_min(:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal2Digits


  subroutine DCTestAssertEqualReal3Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
    real, allocatable:: answer_max(:,:,:)
    real, allocatable:: answer_min(:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal3Digits


  subroutine DCTestAssertEqualReal4Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal4Digits


  subroutine DCTestAssertEqualReal5Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal5Digits


  subroutine DCTestAssertEqualReal6Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal6Digits


  subroutine DCTestAssertEqualReal7Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real:: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real:: right_tmp

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
    real, allocatable:: answer_max(:,:,:,:,:,:,:)
    real, allocatable:: answer_min(:,:,:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0 &
        &       + 0.1 ** significant_digits ) &
        & + 0.1 ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0 &
        &       - 0.1 ** significant_digits ) &
        & - 0.1 ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualReal7Digits


  subroutine DCTestAssertEqualDouble0Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        real(DP):: answer_max
    real(DP):: answer_min
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    if ( answer < 0.0_DP .and. check < 0.0_DP ) then
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    else

      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end if

    wrong = check
    right_max = answer_max
    right_min = answer_min
    if ( right_max < right_min ) then
      right_tmp = right_max
      right_max = right_min
      right_min = right_tmp
    end if

    err_flag = .not. (answer_max > check .and. check > answer_min)

    pos_str = ''

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble0Digits


  subroutine DCTestAssertEqualDouble1Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
    real(DP), allocatable:: answer_max(:)
    real(DP), allocatable:: answer_min(:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_max ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_min ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                      
        &    pos(1)  )

      right_max = answer_max ( &
                      
        &    pos(1)  )

      right_min = answer_min ( &
                      
        &    pos(1)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // &
                      
        &    trim(adjustl(pos_array(1))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble1Digits


  subroutine DCTestAssertEqualDouble2Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
    real(DP), allocatable:: answer_max(:,:)
    real(DP), allocatable:: answer_min(:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble2Digits


  subroutine DCTestAssertEqualDouble3Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
    real(DP), allocatable:: answer_max(:,:,:)
    real(DP), allocatable:: answer_min(:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble3Digits


  subroutine DCTestAssertEqualDouble4Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble4Digits


  subroutine DCTestAssertEqualDouble5Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble5Digits


  subroutine DCTestAssertEqualDouble6Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble6Digits


  subroutine DCTestAssertEqualDouble7Digits( &
    & message, answer, check, significant_digits, ignore_digits )
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    integer, intent(in):: significant_digits
    integer, intent(in):: ignore_digits
    logical:: err_flag
    character(STRING):: pos_str
    real(DP):: wrong, right_max, right_min
    character(STRING):: pos_str_space
    integer:: pos_str_len
    real(DP):: right_tmp

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
    real(DP), allocatable:: answer_max(:,:,:,:,:,:,:)
    real(DP), allocatable:: answer_min(:,:,:,:,:,:,:)
                    
  continue
    err_flag = .false.

    if ( significant_digits < 1 ) then
      write(*,*) ' *** Error [AssertEQ] *** '
      write(*,*) '  Specify a number more than 1 to "significant_digits"'
      call AbortProgram('')
    end if
                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_max ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_min ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative

    where (both_negative)
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    elsewhere
      answer_max = &
        &   answer &
        &   * (   1.0_DP &
        &       + 0.1_DP ** significant_digits ) &
        & + 0.1_DP ** (- ignore_digits)

      answer_min = &
        &   answer &
        &   * (   1.0_DP &
        &       - 0.1_DP ** significant_digits ) &
        & - 0.1_DP ** (- ignore_digits)
    end where

    judge = answer_max > check .and. check > answer_min
    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right_max = answer_max ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      right_min = answer_min ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )

      if ( right_max < right_min ) then
        right_tmp = right_max
        right_max = right_min
        right_min = right_tmp
      end if

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // &
                              &    trim(adjustl(pos_array(1))) // ',' // &
                      
        &    trim(adjustl(pos_array(2))) // ',' // &
                      
        &    trim(adjustl(pos_array(3))) // ',' // &
                      
        &    trim(adjustl(pos_array(4))) // ',' // &
                      
        &    trim(adjustl(pos_array(5))) // ',' // &
                      
        &    trim(adjustl(pos_array(6))) // ',' // &
                      
        &    trim(adjustl(pos_array(7))) // ')'

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)
    deallocate(answer_max, answer_min)

                    

    if (err_flag) then
      pos_str_space = ''
      pos_str_len = len_trim(pos_str)

      write(*,*) ' *** Error [AssertEQ] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  check' // trim(pos_str)  // '  = ', wrong
      write(*,*) '    is NOT EQUAL to'
      write(*,*) '        ' // pos_str_space(1:pos_str_len) &
        &                                     // '   ', right_min, ' < '
      write(*,*) '  answer' // trim(pos_str)  // ' < ', right_max

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


  end subroutine DCTestAssertEqualDouble7Digits


  subroutine DCTestAssertGreaterThanInt0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer
    integer, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0 &
      &  .and. check < 0 &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt0


  subroutine DCTestAssertGreaterThanInt1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:)
    integer, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt1


  subroutine DCTestAssertGreaterThanInt2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:)
    integer, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt2


  subroutine DCTestAssertGreaterThanInt3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:)
    integer, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt3


  subroutine DCTestAssertGreaterThanInt4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:)
    integer, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt4


  subroutine DCTestAssertGreaterThanInt5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt5


  subroutine DCTestAssertGreaterThanInt6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt6


  subroutine DCTestAssertGreaterThanInt7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanInt7


  subroutine DCTestAssertGreaterThanReal0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0.0 &
      &  .and. check < 0.0 &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal0


  subroutine DCTestAssertGreaterThanReal1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal1


  subroutine DCTestAssertGreaterThanReal2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal2


  subroutine DCTestAssertGreaterThanReal3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal3


  subroutine DCTestAssertGreaterThanReal4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal4


  subroutine DCTestAssertGreaterThanReal5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal5


  subroutine DCTestAssertGreaterThanReal6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal6


  subroutine DCTestAssertGreaterThanReal7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanReal7


  subroutine DCTestAssertGreaterThanDouble0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0.0_DP &
      &  .and. check < 0.0_DP &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble0


  subroutine DCTestAssertGreaterThanDouble1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble1


  subroutine DCTestAssertGreaterThanDouble2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble2


  subroutine DCTestAssertGreaterThanDouble3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble3


  subroutine DCTestAssertGreaterThanDouble4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble4


  subroutine DCTestAssertGreaterThanDouble5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble5


  subroutine DCTestAssertGreaterThanDouble6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble6


  subroutine DCTestAssertGreaterThanDouble7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble7


  subroutine DCTestAssertLessThanInt0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer
    integer, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0 &
      &  .and. check < 0 &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt0


  subroutine DCTestAssertLessThanInt1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:)
    integer, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt1


  subroutine DCTestAssertLessThanInt2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:)
    integer, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt2


  subroutine DCTestAssertLessThanInt3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:)
    integer, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt3


  subroutine DCTestAssertLessThanInt4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:)
    integer, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt4


  subroutine DCTestAssertLessThanInt5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt5


  subroutine DCTestAssertLessThanInt6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt6


  subroutine DCTestAssertLessThanInt7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanInt7


  subroutine DCTestAssertLessThanReal0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0.0 &
      &  .and. check < 0.0 &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal0


  subroutine DCTestAssertLessThanReal1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal1


  subroutine DCTestAssertLessThanReal2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal2


  subroutine DCTestAssertLessThanReal3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal3


  subroutine DCTestAssertLessThanReal4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal4


  subroutine DCTestAssertLessThanReal5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal5


  subroutine DCTestAssertLessThanReal6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal6


  subroutine DCTestAssertLessThanReal7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanReal7


  subroutine DCTestAssertLessThanDouble0( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0.0_DP &
      &  .and. check < 0.0_DP &
      &  .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble0


  subroutine DCTestAssertLessThanDouble1( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( judge_rev ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( answer_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( check_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    allocate( both_negative ( &
                      
      &    answer_shape(1)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                      
        &    pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble1


  subroutine DCTestAssertLessThanDouble2( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble2


  subroutine DCTestAssertLessThanDouble3( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble3


  subroutine DCTestAssertLessThanDouble4( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble4


  subroutine DCTestAssertLessThanDouble5( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble5


  subroutine DCTestAssertLessThanDouble6( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble6


  subroutine DCTestAssertLessThanDouble7( &
    & message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    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(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    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 [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( judge_rev ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( answer_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( check_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    allocate( both_negative ( &
                            &    answer_shape(1), &
                      
      &    answer_shape(2), &
                      
      &    answer_shape(3), &
                      
      &    answer_shape(4), &
                      
      &    answer_shape(5), &
                      
      &    answer_shape(6), &
                      
      &    answer_shape(7)  )  &
      &  )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    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))) // ')'

      if ( both_negative ( &
                              &    pos(1), &
                      
        &    pos(2), &
                      
        &    pos(3), &
                      
        &    pos(4), &
                      
        &    pos(5), &
                      
        &    pos(6), &
                      
        &    pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // &
        &        ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertLessThanDouble7

end module dc_test

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