Class dc_test
In: dc_utils/dc_test.f90

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

Support making test programs

Note that Japanese and English are described in parallel.

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

オブジェクト指向スクリプト言語 Ruby の Test::Unit クラス の機能の一部を模倣しています.

This module supports making Fortran 90/95 test programs.

A part of Test::Unit class in Object-oriented programming language Ruby 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 <message に与えられた文字> OK」 というメッセージを表示します. プログラムは続行します. AssertEqual の代わりに AssertGreaterThan を使用する場合には check が answer よりも大きい場合, AssertLessThan を使用する場合には check が answer よりも小さい場合に プログラムは続行します.

一方で answer と check の値, もしくは配列のサイズが異なる場合には, テストプログラムは「Checking <message に与えられた文字> 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 <string given to message> 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 <string given to message> 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

Methods

AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertEqual   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertGreaterThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   AssertLessThan   DCTestAssertEqualChar0   DCTestAssertEqualChar1   DCTestAssertEqualChar2   DCTestAssertEqualChar3   DCTestAssertEqualChar4   DCTestAssertEqualChar5   DCTestAssertEqualChar6   DCTestAssertEqualChar7   DCTestAssertEqualDouble0   DCTestAssertEqualDouble0Digits   DCTestAssertEqualDouble1   DCTestAssertEqualDouble1Digits   DCTestAssertEqualDouble2   DCTestAssertEqualDouble2Digits   DCTestAssertEqualDouble3   DCTestAssertEqualDouble3Digits   DCTestAssertEqualDouble4   DCTestAssertEqualDouble4Digits   DCTestAssertEqualDouble5   DCTestAssertEqualDouble5Digits   DCTestAssertEqualDouble6   DCTestAssertEqualDouble6Digits   DCTestAssertEqualDouble7   DCTestAssertEqualDouble7Digits   DCTestAssertEqualInt0   DCTestAssertEqualInt1   DCTestAssertEqualInt2   DCTestAssertEqualInt3   DCTestAssertEqualInt4   DCTestAssertEqualInt5   DCTestAssertEqualInt6   DCTestAssertEqualInt7   DCTestAssertEqualLogical0   DCTestAssertEqualLogical1   DCTestAssertEqualLogical2   DCTestAssertEqualLogical3   DCTestAssertEqualLogical4   DCTestAssertEqualLogical5   DCTestAssertEqualLogical6   DCTestAssertEqualLogical7   DCTestAssertEqualReal0   DCTestAssertEqualReal0Digits   DCTestAssertEqualReal1   DCTestAssertEqualReal1Digits   DCTestAssertEqualReal2   DCTestAssertEqualReal2Digits   DCTestAssertEqualReal3   DCTestAssertEqualReal3Digits   DCTestAssertEqualReal4   DCTestAssertEqualReal4Digits   DCTestAssertEqualReal5   DCTestAssertEqualReal5Digits   DCTestAssertEqualReal6   DCTestAssertEqualReal6Digits   DCTestAssertEqualReal7   DCTestAssertEqualReal7Digits   DCTestAssertGreaterThanDouble0   DCTestAssertGreaterThanDouble1   DCTestAssertGreaterThanDouble2   DCTestAssertGreaterThanDouble3   DCTestAssertGreaterThanDouble4   DCTestAssertGreaterThanDouble5   DCTestAssertGreaterThanDouble6   DCTestAssertGreaterThanDouble7   DCTestAssertGreaterThanInt0   DCTestAssertGreaterThanInt1   DCTestAssertGreaterThanInt2   DCTestAssertGreaterThanInt3   DCTestAssertGreaterThanInt4   DCTestAssertGreaterThanInt5   DCTestAssertGreaterThanInt6   DCTestAssertGreaterThanInt7   DCTestAssertGreaterThanReal0   DCTestAssertGreaterThanReal1   DCTestAssertGreaterThanReal2   DCTestAssertGreaterThanReal3   DCTestAssertGreaterThanReal4   DCTestAssertGreaterThanReal5   DCTestAssertGreaterThanReal6   DCTestAssertGreaterThanReal7   DCTestAssertLessThanDouble0   DCTestAssertLessThanDouble1   DCTestAssertLessThanDouble2   DCTestAssertLessThanDouble3   DCTestAssertLessThanDouble4   DCTestAssertLessThanDouble5   DCTestAssertLessThanDouble6   DCTestAssertLessThanDouble7   DCTestAssertLessThanInt0   DCTestAssertLessThanInt1   DCTestAssertLessThanInt2   DCTestAssertLessThanInt3   DCTestAssertLessThanInt4   DCTestAssertLessThanInt5   DCTestAssertLessThanInt6   DCTestAssertLessThanInt7   DCTestAssertLessThanReal0   DCTestAssertLessThanReal1   DCTestAssertLessThanReal2   DCTestAssertLessThanReal3   DCTestAssertLessThanReal4   DCTestAssertLessThanReal5   DCTestAssertLessThanReal6   DCTestAssertLessThanReal7  

