!--
! *** Caution!! ***
!
! This file is generated from "dc_test.rb2f90" by Ruby 1.8.2.
! Please do not edit this file directly.
!
! [JAPANESE]
!
! ※※※ 注意!!! ※※※
!
! このファイルは "dc_test.rb2f90" から Ruby 1.8.2
! によって自動生成されたファイルです.
! このファイルを直接編集しませんようお願い致します.
!
!
!++
!
!== Test module
!
! Authors:: Yasuhiro MORIKAWA
! Version:: $Id: dc_test.f90,v 1.5 2006/06/07 15:46:13 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2005. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_test
!
module dc_test,41
!
!== Overview
!
! Fortran 90/95 におけるテストプログラム作成を補助するための
! モジュールです.
!
!== List
!
! Verify :: 正答とチェックすべき値とを照合する.
!
!== Usage
!
! Verify サブルーチンは以下のように用います.
! *answer* に正答を与え, *check* に照合すべき値を与えます.
! *answer* と *check* には全ての組み込み型の変数および
! 配列 (1 〜 7次元) を与えることができますが,
! 2 つの引数の型および次元数は一致している必要があります.
!
! call Verify('Title', answer='foo', check=str1)
!
! もしも *answer* と *check* の値, もしくは配列のサイズが異なる場合,
! テストプログラムはエラーを返して終了します.
!
!=== 具体例
!
! 具体例は以下の通りです.
!
! use dc_types
! use dc_test
! character(STRING):: str1
! integer:: int1
! real:: numr1(2)
! real(DP):: numd1(2,3)
! logical:: y_n
!
! str1 = "foo"
! call Verify('Character', answer='foo', check=str1)
! int1 = 1
! call Verify('Integer', answer=1, check=int1)
! numr1(:) = (/0.00123, 0.2/)
! call Verify('Float', answer=(/0.00123, 0.2/), check=numr1)
! y_n = .true.
! call Verify('Logical', answer=.true., check=y_n)
! numd1(1,:) = (/19.432d0, 75.3d0, 3.183d0/)
! numd1(2,:) = (/0.023d0, 0.9d0, 328.2d0/)
! call Verify('Double precision 1', &
! & answer=(/19.432d0, 75.3d0, 3.183d0/), check=numd1(1,:))
! call Verify('Double precision 2', &
! & answer=(/0.023d0, 0.9d0, 238.5d0/), check=numd1(2,:))
! end
!
!
! 上記の例では, 最後のテストで敢えて間違った answer を与えているので,
! 以下のようなメッセージを出力してプログラムは強制終了します.
!
! *** MESSAGE [DCVerify] *** Checking Character OK
! *** MESSAGE [DCVerify] *** Checking Integer OK
! *** MESSAGE [DCVerify] *** Checking Float OK
! *** MESSAGE [DCVerify] *** Checking Logical OK
! *** MESSAGE [DCVerify] *** Checking Double precision 1 OK
! *** Error [DCVerify] *** Checking Double precision 2 FAILURE
!
! check(3) = 328.2
! is INCORRECT
! Correct answer is answer(3) = 238.5
!
!
use dc_types
, only : STRING, DP
implicit none
private
public Verify
interface Verify
module procedure DCVerifyChar0
module procedure DCVerifyChar1
module procedure DCVerifyChar2
module procedure DCVerifyChar3
module procedure DCVerifyChar4
module procedure DCVerifyChar5
module procedure DCVerifyChar6
module procedure DCVerifyChar7
module procedure DCVerifyInt0
module procedure DCVerifyInt1
module procedure DCVerifyInt2
module procedure DCVerifyInt3
module procedure DCVerifyInt4
module procedure DCVerifyInt5
module procedure DCVerifyInt6
module procedure DCVerifyInt7
module procedure DCVerifyReal0
module procedure DCVerifyReal1
module procedure DCVerifyReal2
module procedure DCVerifyReal3
module procedure DCVerifyReal4
module procedure DCVerifyReal5
module procedure DCVerifyReal6
module procedure DCVerifyReal7
module procedure DCVerifyDouble0
module procedure DCVerifyDouble1
module procedure DCVerifyDouble2
module procedure DCVerifyDouble3
module procedure DCVerifyDouble4
module procedure DCVerifyDouble5
module procedure DCVerifyDouble6
module procedure DCVerifyDouble7
module procedure DCVerifyLogical0
module procedure DCVerifyLogical1
module procedure DCVerifyLogical2
module procedure DCVerifyLogical3
module procedure DCVerifyLogical4
module procedure DCVerifyLogical5
module procedure DCVerifyLogical6
module procedure DCVerifyLogical7
end interface
contains
subroutine DCVerifyChar0(item, answer, check) 2,3
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer
character(*), intent(in):: check
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
continue
err_flag = .false.
err_flag = .not. trim(answer) == trim(check)
wrong = check
right = answer
pos_str = ''
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar0
subroutine DCVerifyChar1(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:)
character(*), intent(in):: check(:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(1), check_shape(1), pos(1)
logical :: consist_shape(1)
character(TOKEN) :: pos_array(1)
integer, allocatable :: mask_array(:)
logical, allocatable :: judge(:)
logical, allocatable :: judge_rev(:)
character(STRING), allocatable :: answer_fixed_length(:)
character(STRING), allocatable :: check_fixed_length(:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1) ) &
& )
allocate( judge (&
& answer_shape(1) ) &
& )
allocate( judge_rev (&
& answer_shape(1) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1) ) &
& )
allocate( check_fixed_length (&
& check_shape(1) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1) )
right = answer (&
& pos(1) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar1
subroutine DCVerifyChar2(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:)
character(*), intent(in):: check(:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(2), check_shape(2), pos(2)
logical :: consist_shape(2)
character(TOKEN) :: pos_array(2)
integer, allocatable :: mask_array(:,:)
logical, allocatable :: judge(:,:)
logical, allocatable :: judge_rev(:,:)
character(STRING), allocatable :: answer_fixed_length(:,:)
character(STRING), allocatable :: check_fixed_length(:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2) )
right = answer (&
& pos(1), &
& pos(2) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar2
subroutine DCVerifyChar3(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:,:)
character(*), intent(in):: check(:,:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(3), check_shape(3), pos(3)
logical :: consist_shape(3)
character(TOKEN) :: pos_array(3)
integer, allocatable :: mask_array(:,:,:)
logical, allocatable :: judge(:,:,:)
logical, allocatable :: judge_rev(:,:,:)
character(STRING), allocatable :: answer_fixed_length(:,:,:)
character(STRING), allocatable :: check_fixed_length(:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar3
subroutine DCVerifyChar4(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:,:,:)
character(*), intent(in):: check(:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(4), check_shape(4), pos(4)
logical :: consist_shape(4)
character(TOKEN) :: pos_array(4)
integer, allocatable :: mask_array(:,:,:,:)
logical, allocatable :: judge(:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:)
character(STRING), allocatable :: answer_fixed_length(:,:,:,:)
character(STRING), allocatable :: check_fixed_length(:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar4
subroutine DCVerifyChar5(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:,:,:,:)
character(*), intent(in):: check(:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(5), check_shape(5), pos(5)
logical :: consist_shape(5)
character(TOKEN) :: pos_array(5)
integer, allocatable :: mask_array(:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:)
character(STRING), allocatable :: answer_fixed_length(:,:,:,:,:)
character(STRING), allocatable :: check_fixed_length(:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar5
subroutine DCVerifyChar6(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:,:,:,:,:)
character(*), intent(in):: check(:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(6), check_shape(6), pos(6)
logical :: consist_shape(6)
character(TOKEN) :: pos_array(6)
integer, allocatable :: mask_array(:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:)
character(STRING), allocatable :: answer_fixed_length(:,:,:,:,:,:)
character(STRING), allocatable :: check_fixed_length(:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5), &
& check_shape(6) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar6
subroutine DCVerifyChar7(item, answer, check) 2,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
character(*), intent(in):: answer(:,:,:,:,:,:,:)
character(*), intent(in):: check(:,:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
character(STRING) :: wrong, right
integer :: answer_shape(7), check_shape(7), pos(7)
logical :: consist_shape(7)
character(TOKEN) :: pos_array(7)
integer, allocatable :: mask_array(:,:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:,:)
character(STRING), allocatable :: answer_fixed_length(:,:,:,:,:,:,:)
character(STRING), allocatable :: check_fixed_length(:,:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( answer_fixed_length (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( check_fixed_length (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5), &
& check_shape(6), &
& check_shape(7) ) &
& )
answer_fixed_length = answer
check_fixed_length = check
judge = answer_fixed_length == check_fixed_length
deallocate(answer_fixed_length, check_fixed_length)
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
write(unit=pos_array(7), fmt="(i20)") pos(7)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ',' // &
& trim(adjustl(pos_array(7))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', trim(wrong)
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', trim(right)
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyChar7
subroutine DCVerifyInt0(item, answer, check) 1,3
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer
integer, intent(in):: check
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
continue
err_flag = .false.
err_flag = .not. answer == check
wrong = check
right = answer
pos_str = ''
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt0
subroutine DCVerifyInt1(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:)
integer, intent(in):: check(:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(1), check_shape(1), pos(1)
logical :: consist_shape(1)
character(TOKEN) :: pos_array(1)
integer, allocatable :: mask_array(:)
logical, allocatable :: judge(:)
logical, allocatable :: judge_rev(:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1) ) &
& )
allocate( judge (&
& answer_shape(1) ) &
& )
allocate( judge_rev (&
& answer_shape(1) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1) )
right = answer (&
& pos(1) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt1
subroutine DCVerifyInt2(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:)
integer, intent(in):: check(:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(2), check_shape(2), pos(2)
logical :: consist_shape(2)
character(TOKEN) :: pos_array(2)
integer, allocatable :: mask_array(:,:)
logical, allocatable :: judge(:,:)
logical, allocatable :: judge_rev(:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2) )
right = answer (&
& pos(1), &
& pos(2) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt2
subroutine DCVerifyInt3(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:,:)
integer, intent(in):: check(:,:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(3), check_shape(3), pos(3)
logical :: consist_shape(3)
character(TOKEN) :: pos_array(3)
integer, allocatable :: mask_array(:,:,:)
logical, allocatable :: judge(:,:,:)
logical, allocatable :: judge_rev(:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt3
subroutine DCVerifyInt4(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:,:,:)
integer, intent(in):: check(:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(4), check_shape(4), pos(4)
logical :: consist_shape(4)
character(TOKEN) :: pos_array(4)
integer, allocatable :: mask_array(:,:,:,:)
logical, allocatable :: judge(:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt4
subroutine DCVerifyInt5(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:,:,:,:)
integer, intent(in):: check(:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(5), check_shape(5), pos(5)
logical :: consist_shape(5)
character(TOKEN) :: pos_array(5)
integer, allocatable :: mask_array(:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt5
subroutine DCVerifyInt6(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:,:,:,:,:)
integer, intent(in):: check(:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(6), check_shape(6), pos(6)
logical :: consist_shape(6)
character(TOKEN) :: pos_array(6)
integer, allocatable :: mask_array(:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt6
subroutine DCVerifyInt7(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
integer, intent(in):: answer(:,:,:,:,:,:,:)
integer, intent(in):: check(:,:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
integer :: wrong, right
integer :: answer_shape(7), check_shape(7), pos(7)
logical :: consist_shape(7)
character(TOKEN) :: pos_array(7)
integer, allocatable :: mask_array(:,:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
write(unit=pos_array(7), fmt="(i20)") pos(7)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ',' // &
& trim(adjustl(pos_array(7))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyInt7
subroutine DCVerifyReal0(item, answer, check) 1,3
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer
real, intent(in):: check
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
continue
err_flag = .false.
err_flag = .not. answer == check
wrong = check
right = answer
pos_str = ''
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal0
subroutine DCVerifyReal1(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:)
real, intent(in):: check(:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(1), check_shape(1), pos(1)
logical :: consist_shape(1)
character(TOKEN) :: pos_array(1)
integer, allocatable :: mask_array(:)
logical, allocatable :: judge(:)
logical, allocatable :: judge_rev(:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1) ) &
& )
allocate( judge (&
& answer_shape(1) ) &
& )
allocate( judge_rev (&
& answer_shape(1) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1) )
right = answer (&
& pos(1) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal1
subroutine DCVerifyReal2(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:)
real, intent(in):: check(:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(2), check_shape(2), pos(2)
logical :: consist_shape(2)
character(TOKEN) :: pos_array(2)
integer, allocatable :: mask_array(:,:)
logical, allocatable :: judge(:,:)
logical, allocatable :: judge_rev(:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2) )
right = answer (&
& pos(1), &
& pos(2) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal2
subroutine DCVerifyReal3(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:,:)
real, intent(in):: check(:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(3), check_shape(3), pos(3)
logical :: consist_shape(3)
character(TOKEN) :: pos_array(3)
integer, allocatable :: mask_array(:,:,:)
logical, allocatable :: judge(:,:,:)
logical, allocatable :: judge_rev(:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal3
subroutine DCVerifyReal4(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:,:,:)
real, intent(in):: check(:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(4), check_shape(4), pos(4)
logical :: consist_shape(4)
character(TOKEN) :: pos_array(4)
integer, allocatable :: mask_array(:,:,:,:)
logical, allocatable :: judge(:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal4
subroutine DCVerifyReal5(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:,:,:,:)
real, intent(in):: check(:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(5), check_shape(5), pos(5)
logical :: consist_shape(5)
character(TOKEN) :: pos_array(5)
integer, allocatable :: mask_array(:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal5
subroutine DCVerifyReal6(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:,:,:,:,:)
real, intent(in):: check(:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(6), check_shape(6), pos(6)
logical :: consist_shape(6)
character(TOKEN) :: pos_array(6)
integer, allocatable :: mask_array(:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal6
subroutine DCVerifyReal7(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real, intent(in):: answer(:,:,:,:,:,:,:)
real, intent(in):: check(:,:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real :: wrong, right
integer :: answer_shape(7), check_shape(7), pos(7)
logical :: consist_shape(7)
character(TOKEN) :: pos_array(7)
integer, allocatable :: mask_array(:,:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
write(unit=pos_array(7), fmt="(i20)") pos(7)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ',' // &
& trim(adjustl(pos_array(7))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyReal7
subroutine DCVerifyDouble0(item, answer, check) 1,3
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer
real(DP), intent(in):: check
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
continue
err_flag = .false.
err_flag = .not. answer == check
wrong = check
right = answer
pos_str = ''
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble0
subroutine DCVerifyDouble1(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:)
real(DP), intent(in):: check(:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(1), check_shape(1), pos(1)
logical :: consist_shape(1)
character(TOKEN) :: pos_array(1)
integer, allocatable :: mask_array(:)
logical, allocatable :: judge(:)
logical, allocatable :: judge_rev(:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1) ) &
& )
allocate( judge (&
& answer_shape(1) ) &
& )
allocate( judge_rev (&
& answer_shape(1) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1) )
right = answer (&
& pos(1) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble1
subroutine DCVerifyDouble2(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:)
real(DP), intent(in):: check(:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(2), check_shape(2), pos(2)
logical :: consist_shape(2)
character(TOKEN) :: pos_array(2)
integer, allocatable :: mask_array(:,:)
logical, allocatable :: judge(:,:)
logical, allocatable :: judge_rev(:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2) )
right = answer (&
& pos(1), &
& pos(2) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble2
subroutine DCVerifyDouble3(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:,:)
real(DP), intent(in):: check(:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(3), check_shape(3), pos(3)
logical :: consist_shape(3)
character(TOKEN) :: pos_array(3)
integer, allocatable :: mask_array(:,:,:)
logical, allocatable :: judge(:,:,:)
logical, allocatable :: judge_rev(:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble3
subroutine DCVerifyDouble4(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:,:,:)
real(DP), intent(in):: check(:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(4), check_shape(4), pos(4)
logical :: consist_shape(4)
character(TOKEN) :: pos_array(4)
integer, allocatable :: mask_array(:,:,:,:)
logical, allocatable :: judge(:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble4
subroutine DCVerifyDouble5(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:,:,:,:)
real(DP), intent(in):: check(:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(5), check_shape(5), pos(5)
logical :: consist_shape(5)
character(TOKEN) :: pos_array(5)
integer, allocatable :: mask_array(:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble5
subroutine DCVerifyDouble6(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:,:,:,:,:)
real(DP), intent(in):: check(:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(6), check_shape(6), pos(6)
logical :: consist_shape(6)
character(TOKEN) :: pos_array(6)
integer, allocatable :: mask_array(:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble6
subroutine DCVerifyDouble7(item, answer, check) 1,4
use sysdep, only: AbortProgram
use dc_types, only: STRING, TOKEN
implicit none
character(*), intent(in):: item
real(DP), intent(in):: answer(:,:,:,:,:,:,:)
real(DP), intent(in):: check(:,:,:,:,:,:,:)
logical :: err_flag
character(STRING) :: pos_str
real(DP) :: wrong, right
integer :: answer_shape(7), check_shape(7), pos(7)
logical :: consist_shape(7)
character(TOKEN) :: pos_array(7)
integer, allocatable :: mask_array(:,:,:,:,:,:,:)
logical, allocatable :: judge(:,:,:,:,:,:,:)
logical, allocatable :: judge_rev(:,:,:,:,:,:,:)
continue
err_flag = .false.
answer_shape = shape(answer)
check_shape = shape(check)
consist_shape = answer_shape == check_shape
if (.not. all(consist_shape)) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' shape of check is (', check_shape, ')'
write(*,*) ' is INCORRECT'
write(*,*) ' Correct shape of answer is (', answer_shape, ')'
call AbortProgram('')
end if
allocate( mask_array (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( judge_rev (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
judge = answer == check
judge_rev = .not. judge
err_flag = any(judge_rev)
mask_array = 1
pos = maxloc(mask_array, judge_rev)
if (err_flag) then
wrong = check (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
right = answer (&
& pos(1), &
& pos(2), &
& pos(3), &
& pos(4), &
& pos(5), &
& pos(6), &
& pos(7) )
write(unit=pos_array(1), fmt="(i20)") pos(1)
write(unit=pos_array(2), fmt="(i20)") pos(2)
write(unit=pos_array(3), fmt="(i20)") pos(3)
write(unit=pos_array(4), fmt="(i20)") pos(4)
write(unit=pos_array(5), fmt="(i20)") pos(5)
write(unit=pos_array(6), fmt="(i20)") pos(6)
write(unit=pos_array(7), fmt="(i20)") pos(7)
pos_str = '(' // &
& trim(adjustl(pos_array(1))) // ',' // &
& trim(adjustl(pos_array(2))) // ',' // &
& trim(adjustl(pos_array(3))) // ',' // &
& trim(adjustl(pos_array(4))) // ',' // &
& trim(adjustl(pos_array(5))) // ',' // &
& trim(adjustl(pos_array(6))) // ',' // &
& trim(adjustl(pos_array(7))) // ')'
end if
deallocate(mask_array, judge, judge_rev)
if (err_flag) then
write(*,*) ' *** Error [DCVerify] *** Checking ' // trim(item) // ' FAILURE'
write(*,*) ''
write(*,*) ' check' // trim(pos_str) // ' = ', wrong
write(*,*) ' is INCORRECT'
write(*,*) ' Correct answer is answer' // trim(pos_str) // ' = ', right
call AbortProgram('')
else
write(*,*) ' *** MESSAGE [DCVerify] *** Checking ' // trim(item) // ' OK'
end if
end subroutine DCVerifyDouble7
subroutine DCVerifyLogical0(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer
logical, intent(in):: check
character(STRING) :: answer_str
character(STRING) :: check_str
continue
if (answer) then
answer_str = ".true."
else
answer_str = ".false."
end if
if (check) then
check_str = ".true."
else
check_str = ".false."
end if
call DCVerifyChar0(item, answer_str, check_str)
end subroutine DCVerifyLogical0
subroutine DCVerifyLogical1(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:)
logical, intent(in):: check(:)
integer :: answer_shape(1), check_shape(1), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:)
character(STRING), allocatable :: check_str(:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1) ) &
& )
allocate( check_str (&
& check_shape(1) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar1(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical1
subroutine DCVerifyLogical2(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:)
logical, intent(in):: check(:,:)
integer :: answer_shape(2), check_shape(2), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:)
character(STRING), allocatable :: check_str(:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar2(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical2
subroutine DCVerifyLogical3(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:,:)
logical, intent(in):: check(:,:,:)
integer :: answer_shape(3), check_shape(3), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:,:)
character(STRING), allocatable :: check_str(:,:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar3(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical3
subroutine DCVerifyLogical4(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:,:,:)
logical, intent(in):: check(:,:,:,:)
integer :: answer_shape(4), check_shape(4), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:,:,:)
character(STRING), allocatable :: check_str(:,:,:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar4(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical4
subroutine DCVerifyLogical5(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:,:,:,:)
logical, intent(in):: check(:,:,:,:,:)
integer :: answer_shape(5), check_shape(5), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:,:,:,:)
character(STRING), allocatable :: check_str(:,:,:,:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar5(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical5
subroutine DCVerifyLogical6(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:,:,:,:,:)
logical, intent(in):: check(:,:,:,:,:,:)
integer :: answer_shape(6), check_shape(6), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:,:,:,:,:)
character(STRING), allocatable :: check_str(:,:,:,:,:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5), &
& check_shape(6) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar6(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical6
subroutine DCVerifyLogical7(item, answer, check) 1,2
use dc_types, only: STRING
implicit none
character(*), intent(in):: item
logical, intent(in):: answer(:,:,:,:,:,:,:)
logical, intent(in):: check(:,:,:,:,:,:,:)
integer :: answer_shape(7), check_shape(7), i
logical, allocatable :: answer_tmp(:), check_tmp(:)
character(STRING), allocatable :: answer_str_tmp(:), check_str_tmp(:)
character(STRING), allocatable :: answer_str(:,:,:,:,:,:,:)
character(STRING), allocatable :: check_str(:,:,:,:,:,:,:)
continue
allocate(answer_tmp(size(answer)))
allocate(check_tmp(size(check)))
allocate(answer_str_tmp(size(answer)))
allocate(check_str_tmp(size(check)))
answer_tmp = pack(answer, .true.)
check_tmp = pack(check, .true.)
do i = 1, size(answer_tmp)
if (answer_tmp(i)) then
answer_str_tmp(i) = '.true.'
else
answer_str_tmp(i) = '.false.'
end if
end do
do i = 1, size(check_tmp)
if (check_tmp(i)) then
check_str_tmp(i) = '.true.'
else
check_str_tmp(i) = '.false.'
end if
end do
answer_shape = shape(answer)
check_shape = shape(check)
allocate( answer_str (&
& answer_shape(1), &
& answer_shape(2), &
& answer_shape(3), &
& answer_shape(4), &
& answer_shape(5), &
& answer_shape(6), &
& answer_shape(7) ) &
& )
allocate( check_str (&
& check_shape(1), &
& check_shape(2), &
& check_shape(3), &
& check_shape(4), &
& check_shape(5), &
& check_shape(6), &
& check_shape(7) ) &
& )
answer_str = reshape(answer_str_tmp, answer_shape)
check_str = reshape(check_str_tmp, check_shape)
call DCVerifyChar7(item, answer_str, check_str)
deallocate(answer_str, answer_tmp, answer_str_tmp)
deallocate(check_str, check_tmp, check_str_tmp)
end subroutine DCVerifyLogical7
end module dc_test
!--
! vi:set readonly sw=4 ts=8:
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++