d7/d8f/dc__test_8f90_source.html

!--

! *** Caution!! ***

!

! This file is generated from "dc_test.rb2f90" by Ruby 2.3.0.

! Please do not edit this file directly.

!

! [JAPANESE]

!

! ※※※ 注意!!! ※※※

!

! このファイルは "dc_test.rb2f90" から Ruby 2.3.0

! によって自動生成されたファイルです.

! このファイルを直接編集しませんようお願い致します.

!

!

!++

!

!= テストプログラム作成支援

!

!= Support making test programs

!

! Authors::   Yasuhiro MORIKAWA

! Version::   $Id: dc_test.rb2f90,v 1.2 2009-03-22 02:17:34 morikawa Exp $

! Tag Name::  $Name:  $

! 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 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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar0


  subroutine dctestassertequalchar1(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar1


  subroutine dctestassertequalchar2(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar2


  subroutine dctestassertequalchar3(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar3


  subroutine dctestassertequalchar4(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar4


  subroutine dctestassertequalchar5(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar5


  subroutine dctestassertequalchar6(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar6


  subroutine dctestassertequalchar7(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalchar7


  subroutine dctestassertequalint0(message, answer, check)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint0


  subroutine dctestassertequalint1(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint1


  subroutine dctestassertequalint2(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint2


  subroutine dctestassertequalint3(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint3


  subroutine dctestassertequalint4(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint4


  subroutine dctestassertequalint5(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint5


  subroutine dctestassertequalint6(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint6


  subroutine dctestassertequalint7(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalint7


  subroutine dctestassertequalreal0(message, answer, check)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal0


  subroutine dctestassertequalreal1(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal1


  subroutine dctestassertequalreal2(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal2


  subroutine dctestassertequalreal3(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal3


  subroutine dctestassertequalreal4(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal4


  subroutine dctestassertequalreal5(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal5


  subroutine dctestassertequalreal6(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal6


  subroutine dctestassertequalreal7(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal7


  subroutine dctestassertequaldouble0(message, answer, check)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble0


  subroutine dctestassertequaldouble1(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble1


  subroutine dctestassertequaldouble2(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble2


  subroutine dctestassertequaldouble3(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble3


  subroutine dctestassertequaldouble4(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble4


  subroutine dctestassertequaldouble5(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble5


  subroutine dctestassertequaldouble6(message, answer, check)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble6


  subroutine dctestassertequaldouble7(message, answer, check)

    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 abort()

    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 abort()

    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 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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal0digits


  subroutine dctestassertequalreal1digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal1digits


  subroutine dctestassertequalreal2digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal2digits


  subroutine dctestassertequalreal3digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal3digits


  subroutine dctestassertequalreal4digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal4digits


  subroutine dctestassertequalreal5digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal5digits


  subroutine dctestassertequalreal6digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal6digits


  subroutine dctestassertequalreal7digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequalreal7digits


  subroutine dctestassertequaldouble0digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble0digits


  subroutine dctestassertequaldouble1digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble1digits


  subroutine dctestassertequaldouble2digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble2digits


  subroutine dctestassertequaldouble3digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble3digits


  subroutine dctestassertequaldouble4digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble4digits


  subroutine dctestassertequaldouble5digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble5digits


  subroutine dctestassertequaldouble6digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble6digits


  subroutine dctestassertequaldouble7digits( &

    & message, answer, check, significant_digits, ignore_digits )

    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 abort()

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertEQ] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertequaldouble7digits


  subroutine dctestassertgreaterthanint0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint0


  subroutine dctestassertgreaterthanint1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint1


  subroutine dctestassertgreaterthanint2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint2


  subroutine dctestassertgreaterthanint3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint3


  subroutine dctestassertgreaterthanint4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint4


  subroutine dctestassertgreaterthanint5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint5


  subroutine dctestassertgreaterthanint6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint6


  subroutine dctestassertgreaterthanint7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanint7


  subroutine dctestassertgreaterthanreal0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal0


  subroutine dctestassertgreaterthanreal1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal1


  subroutine dctestassertgreaterthanreal2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal2


  subroutine dctestassertgreaterthanreal3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal3


  subroutine dctestassertgreaterthanreal4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal4


  subroutine dctestassertgreaterthanreal5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal5


  subroutine dctestassertgreaterthanreal6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal6


  subroutine dctestassertgreaterthanreal7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthanreal7


  subroutine dctestassertgreaterthandouble0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble0


  subroutine dctestassertgreaterthandouble1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble1


  subroutine dctestassertgreaterthandouble2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble2


  subroutine dctestassertgreaterthandouble3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble3


  subroutine dctestassertgreaterthandouble4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble4


  subroutine dctestassertgreaterthandouble5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble5


  subroutine dctestassertgreaterthandouble6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble6


  subroutine dctestassertgreaterthandouble7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertgreaterthandouble7


  subroutine dctestassertlessthanint0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint0


  subroutine dctestassertlessthanint1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint1


  subroutine dctestassertlessthanint2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint2


  subroutine dctestassertlessthanint3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint3


  subroutine dctestassertlessthanint4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint4


  subroutine dctestassertlessthanint5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint5


  subroutine dctestassertlessthanint6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint6


  subroutine dctestassertlessthanint7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanint7


  subroutine dctestassertlessthanreal0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal0


  subroutine dctestassertlessthanreal1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal1


  subroutine dctestassertlessthanreal2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal2


  subroutine dctestassertlessthanreal3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal3


  subroutine dctestassertlessthanreal4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal4


  subroutine dctestassertlessthanreal5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal5


  subroutine dctestassertlessthanreal6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal6


  subroutine dctestassertlessthanreal7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthanreal7


  subroutine dctestassertlessthandouble0( &

    & message, answer, check, negative_support)

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble0


  subroutine dctestassertlessthandouble1( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble1


  subroutine dctestassertlessthandouble2( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble2


  subroutine dctestassertlessthandouble3( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble3


  subroutine dctestassertlessthandouble4( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble4


  subroutine dctestassertlessthandouble5( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble5


  subroutine dctestassertlessthandouble6( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    else

      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'

    end if


  end subroutine dctestassertlessthandouble6


  subroutine dctestassertlessthandouble7( &

    & message, answer, check, negative_support)

    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 abort()

    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 abort()

    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:

!

!++