Included Modules

dc_types sysdep

Public Instance methods

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :character(*), intent(in)
check :character(*), intent(in)

Alias for DCTestAssertEqualChar0

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)

Alias for DCTestAssertEqualInt0

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :logical, intent(in)
check :logical, intent(in)

Alias for DCTestAssertEqualLogical0

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)

Alias for DCTestAssertEqualDouble0

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)

Alias for DCTestAssertEqualReal0

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :character(*), intent(in)
check(:) :character(*), intent(in)

Alias for DCTestAssertEqualChar1

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)

Alias for DCTestAssertEqualInt1

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :logical, intent(in)
check(:) :logical, intent(in)

Alias for DCTestAssertEqualLogical1

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble1

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)

Alias for DCTestAssertEqualReal1

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :character(*), intent(in)
check(:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar2

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt2

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :logical, intent(in)
check(:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical2

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble2

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)

Alias for DCTestAssertEqualReal2

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :character(*), intent(in)
check(:,:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar3

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt3

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :logical, intent(in)
check(:,:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical3

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble3

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)

Alias for DCTestAssertEqualReal3

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :character(*), intent(in)
check(:,:,:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar4

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt4

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :logical, intent(in)
check(:,:,:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical4

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble4

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)

Alias for DCTestAssertEqualReal4

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar5

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt5

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical5

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble5

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)

Alias for DCTestAssertEqualReal5

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar6

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt6

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical6

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble6

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)

Alias for DCTestAssertEqualReal6

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:,:) :character(*), intent(in)

Alias for DCTestAssertEqualChar7

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)

Alias for DCTestAssertEqualInt7

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:,:) :logical, intent(in)

Alias for DCTestAssertEqualLogical7

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)

Alias for DCTestAssertEqualDouble7

AssertEqual( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)

Alias for DCTestAssertEqualReal7

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble0Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal0Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble1Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal1Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble2Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal2Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble3Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal3Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble4Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal4Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble5Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal5Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble6Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal6Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualDouble7Digits

AssertEqual( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

Alias for DCTestAssertEqualReal7Digits

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt0

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble0

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal0

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt1

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble1

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal1

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt2

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble2

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal2

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt3

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble3

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal3

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt4

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble4

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal4

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt5

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble5

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal5

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt6

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble6

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal6

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanInt7

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanDouble7

AssertGreaterThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertGreaterThanReal7

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt0

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble0

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal0

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt1

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble1

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal1

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt2

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble2

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal2

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt3

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble3

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal3

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt4

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble4

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal4

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt5

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble5

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal5

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt6

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble6

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal6

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanInt7

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanDouble7

AssertLessThan( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

Alias for DCTestAssertLessThanReal7

Private Instance methods

DCTestAssertEqualChar0( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :character(*), intent(in)
check :character(*), intent(in)

[Source]

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

                                        

                                                                
                    

  continue
    err_flag = .false.

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

                    


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

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


  end subroutine DCTestAssertEqualChar0
DCTestAssertEqualChar1( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :character(*), intent(in)
check(:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

                      
    allocate( answer_fixed_length ( answer_shape(1)  ) )

    allocate( check_fixed_length ( check_shape(1)  ) )

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar1
DCTestAssertEqualChar2( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :character(*), intent(in)
check(:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar2
DCTestAssertEqualChar3( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :character(*), intent(in)
check(:,:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar3
DCTestAssertEqualChar4( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :character(*), intent(in)
check(:,:,:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar4
DCTestAssertEqualChar5( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar5
DCTestAssertEqualChar6( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar6
DCTestAssertEqualChar7( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :character(*), intent(in)
check(:,:,:,:,:,:,:) :character(*), intent(in)

[Source]

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

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

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

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

    answer_fixed_length = answer
    check_fixed_length = check

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

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualChar7
DCTestAssertEqualDouble0( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)

[Source]

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

                                        

                    

  continue
    err_flag = .false.

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

                    


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

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


  end subroutine DCTestAssertEqualDouble0
DCTestAssertEqualDouble0Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

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

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

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

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

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

    pos_str = ''

                    

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

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

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


  end subroutine DCTestAssertEqualDouble0Digits
DCTestAssertEqualDouble1( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

                      
    judge = answer == check

                      

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble1
DCTestAssertEqualDouble1Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    allocate( answer_max ( answer_shape(1)  ) )

    allocate( answer_min ( answer_shape(1)  ) )

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

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

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

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

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right_max = answer_max ( pos(1)  )

      right_min = answer_min ( pos(1)  )

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble1Digits
DCTestAssertEqualDouble2( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble2
DCTestAssertEqualDouble2Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble2Digits
DCTestAssertEqualDouble3( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble3
DCTestAssertEqualDouble3Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble3Digits
DCTestAssertEqualDouble4( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble4
DCTestAssertEqualDouble4Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble4Digits
DCTestAssertEqualDouble5( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble5
DCTestAssertEqualDouble5Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble5Digits
DCTestAssertEqualDouble6( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble6
DCTestAssertEqualDouble6Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble6Digits
DCTestAssertEqualDouble7( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualDouble7
DCTestAssertEqualDouble7Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualDouble7Digits
DCTestAssertEqualInt0( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)

[Source]

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

                                        

                    

  continue
    err_flag = .false.

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

                    


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

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


  end subroutine DCTestAssertEqualInt0
DCTestAssertEqualInt1( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

                      
    judge = answer == check

                      

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt1
DCTestAssertEqualInt2( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt2
DCTestAssertEqualInt3( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt3
DCTestAssertEqualInt4( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt4
DCTestAssertEqualInt5( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt5
DCTestAssertEqualInt6( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt6
DCTestAssertEqualInt7( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualInt7
DCTestAssertEqualLogical0( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :logical, intent(in)
check :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical1( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :logical, intent(in)
check(:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical2( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :logical, intent(in)
check(:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical3( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :logical, intent(in)
check(:,:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical4( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :logical, intent(in)
check(:,:,:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical5( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical6( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualLogical7( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :logical, intent(in)
check(:,:,:,:,:,:,:) :logical, intent(in)

[Source]

  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
DCTestAssertEqualReal0( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)

[Source]

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

                                        

                    

  continue
    err_flag = .false.

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

                    


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

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


  end subroutine DCTestAssertEqualReal0
DCTestAssertEqualReal0Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

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

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

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

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

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

    pos_str = ''

                    

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

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

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


  end subroutine DCTestAssertEqualReal0Digits
DCTestAssertEqualReal1( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

                      
    judge = answer == check

                      

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal1
DCTestAssertEqualReal1Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    allocate( answer_max ( answer_shape(1)  ) )

    allocate( answer_min ( answer_shape(1)  ) )

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

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

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

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

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

    if (err_flag) then

      wrong = check ( pos(1)  )

      right_max = answer_max ( pos(1)  )

      right_min = answer_min ( pos(1)  )

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal1Digits
DCTestAssertEqualReal2( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal2
DCTestAssertEqualReal2Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal2Digits
DCTestAssertEqualReal3( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal3
DCTestAssertEqualReal3Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal3Digits
DCTestAssertEqualReal4( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal4
DCTestAssertEqualReal4Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal4Digits
DCTestAssertEqualReal5( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal5
DCTestAssertEqualReal5Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal5Digits
DCTestAssertEqualReal6( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal6
DCTestAssertEqualReal6Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal6Digits
DCTestAssertEqualReal7( message, answer, check )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)

[Source]

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

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

                    

  continue
    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

                      
    judge = answer == check

                      

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

    if (err_flag) then

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

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

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

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

    end if
    deallocate(mask_array, judge, judge_rev)

                    


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

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


  end subroutine DCTestAssertEqualReal7
DCTestAssertEqualReal7Digits( message, answer, check, significant_digits, ignore_digits )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
significant_digits :integer, intent(in)
ignore_digits :integer, intent(in)

[Source]

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

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

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


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

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

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

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

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

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

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

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

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

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

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

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

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

    if (err_flag) then

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

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

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

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

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

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

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

                    

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

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

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


  end subroutine DCTestAssertEqualReal7Digits
DCTestAssertGreaterThanDouble0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

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

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0.0_DP .and. check < 0.0_DP .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

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


  end subroutine DCTestAssertGreaterThanDouble0
DCTestAssertGreaterThanDouble1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

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

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

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

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

    consist_shape = answer_shape == check_shape

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

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble1
DCTestAssertGreaterThanDouble2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble2
DCTestAssertGreaterThanDouble3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble3
DCTestAssertGreaterThanDouble4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble4
DCTestAssertGreaterThanDouble5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble5
DCTestAssertGreaterThanDouble6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble6
DCTestAssertGreaterThanDouble7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanDouble7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanDouble7
DCTestAssertGreaterThanInt0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt0( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer
    integer, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0 .and. check < 0 .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt0
DCTestAssertGreaterThanInt1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt1( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:)
    integer, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt1
DCTestAssertGreaterThanInt2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:)
    integer, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt2
DCTestAssertGreaterThanInt3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:)
    integer, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt3
DCTestAssertGreaterThanInt4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:)
    integer, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt4
DCTestAssertGreaterThanInt5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt5
DCTestAssertGreaterThanInt6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt6
DCTestAssertGreaterThanInt7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanInt7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanInt7
DCTestAssertGreaterThanReal0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal0( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    err_flag = .not. answer < check
    abs_mes = ''

    if ( answer < 0.0 .and. check < 0.0 .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal0
DCTestAssertGreaterThanReal1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal1( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal1
DCTestAssertGreaterThanReal2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal2
DCTestAssertGreaterThanReal3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal3
DCTestAssertGreaterThanReal4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal4
DCTestAssertGreaterThanReal5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal5
DCTestAssertGreaterThanReal6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal6
DCTestAssertGreaterThanReal7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertGreaterThanReal7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer < check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT GREATER THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertGreaterThanReal7
DCTestAssertLessThanDouble0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real(DP), intent(in)
check :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble0( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer
    real(DP), intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0.0_DP .and. check < 0.0_DP .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble0
DCTestAssertLessThanDouble1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real(DP), intent(in)
check(:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble1( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:)
    real(DP), intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble1
DCTestAssertLessThanDouble2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real(DP), intent(in)
check(:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:)
    real(DP), intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble2
DCTestAssertLessThanDouble3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real(DP), intent(in)
check(:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:)
    real(DP), intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble3
DCTestAssertLessThanDouble4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real(DP), intent(in)
check(:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble4
DCTestAssertLessThanDouble5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble5
DCTestAssertLessThanDouble6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble6
DCTestAssertLessThanDouble7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real(DP), intent(in)
check(:,:,:,:,:,:,:) :real(DP), intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanDouble7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real(DP), intent(in):: answer(:,:,:,:,:,:,:)
    real(DP), intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real(DP):: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0.0_DP
    check_negative = check < 0.0_DP
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanDouble7
DCTestAssertLessThanInt0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :integer, intent(in)
check :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt0( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer
    integer, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0 .and. check < 0 .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt0
DCTestAssertLessThanInt1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :integer, intent(in)
check(:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt1( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:)
    integer, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt1
DCTestAssertLessThanInt2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :integer, intent(in)
check(:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:)
    integer, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt2
DCTestAssertLessThanInt3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :integer, intent(in)
check(:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:)
    integer, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt3
DCTestAssertLessThanInt4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :integer, intent(in)
check(:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:)
    integer, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt4
DCTestAssertLessThanInt5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt5
DCTestAssertLessThanInt6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt6
DCTestAssertLessThanInt7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :integer, intent(in)
check(:,:,:,:,:,:,:) :integer, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanInt7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    integer, intent(in):: answer(:,:,:,:,:,:,:)
    integer, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    integer:: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0
    check_negative = check < 0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanInt7
DCTestAssertLessThanReal0( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer :real, intent(in)
check :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal0( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer
    real, intent(in):: check
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                                        

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    


    err_flag = .not. answer > check
    abs_mes = ''

    if ( answer < 0.0 .and. check < 0.0 .and. negative_support_on ) then

      err_flag = .not. err_flag
      abs_mes = 'ABSOLUTE value of'
    end if

    wrong = check
    right = answer
    pos_str = ''

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal0
DCTestAssertLessThanReal1( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:) :real, intent(in)
check(:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal1( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:)
    real, intent(in):: check(:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(1), check_shape(1), pos(1)
    logical:: consist_shape(1)
    character(TOKEN):: pos_array(1)
    integer, allocatable:: mask_array(:)
    logical, allocatable:: judge(:)
    logical, allocatable:: judge_rev(:)
    logical, allocatable:: answer_negative(:)
    logical, allocatable:: check_negative(:)
    logical, allocatable:: both_negative(:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1)  ) )

    allocate( judge ( answer_shape(1)  ) )

    allocate( judge_rev ( answer_shape(1)  ) )

    allocate( answer_negative ( answer_shape(1)  ) )

    allocate( check_negative ( answer_shape(1)  ) )

    allocate( both_negative ( answer_shape(1)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1)  )

      right = answer ( pos(1)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ')'

      if ( both_negative ( pos(1)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal1
DCTestAssertLessThanReal2( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:) :real, intent(in)
check(:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal2( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:)
    real, intent(in):: check(:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(2), check_shape(2), pos(2)
    logical:: consist_shape(2)
    character(TOKEN):: pos_array(2)
    integer, allocatable:: mask_array(:,:)
    logical, allocatable:: judge(:,:)
    logical, allocatable:: judge_rev(:,:)
    logical, allocatable:: answer_negative(:,:)
    logical, allocatable:: check_negative(:,:)
    logical, allocatable:: both_negative(:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2)  )

      right = answer ( pos(1), pos(2)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ')'

      if ( both_negative ( pos(1), pos(2)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal2
DCTestAssertLessThanReal3( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:) :real, intent(in)
check(:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal3( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:)
    real, intent(in):: check(:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(3), check_shape(3), pos(3)
    logical:: consist_shape(3)
    character(TOKEN):: pos_array(3)
    integer, allocatable:: mask_array(:,:,:)
    logical, allocatable:: judge(:,:,:)
    logical, allocatable:: judge_rev(:,:,:)
    logical, allocatable:: answer_negative(:,:,:)
    logical, allocatable:: check_negative(:,:,:)
    logical, allocatable:: both_negative(:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3)  )

      right = answer ( pos(1), pos(2), pos(3)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal3
DCTestAssertLessThanReal4( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:) :real, intent(in)
check(:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal4( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:)
    real, intent(in):: check(:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(4), check_shape(4), pos(4)
    logical:: consist_shape(4)
    character(TOKEN):: pos_array(4)
    integer, allocatable:: mask_array(:,:,:,:)
    logical, allocatable:: judge(:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal4
DCTestAssertLessThanReal5( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal5( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(5), check_shape(5), pos(5)
    logical:: consist_shape(5)
    character(TOKEN):: pos_array(5)
    integer, allocatable:: mask_array(:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal5
DCTestAssertLessThanReal6( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal6( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(6), check_shape(6), pos(6)
    logical:: consist_shape(6)
    character(TOKEN):: pos_array(6)
    integer, allocatable:: mask_array(:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal6
DCTestAssertLessThanReal7( message, answer, check, [negative_support] )
Subroutine :
message :character(*), intent(in)
answer(:,:,:,:,:,:,:) :real, intent(in)
check(:,:,:,:,:,:,:) :real, intent(in)
negative_support :logical, intent(in), optional

[Source]

  subroutine DCTestAssertLessThanReal7( message, answer, check, negative_support)
    use sysdep, only: AbortProgram
    use dc_types, only: STRING, TOKEN
    implicit none
    character(*), intent(in):: message
    real, intent(in):: answer(:,:,:,:,:,:,:)
    real, intent(in):: check(:,:,:,:,:,:,:)
    logical, intent(in), optional:: negative_support
    logical:: err_flag
    logical:: negative_support_on
    character(STRING):: pos_str
    character(TOKEN):: abs_mes
    real:: wrong, right

                        integer:: answer_shape(7), check_shape(7), pos(7)
    logical:: consist_shape(7)
    character(TOKEN):: pos_array(7)
    integer, allocatable:: mask_array(:,:,:,:,:,:,:)
    logical, allocatable:: judge(:,:,:,:,:,:,:)
    logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
    logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
    logical, allocatable:: check_negative(:,:,:,:,:,:,:)
    logical, allocatable:: both_negative(:,:,:,:,:,:,:)
                    

  continue
    if (present(negative_support)) then
      negative_support_on = negative_support
    else
      negative_support_on = .true.
    end if

    err_flag = .false.

                    
    answer_shape = shape(answer)
    check_shape = shape(check)

    consist_shape = answer_shape == check_shape

    if (.not. all(consist_shape)) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) '  shape of check is (', check_shape, ')'
      write(*,*) '    is INCORRECT'
      write(*,*) '  Correct shape of answer is (', answer_shape, ')'

      call AbortProgram('')
    end if


    allocate( mask_array ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( judge_rev ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( answer_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( check_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    allocate( both_negative ( answer_shape(1), answer_shape(2), answer_shape(3), answer_shape(4), answer_shape(5), answer_shape(6), answer_shape(7)  ) )

    answer_negative = answer < 0.0
    check_negative = check < 0.0
    both_negative = answer_negative .and. check_negative
    if (.not. negative_support_on) both_negative = .false.

    judge = answer > check
    where (both_negative) judge = .not. judge

    judge_rev = .not. judge
    err_flag = any(judge_rev)
    mask_array = 1
    pos = maxloc(mask_array, judge_rev)

    if (err_flag) then

      wrong = check ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

      right = answer ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )

                            write(unit=pos_array(1), fmt="(i20)") pos(1)
                      
      write(unit=pos_array(2), fmt="(i20)") pos(2)
                      
      write(unit=pos_array(3), fmt="(i20)") pos(3)
                      
      write(unit=pos_array(4), fmt="(i20)") pos(4)
                      
      write(unit=pos_array(5), fmt="(i20)") pos(5)
                      
      write(unit=pos_array(6), fmt="(i20)") pos(6)
                      
      write(unit=pos_array(7), fmt="(i20)") pos(7)
                      

      pos_str = '(' // trim(adjustl(pos_array(1))) // ',' // trim(adjustl(pos_array(2))) // ',' // trim(adjustl(pos_array(3))) // ',' // trim(adjustl(pos_array(4))) // ',' // trim(adjustl(pos_array(5))) // ',' // trim(adjustl(pos_array(6))) // ',' // trim(adjustl(pos_array(7))) // ')'

      if ( both_negative ( pos(1), pos(2), pos(3), pos(4), pos(5), pos(6), pos(7)  )  ) then

        abs_mes = 'ABSOLUTE value of'
      else
        abs_mes = ''

      end if

    end if
    deallocate(mask_array, judge, judge_rev)
    deallocate(answer_negative, check_negative, both_negative)

                    


    if (err_flag) then
      write(*,*) ' *** Error [AssertLT] *** Checking ' // trim(message) // ' FAILURE'
      write(*,*) ''
      write(*,*) ' ' // trim(abs_mes) // ' check' // trim(pos_str) // '  = ', wrong
      write(*,*) '    is NOT LESS THAN'
      write(*,*) ' ' // trim(abs_mes) // ' answer' // trim(pos_str) // ' = ', right

      call AbortProgram('')
    else
      write(*,*) ' *** MESSAGE [AssertLT] *** Checking ' // trim(message) // ' OK'
    end if


  end subroutine DCTestAssertLessThanReal7