Private Member Functions
dc_test::assertgreaterthan Interface Reference

Private Member Functions

subroutine dctestassertgreaterthanint0 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint1 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint2 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint3 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint4 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint5 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint6 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanint7 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal0 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal1 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal2 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal3 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal4 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal5 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal6 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthanreal7 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble0 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble1 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble2 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble3 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble4 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble5 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble6 (message, answer, check, negative_support)
 
subroutine dctestassertgreaterthandouble7 (message, answer, check, negative_support)
 

Detailed Description

Definition at line 419 of file dc_test.f90.

Member Function/Subroutine Documentation

◆ dctestassertgreaterthandouble0()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble0 ( character(*), intent(in)  message,
real(dp), intent(in)  answer,
real(dp), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12146 of file dc_test.f90.

12146  use sysdep, only: abortprogram
12147  use dc_types, only: string, token
12148  implicit none
12149  character(*), intent(in):: message
12150  real(DP), intent(in):: answer
12151  real(DP), intent(in):: check
12152  logical, intent(in), optional:: negative_support
12153  logical:: err_flag
12154  logical:: negative_support_on
12155  character(STRING):: pos_str
12156  character(TOKEN):: abs_mes
12157  real(DP):: wrong, right
12158 
12159 
12160 
12161  continue
12162  if (present(negative_support)) then
12163  negative_support_on = negative_support
12164  else
12165  negative_support_on = .true.
12166  end if
12167 
12168  err_flag = .false.
12169 
12170 
12171  err_flag = .not. answer < check
12172  abs_mes = ''
12173 
12174  if ( answer < 0.0_dp &
12175  & .and. check < 0.0_dp &
12176  & .and. negative_support_on ) then
12177 
12178  err_flag = .not. err_flag
12179  abs_mes = 'ABSOLUTE value of'
12180  end if
12181 
12182  wrong = check
12183  right = answer
12184  pos_str = ''
12185 
12186 
12187 
12188 
12189  if (err_flag) then
12190  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12191  write(*,*) ''
12192  write(*,*) ' ' // trim(abs_mes) // &
12193  & ' check' // trim(pos_str) // ' = ', wrong
12194  write(*,*) ' is NOT GREATER THAN'
12195  write(*,*) ' ' // trim(abs_mes) // &
12196  & ' answer' // trim(pos_str) // ' = ', right
12197 
12198  call abortprogram('')
12199  else
12200  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12201  end if
12202 
12203 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble1()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble1 ( character(*), intent(in)  message,
real(dp), dimension(:), intent(in)  answer,
real(dp), dimension(:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12209 of file dc_test.f90.

12209  use sysdep, only: abortprogram
12210  use dc_types, only: string, token
12211  implicit none
12212  character(*), intent(in):: message
12213  real(DP), intent(in):: answer(:)
12214  real(DP), intent(in):: check(:)
12215  logical, intent(in), optional:: negative_support
12216  logical:: err_flag
12217  logical:: negative_support_on
12218  character(STRING):: pos_str
12219  character(TOKEN):: abs_mes
12220  real(DP):: wrong, right
12221 
12222  integer:: answer_shape(1), check_shape(1), pos(1)
12223  logical:: consist_shape(1)
12224  character(TOKEN):: pos_array(1)
12225  integer, allocatable:: mask_array(:)
12226  logical, allocatable:: judge(:)
12227  logical, allocatable:: judge_rev(:)
12228  logical, allocatable:: answer_negative(:)
12229  logical, allocatable:: check_negative(:)
12230  logical, allocatable:: both_negative(:)
12231 
12232 
12233  continue
12234  if (present(negative_support)) then
12235  negative_support_on = negative_support
12236  else
12237  negative_support_on = .true.
12238  end if
12239 
12240  err_flag = .false.
12241 
12242 
12243  answer_shape = shape(answer)
12244  check_shape = shape(check)
12245 
12246  consist_shape = answer_shape == check_shape
12247 
12248  if (.not. all(consist_shape)) then
12249  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12250  write(*,*) ''
12251  write(*,*) ' shape of check is (', check_shape, ')'
12252  write(*,*) ' is INCORRECT'
12253  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
12254 
12255  call abortprogram('')
12256  end if
12257 
12258 
12259  allocate( mask_array( &
12260 
12261  & answer_shape(1) ) &
12262  & )
12263 
12264  allocate( judge( &
12265 
12266  & answer_shape(1) ) &
12267  & )
12268 
12269  allocate( judge_rev( &
12270 
12271  & answer_shape(1) ) &
12272  & )
12273 
12274  allocate( answer_negative( &
12275 
12276  & answer_shape(1) ) &
12277  & )
12278 
12279  allocate( check_negative( &
12280 
12281  & answer_shape(1) ) &
12282  & )
12283 
12284  allocate( both_negative( &
12285 
12286  & answer_shape(1) ) &
12287  & )
12288 
12289  answer_negative = answer < 0.0_dp
12290  check_negative = check < 0.0_dp
12291  both_negative = answer_negative .and. check_negative
12292  if (.not. negative_support_on) both_negative = .false.
12293 
12294  judge = answer < check
12295  where (both_negative) judge = .not. judge
12296 
12297  judge_rev = .not. judge
12298  err_flag = any(judge_rev)
12299  mask_array = 1
12300  pos = maxloc(mask_array, judge_rev)
12301 
12302  if (err_flag) then
12303 
12304  wrong = check( &
12305 
12306  & pos(1) )
12307 
12308  right = answer( &
12309 
12310  & pos(1) )
12311 
12312  write(unit=pos_array(1), fmt="(i20)") pos(1)
12313 
12314 
12315  pos_str = '(' // &
12316 
12317  & trim(adjustl(pos_array(1))) // ')'
12318 
12319  if ( both_negative( &
12320 
12321  & pos(1) ) ) then
12322 
12323  abs_mes = 'ABSOLUTE value of'
12324  else
12325  abs_mes = ''
12326 
12327  end if
12328 
12329  end if
12330  deallocate(mask_array, judge, judge_rev)
12331  deallocate(answer_negative, check_negative, both_negative)
12332 
12333 
12334 
12335 
12336  if (err_flag) then
12337  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12338  write(*,*) ''
12339  write(*,*) ' ' // trim(abs_mes) // &
12340  & ' check' // trim(pos_str) // ' = ', wrong
12341  write(*,*) ' is NOT GREATER THAN'
12342  write(*,*) ' ' // trim(abs_mes) // &
12343  & ' answer' // trim(pos_str) // ' = ', right
12344 
12345  call abortprogram('')
12346  else
12347  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12348  end if
12349 
12350 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble2()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble2 ( character(*), intent(in)  message,
real(dp), dimension(:,:), intent(in)  answer,
real(dp), dimension(:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12356 of file dc_test.f90.

12356  use sysdep, only: abortprogram
12357  use dc_types, only: string, token
12358  implicit none
12359  character(*), intent(in):: message
12360  real(DP), intent(in):: answer(:,:)
12361  real(DP), intent(in):: check(:,:)
12362  logical, intent(in), optional:: negative_support
12363  logical:: err_flag
12364  logical:: negative_support_on
12365  character(STRING):: pos_str
12366  character(TOKEN):: abs_mes
12367  real(DP):: wrong, right
12368 
12369  integer:: answer_shape(2), check_shape(2), pos(2)
12370  logical:: consist_shape(2)
12371  character(TOKEN):: pos_array(2)
12372  integer, allocatable:: mask_array(:,:)
12373  logical, allocatable:: judge(:,:)
12374  logical, allocatable:: judge_rev(:,:)
12375  logical, allocatable:: answer_negative(:,:)
12376  logical, allocatable:: check_negative(:,:)
12377  logical, allocatable:: both_negative(:,:)
12378 
12379 
12380  continue
12381  if (present(negative_support)) then
12382  negative_support_on = negative_support
12383  else
12384  negative_support_on = .true.
12385  end if
12386 
12387  err_flag = .false.
12388 
12389 
12390  answer_shape = shape(answer)
12391  check_shape = shape(check)
12392 
12393  consist_shape = answer_shape == check_shape
12394 
12395  if (.not. all(consist_shape)) then
12396  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12397  write(*,*) ''
12398  write(*,*) ' shape of check is (', check_shape, ')'
12399  write(*,*) ' is INCORRECT'
12400  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
12401 
12402  call abortprogram('')
12403  end if
12404 
12405 
12406  allocate( mask_array( &
12407  & answer_shape(1), &
12408 
12409  & answer_shape(2) ) &
12410  & )
12411 
12412  allocate( judge( &
12413  & answer_shape(1), &
12414 
12415  & answer_shape(2) ) &
12416  & )
12417 
12418  allocate( judge_rev( &
12419  & answer_shape(1), &
12420 
12421  & answer_shape(2) ) &
12422  & )
12423 
12424  allocate( answer_negative( &
12425  & answer_shape(1), &
12426 
12427  & answer_shape(2) ) &
12428  & )
12429 
12430  allocate( check_negative( &
12431  & answer_shape(1), &
12432 
12433  & answer_shape(2) ) &
12434  & )
12435 
12436  allocate( both_negative( &
12437  & answer_shape(1), &
12438 
12439  & answer_shape(2) ) &
12440  & )
12441 
12442  answer_negative = answer < 0.0_dp
12443  check_negative = check < 0.0_dp
12444  both_negative = answer_negative .and. check_negative
12445  if (.not. negative_support_on) both_negative = .false.
12446 
12447  judge = answer < check
12448  where (both_negative) judge = .not. judge
12449 
12450  judge_rev = .not. judge
12451  err_flag = any(judge_rev)
12452  mask_array = 1
12453  pos = maxloc(mask_array, judge_rev)
12454 
12455  if (err_flag) then
12456 
12457  wrong = check( &
12458  & pos(1), &
12459 
12460  & pos(2) )
12461 
12462  right = answer( &
12463  & pos(1), &
12464 
12465  & pos(2) )
12466 
12467  write(unit=pos_array(1), fmt="(i20)") pos(1)
12468 
12469  write(unit=pos_array(2), fmt="(i20)") pos(2)
12470 
12471 
12472  pos_str = '(' // &
12473  & trim(adjustl(pos_array(1))) // ',' // &
12474 
12475  & trim(adjustl(pos_array(2))) // ')'
12476 
12477  if ( both_negative( &
12478  & pos(1), &
12479 
12480  & pos(2) ) ) then
12481 
12482  abs_mes = 'ABSOLUTE value of'
12483  else
12484  abs_mes = ''
12485 
12486  end if
12487 
12488  end if
12489  deallocate(mask_array, judge, judge_rev)
12490  deallocate(answer_negative, check_negative, both_negative)
12491 
12492 
12493 
12494 
12495  if (err_flag) then
12496  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12497  write(*,*) ''
12498  write(*,*) ' ' // trim(abs_mes) // &
12499  & ' check' // trim(pos_str) // ' = ', wrong
12500  write(*,*) ' is NOT GREATER THAN'
12501  write(*,*) ' ' // trim(abs_mes) // &
12502  & ' answer' // trim(pos_str) // ' = ', right
12503 
12504  call abortprogram('')
12505  else
12506  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12507  end if
12508 
12509 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble3()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble3 ( character(*), intent(in)  message,
real(dp), dimension(:,:,:), intent(in)  answer,
real(dp), dimension(:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12515 of file dc_test.f90.

12515  use sysdep, only: abortprogram
12516  use dc_types, only: string, token
12517  implicit none
12518  character(*), intent(in):: message
12519  real(DP), intent(in):: answer(:,:,:)
12520  real(DP), intent(in):: check(:,:,:)
12521  logical, intent(in), optional:: negative_support
12522  logical:: err_flag
12523  logical:: negative_support_on
12524  character(STRING):: pos_str
12525  character(TOKEN):: abs_mes
12526  real(DP):: wrong, right
12527 
12528  integer:: answer_shape(3), check_shape(3), pos(3)
12529  logical:: consist_shape(3)
12530  character(TOKEN):: pos_array(3)
12531  integer, allocatable:: mask_array(:,:,:)
12532  logical, allocatable:: judge(:,:,:)
12533  logical, allocatable:: judge_rev(:,:,:)
12534  logical, allocatable:: answer_negative(:,:,:)
12535  logical, allocatable:: check_negative(:,:,:)
12536  logical, allocatable:: both_negative(:,:,:)
12537 
12538 
12539  continue
12540  if (present(negative_support)) then
12541  negative_support_on = negative_support
12542  else
12543  negative_support_on = .true.
12544  end if
12545 
12546  err_flag = .false.
12547 
12548 
12549  answer_shape = shape(answer)
12550  check_shape = shape(check)
12551 
12552  consist_shape = answer_shape == check_shape
12553 
12554  if (.not. all(consist_shape)) then
12555  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12556  write(*,*) ''
12557  write(*,*) ' shape of check is (', check_shape, ')'
12558  write(*,*) ' is INCORRECT'
12559  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
12560 
12561  call abortprogram('')
12562  end if
12563 
12564 
12565  allocate( mask_array( &
12566  & answer_shape(1), &
12567 
12568  & answer_shape(2), &
12569 
12570  & answer_shape(3) ) &
12571  & )
12572 
12573  allocate( judge( &
12574  & answer_shape(1), &
12575 
12576  & answer_shape(2), &
12577 
12578  & answer_shape(3) ) &
12579  & )
12580 
12581  allocate( judge_rev( &
12582  & answer_shape(1), &
12583 
12584  & answer_shape(2), &
12585 
12586  & answer_shape(3) ) &
12587  & )
12588 
12589  allocate( answer_negative( &
12590  & answer_shape(1), &
12591 
12592  & answer_shape(2), &
12593 
12594  & answer_shape(3) ) &
12595  & )
12596 
12597  allocate( check_negative( &
12598  & answer_shape(1), &
12599 
12600  & answer_shape(2), &
12601 
12602  & answer_shape(3) ) &
12603  & )
12604 
12605  allocate( both_negative( &
12606  & answer_shape(1), &
12607 
12608  & answer_shape(2), &
12609 
12610  & answer_shape(3) ) &
12611  & )
12612 
12613  answer_negative = answer < 0.0_dp
12614  check_negative = check < 0.0_dp
12615  both_negative = answer_negative .and. check_negative
12616  if (.not. negative_support_on) both_negative = .false.
12617 
12618  judge = answer < check
12619  where (both_negative) judge = .not. judge
12620 
12621  judge_rev = .not. judge
12622  err_flag = any(judge_rev)
12623  mask_array = 1
12624  pos = maxloc(mask_array, judge_rev)
12625 
12626  if (err_flag) then
12627 
12628  wrong = check( &
12629  & pos(1), &
12630 
12631  & pos(2), &
12632 
12633  & pos(3) )
12634 
12635  right = answer( &
12636  & pos(1), &
12637 
12638  & pos(2), &
12639 
12640  & pos(3) )
12641 
12642  write(unit=pos_array(1), fmt="(i20)") pos(1)
12643 
12644  write(unit=pos_array(2), fmt="(i20)") pos(2)
12645 
12646  write(unit=pos_array(3), fmt="(i20)") pos(3)
12647 
12648 
12649  pos_str = '(' // &
12650  & trim(adjustl(pos_array(1))) // ',' // &
12651 
12652  & trim(adjustl(pos_array(2))) // ',' // &
12653 
12654  & trim(adjustl(pos_array(3))) // ')'
12655 
12656  if ( both_negative( &
12657  & pos(1), &
12658 
12659  & pos(2), &
12660 
12661  & pos(3) ) ) then
12662 
12663  abs_mes = 'ABSOLUTE value of'
12664  else
12665  abs_mes = ''
12666 
12667  end if
12668 
12669  end if
12670  deallocate(mask_array, judge, judge_rev)
12671  deallocate(answer_negative, check_negative, both_negative)
12672 
12673 
12674 
12675 
12676  if (err_flag) then
12677  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12678  write(*,*) ''
12679  write(*,*) ' ' // trim(abs_mes) // &
12680  & ' check' // trim(pos_str) // ' = ', wrong
12681  write(*,*) ' is NOT GREATER THAN'
12682  write(*,*) ' ' // trim(abs_mes) // &
12683  & ' answer' // trim(pos_str) // ' = ', right
12684 
12685  call abortprogram('')
12686  else
12687  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12688  end if
12689 
12690 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble4()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble4 ( character(*), intent(in)  message,
real(dp), dimension(:,:,:,:), intent(in)  answer,
real(dp), dimension(:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12696 of file dc_test.f90.

12696  use sysdep, only: abortprogram
12697  use dc_types, only: string, token
12698  implicit none
12699  character(*), intent(in):: message
12700  real(DP), intent(in):: answer(:,:,:,:)
12701  real(DP), intent(in):: check(:,:,:,:)
12702  logical, intent(in), optional:: negative_support
12703  logical:: err_flag
12704  logical:: negative_support_on
12705  character(STRING):: pos_str
12706  character(TOKEN):: abs_mes
12707  real(DP):: wrong, right
12708 
12709  integer:: answer_shape(4), check_shape(4), pos(4)
12710  logical:: consist_shape(4)
12711  character(TOKEN):: pos_array(4)
12712  integer, allocatable:: mask_array(:,:,:,:)
12713  logical, allocatable:: judge(:,:,:,:)
12714  logical, allocatable:: judge_rev(:,:,:,:)
12715  logical, allocatable:: answer_negative(:,:,:,:)
12716  logical, allocatable:: check_negative(:,:,:,:)
12717  logical, allocatable:: both_negative(:,:,:,:)
12718 
12719 
12720  continue
12721  if (present(negative_support)) then
12722  negative_support_on = negative_support
12723  else
12724  negative_support_on = .true.
12725  end if
12726 
12727  err_flag = .false.
12728 
12729 
12730  answer_shape = shape(answer)
12731  check_shape = shape(check)
12732 
12733  consist_shape = answer_shape == check_shape
12734 
12735  if (.not. all(consist_shape)) then
12736  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12737  write(*,*) ''
12738  write(*,*) ' shape of check is (', check_shape, ')'
12739  write(*,*) ' is INCORRECT'
12740  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
12741 
12742  call abortprogram('')
12743  end if
12744 
12745 
12746  allocate( mask_array( &
12747  & answer_shape(1), &
12748 
12749  & answer_shape(2), &
12750 
12751  & answer_shape(3), &
12752 
12753  & answer_shape(4) ) &
12754  & )
12755 
12756  allocate( judge( &
12757  & answer_shape(1), &
12758 
12759  & answer_shape(2), &
12760 
12761  & answer_shape(3), &
12762 
12763  & answer_shape(4) ) &
12764  & )
12765 
12766  allocate( judge_rev( &
12767  & answer_shape(1), &
12768 
12769  & answer_shape(2), &
12770 
12771  & answer_shape(3), &
12772 
12773  & answer_shape(4) ) &
12774  & )
12775 
12776  allocate( answer_negative( &
12777  & answer_shape(1), &
12778 
12779  & answer_shape(2), &
12780 
12781  & answer_shape(3), &
12782 
12783  & answer_shape(4) ) &
12784  & )
12785 
12786  allocate( check_negative( &
12787  & answer_shape(1), &
12788 
12789  & answer_shape(2), &
12790 
12791  & answer_shape(3), &
12792 
12793  & answer_shape(4) ) &
12794  & )
12795 
12796  allocate( both_negative( &
12797  & answer_shape(1), &
12798 
12799  & answer_shape(2), &
12800 
12801  & answer_shape(3), &
12802 
12803  & answer_shape(4) ) &
12804  & )
12805 
12806  answer_negative = answer < 0.0_dp
12807  check_negative = check < 0.0_dp
12808  both_negative = answer_negative .and. check_negative
12809  if (.not. negative_support_on) both_negative = .false.
12810 
12811  judge = answer < check
12812  where (both_negative) judge = .not. judge
12813 
12814  judge_rev = .not. judge
12815  err_flag = any(judge_rev)
12816  mask_array = 1
12817  pos = maxloc(mask_array, judge_rev)
12818 
12819  if (err_flag) then
12820 
12821  wrong = check( &
12822  & pos(1), &
12823 
12824  & pos(2), &
12825 
12826  & pos(3), &
12827 
12828  & pos(4) )
12829 
12830  right = answer( &
12831  & pos(1), &
12832 
12833  & pos(2), &
12834 
12835  & pos(3), &
12836 
12837  & pos(4) )
12838 
12839  write(unit=pos_array(1), fmt="(i20)") pos(1)
12840 
12841  write(unit=pos_array(2), fmt="(i20)") pos(2)
12842 
12843  write(unit=pos_array(3), fmt="(i20)") pos(3)
12844 
12845  write(unit=pos_array(4), fmt="(i20)") pos(4)
12846 
12847 
12848  pos_str = '(' // &
12849  & trim(adjustl(pos_array(1))) // ',' // &
12850 
12851  & trim(adjustl(pos_array(2))) // ',' // &
12852 
12853  & trim(adjustl(pos_array(3))) // ',' // &
12854 
12855  & trim(adjustl(pos_array(4))) // ')'
12856 
12857  if ( both_negative( &
12858  & pos(1), &
12859 
12860  & pos(2), &
12861 
12862  & pos(3), &
12863 
12864  & pos(4) ) ) then
12865 
12866  abs_mes = 'ABSOLUTE value of'
12867  else
12868  abs_mes = ''
12869 
12870  end if
12871 
12872  end if
12873  deallocate(mask_array, judge, judge_rev)
12874  deallocate(answer_negative, check_negative, both_negative)
12875 
12876 
12877 
12878 
12879  if (err_flag) then
12880  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12881  write(*,*) ''
12882  write(*,*) ' ' // trim(abs_mes) // &
12883  & ' check' // trim(pos_str) // ' = ', wrong
12884  write(*,*) ' is NOT GREATER THAN'
12885  write(*,*) ' ' // trim(abs_mes) // &
12886  & ' answer' // trim(pos_str) // ' = ', right
12887 
12888  call abortprogram('')
12889  else
12890  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12891  end if
12892 
12893 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble5()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble5 ( character(*), intent(in)  message,
real(dp), dimension(:,:,:,:,:), intent(in)  answer,
real(dp), dimension(:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 12899 of file dc_test.f90.

12899  use sysdep, only: abortprogram
12900  use dc_types, only: string, token
12901  implicit none
12902  character(*), intent(in):: message
12903  real(DP), intent(in):: answer(:,:,:,:,:)
12904  real(DP), intent(in):: check(:,:,:,:,:)
12905  logical, intent(in), optional:: negative_support
12906  logical:: err_flag
12907  logical:: negative_support_on
12908  character(STRING):: pos_str
12909  character(TOKEN):: abs_mes
12910  real(DP):: wrong, right
12911 
12912  integer:: answer_shape(5), check_shape(5), pos(5)
12913  logical:: consist_shape(5)
12914  character(TOKEN):: pos_array(5)
12915  integer, allocatable:: mask_array(:,:,:,:,:)
12916  logical, allocatable:: judge(:,:,:,:,:)
12917  logical, allocatable:: judge_rev(:,:,:,:,:)
12918  logical, allocatable:: answer_negative(:,:,:,:,:)
12919  logical, allocatable:: check_negative(:,:,:,:,:)
12920  logical, allocatable:: both_negative(:,:,:,:,:)
12921 
12922 
12923  continue
12924  if (present(negative_support)) then
12925  negative_support_on = negative_support
12926  else
12927  negative_support_on = .true.
12928  end if
12929 
12930  err_flag = .false.
12931 
12932 
12933  answer_shape = shape(answer)
12934  check_shape = shape(check)
12935 
12936  consist_shape = answer_shape == check_shape
12937 
12938  if (.not. all(consist_shape)) then
12939  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12940  write(*,*) ''
12941  write(*,*) ' shape of check is (', check_shape, ')'
12942  write(*,*) ' is INCORRECT'
12943  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
12944 
12945  call abortprogram('')
12946  end if
12947 
12948 
12949  allocate( mask_array( &
12950  & answer_shape(1), &
12951 
12952  & answer_shape(2), &
12953 
12954  & answer_shape(3), &
12955 
12956  & answer_shape(4), &
12957 
12958  & answer_shape(5) ) &
12959  & )
12960 
12961  allocate( judge( &
12962  & answer_shape(1), &
12963 
12964  & answer_shape(2), &
12965 
12966  & answer_shape(3), &
12967 
12968  & answer_shape(4), &
12969 
12970  & answer_shape(5) ) &
12971  & )
12972 
12973  allocate( judge_rev( &
12974  & answer_shape(1), &
12975 
12976  & answer_shape(2), &
12977 
12978  & answer_shape(3), &
12979 
12980  & answer_shape(4), &
12981 
12982  & answer_shape(5) ) &
12983  & )
12984 
12985  allocate( answer_negative( &
12986  & answer_shape(1), &
12987 
12988  & answer_shape(2), &
12989 
12990  & answer_shape(3), &
12991 
12992  & answer_shape(4), &
12993 
12994  & answer_shape(5) ) &
12995  & )
12996 
12997  allocate( check_negative( &
12998  & answer_shape(1), &
12999 
13000  & answer_shape(2), &
13001 
13002  & answer_shape(3), &
13003 
13004  & answer_shape(4), &
13005 
13006  & answer_shape(5) ) &
13007  & )
13008 
13009  allocate( both_negative( &
13010  & answer_shape(1), &
13011 
13012  & answer_shape(2), &
13013 
13014  & answer_shape(3), &
13015 
13016  & answer_shape(4), &
13017 
13018  & answer_shape(5) ) &
13019  & )
13020 
13021  answer_negative = answer < 0.0_dp
13022  check_negative = check < 0.0_dp
13023  both_negative = answer_negative .and. check_negative
13024  if (.not. negative_support_on) both_negative = .false.
13025 
13026  judge = answer < check
13027  where (both_negative) judge = .not. judge
13028 
13029  judge_rev = .not. judge
13030  err_flag = any(judge_rev)
13031  mask_array = 1
13032  pos = maxloc(mask_array, judge_rev)
13033 
13034  if (err_flag) then
13035 
13036  wrong = check( &
13037  & pos(1), &
13038 
13039  & pos(2), &
13040 
13041  & pos(3), &
13042 
13043  & pos(4), &
13044 
13045  & pos(5) )
13046 
13047  right = answer( &
13048  & pos(1), &
13049 
13050  & pos(2), &
13051 
13052  & pos(3), &
13053 
13054  & pos(4), &
13055 
13056  & pos(5) )
13057 
13058  write(unit=pos_array(1), fmt="(i20)") pos(1)
13059 
13060  write(unit=pos_array(2), fmt="(i20)") pos(2)
13061 
13062  write(unit=pos_array(3), fmt="(i20)") pos(3)
13063 
13064  write(unit=pos_array(4), fmt="(i20)") pos(4)
13065 
13066  write(unit=pos_array(5), fmt="(i20)") pos(5)
13067 
13068 
13069  pos_str = '(' // &
13070  & trim(adjustl(pos_array(1))) // ',' // &
13071 
13072  & trim(adjustl(pos_array(2))) // ',' // &
13073 
13074  & trim(adjustl(pos_array(3))) // ',' // &
13075 
13076  & trim(adjustl(pos_array(4))) // ',' // &
13077 
13078  & trim(adjustl(pos_array(5))) // ')'
13079 
13080  if ( both_negative( &
13081  & pos(1), &
13082 
13083  & pos(2), &
13084 
13085  & pos(3), &
13086 
13087  & pos(4), &
13088 
13089  & pos(5) ) ) then
13090 
13091  abs_mes = 'ABSOLUTE value of'
13092  else
13093  abs_mes = ''
13094 
13095  end if
13096 
13097  end if
13098  deallocate(mask_array, judge, judge_rev)
13099  deallocate(answer_negative, check_negative, both_negative)
13100 
13101 
13102 
13103 
13104  if (err_flag) then
13105  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
13106  write(*,*) ''
13107  write(*,*) ' ' // trim(abs_mes) // &
13108  & ' check' // trim(pos_str) // ' = ', wrong
13109  write(*,*) ' is NOT GREATER THAN'
13110  write(*,*) ' ' // trim(abs_mes) // &
13111  & ' answer' // trim(pos_str) // ' = ', right
13112 
13113  call abortprogram('')
13114  else
13115  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
13116  end if
13117 
13118 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble6()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble6 ( character(*), intent(in)  message,
real(dp), dimension(:,:,:,:,:,:), intent(in)  answer,
real(dp), dimension(:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 13124 of file dc_test.f90.

13124  use sysdep, only: abortprogram
13125  use dc_types, only: string, token
13126  implicit none
13127  character(*), intent(in):: message
13128  real(DP), intent(in):: answer(:,:,:,:,:,:)
13129  real(DP), intent(in):: check(:,:,:,:,:,:)
13130  logical, intent(in), optional:: negative_support
13131  logical:: err_flag
13132  logical:: negative_support_on
13133  character(STRING):: pos_str
13134  character(TOKEN):: abs_mes
13135  real(DP):: wrong, right
13136 
13137  integer:: answer_shape(6), check_shape(6), pos(6)
13138  logical:: consist_shape(6)
13139  character(TOKEN):: pos_array(6)
13140  integer, allocatable:: mask_array(:,:,:,:,:,:)
13141  logical, allocatable:: judge(:,:,:,:,:,:)
13142  logical, allocatable:: judge_rev(:,:,:,:,:,:)
13143  logical, allocatable:: answer_negative(:,:,:,:,:,:)
13144  logical, allocatable:: check_negative(:,:,:,:,:,:)
13145  logical, allocatable:: both_negative(:,:,:,:,:,:)
13146 
13147 
13148  continue
13149  if (present(negative_support)) then
13150  negative_support_on = negative_support
13151  else
13152  negative_support_on = .true.
13153  end if
13154 
13155  err_flag = .false.
13156 
13157 
13158  answer_shape = shape(answer)
13159  check_shape = shape(check)
13160 
13161  consist_shape = answer_shape == check_shape
13162 
13163  if (.not. all(consist_shape)) then
13164  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
13165  write(*,*) ''
13166  write(*,*) ' shape of check is (', check_shape, ')'
13167  write(*,*) ' is INCORRECT'
13168  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
13169 
13170  call abortprogram('')
13171  end if
13172 
13173 
13174  allocate( mask_array( &
13175  & answer_shape(1), &
13176 
13177  & answer_shape(2), &
13178 
13179  & answer_shape(3), &
13180 
13181  & answer_shape(4), &
13182 
13183  & answer_shape(5), &
13184 
13185  & answer_shape(6) ) &
13186  & )
13187 
13188  allocate( judge( &
13189  & answer_shape(1), &
13190 
13191  & answer_shape(2), &
13192 
13193  & answer_shape(3), &
13194 
13195  & answer_shape(4), &
13196 
13197  & answer_shape(5), &
13198 
13199  & answer_shape(6) ) &
13200  & )
13201 
13202  allocate( judge_rev( &
13203  & answer_shape(1), &
13204 
13205  & answer_shape(2), &
13206 
13207  & answer_shape(3), &
13208 
13209  & answer_shape(4), &
13210 
13211  & answer_shape(5), &
13212 
13213  & answer_shape(6) ) &
13214  & )
13215 
13216  allocate( answer_negative( &
13217  & answer_shape(1), &
13218 
13219  & answer_shape(2), &
13220 
13221  & answer_shape(3), &
13222 
13223  & answer_shape(4), &
13224 
13225  & answer_shape(5), &
13226 
13227  & answer_shape(6) ) &
13228  & )
13229 
13230  allocate( check_negative( &
13231  & answer_shape(1), &
13232 
13233  & answer_shape(2), &
13234 
13235  & answer_shape(3), &
13236 
13237  & answer_shape(4), &
13238 
13239  & answer_shape(5), &
13240 
13241  & answer_shape(6) ) &
13242  & )
13243 
13244  allocate( both_negative( &
13245  & answer_shape(1), &
13246 
13247  & answer_shape(2), &
13248 
13249  & answer_shape(3), &
13250 
13251  & answer_shape(4), &
13252 
13253  & answer_shape(5), &
13254 
13255  & answer_shape(6) ) &
13256  & )
13257 
13258  answer_negative = answer < 0.0_dp
13259  check_negative = check < 0.0_dp
13260  both_negative = answer_negative .and. check_negative
13261  if (.not. negative_support_on) both_negative = .false.
13262 
13263  judge = answer < check
13264  where (both_negative) judge = .not. judge
13265 
13266  judge_rev = .not. judge
13267  err_flag = any(judge_rev)
13268  mask_array = 1
13269  pos = maxloc(mask_array, judge_rev)
13270 
13271  if (err_flag) then
13272 
13273  wrong = check( &
13274  & pos(1), &
13275 
13276  & pos(2), &
13277 
13278  & pos(3), &
13279 
13280  & pos(4), &
13281 
13282  & pos(5), &
13283 
13284  & pos(6) )
13285 
13286  right = answer( &
13287  & pos(1), &
13288 
13289  & pos(2), &
13290 
13291  & pos(3), &
13292 
13293  & pos(4), &
13294 
13295  & pos(5), &
13296 
13297  & pos(6) )
13298 
13299  write(unit=pos_array(1), fmt="(i20)") pos(1)
13300 
13301  write(unit=pos_array(2), fmt="(i20)") pos(2)
13302 
13303  write(unit=pos_array(3), fmt="(i20)") pos(3)
13304 
13305  write(unit=pos_array(4), fmt="(i20)") pos(4)
13306 
13307  write(unit=pos_array(5), fmt="(i20)") pos(5)
13308 
13309  write(unit=pos_array(6), fmt="(i20)") pos(6)
13310 
13311 
13312  pos_str = '(' // &
13313  & trim(adjustl(pos_array(1))) // ',' // &
13314 
13315  & trim(adjustl(pos_array(2))) // ',' // &
13316 
13317  & trim(adjustl(pos_array(3))) // ',' // &
13318 
13319  & trim(adjustl(pos_array(4))) // ',' // &
13320 
13321  & trim(adjustl(pos_array(5))) // ',' // &
13322 
13323  & trim(adjustl(pos_array(6))) // ')'
13324 
13325  if ( both_negative( &
13326  & pos(1), &
13327 
13328  & pos(2), &
13329 
13330  & pos(3), &
13331 
13332  & pos(4), &
13333 
13334  & pos(5), &
13335 
13336  & pos(6) ) ) then
13337 
13338  abs_mes = 'ABSOLUTE value of'
13339  else
13340  abs_mes = ''
13341 
13342  end if
13343 
13344  end if
13345  deallocate(mask_array, judge, judge_rev)
13346  deallocate(answer_negative, check_negative, both_negative)
13347 
13348 
13349 
13350 
13351  if (err_flag) then
13352  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
13353  write(*,*) ''
13354  write(*,*) ' ' // trim(abs_mes) // &
13355  & ' check' // trim(pos_str) // ' = ', wrong
13356  write(*,*) ' is NOT GREATER THAN'
13357  write(*,*) ' ' // trim(abs_mes) // &
13358  & ' answer' // trim(pos_str) // ' = ', right
13359 
13360  call abortprogram('')
13361  else
13362  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
13363  end if
13364 
13365 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthandouble7()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthandouble7 ( character(*), intent(in)  message,
real(dp), dimension(:,:,:,:,:,:,:), intent(in)  answer,
real(dp), dimension(:,:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 13371 of file dc_test.f90.

13371  use sysdep, only: abortprogram
13372  use dc_types, only: string, token
13373  implicit none
13374  character(*), intent(in):: message
13375  real(DP), intent(in):: answer(:,:,:,:,:,:,:)
13376  real(DP), intent(in):: check(:,:,:,:,:,:,:)
13377  logical, intent(in), optional:: negative_support
13378  logical:: err_flag
13379  logical:: negative_support_on
13380  character(STRING):: pos_str
13381  character(TOKEN):: abs_mes
13382  real(DP):: wrong, right
13383 
13384  integer:: answer_shape(7), check_shape(7), pos(7)
13385  logical:: consist_shape(7)
13386  character(TOKEN):: pos_array(7)
13387  integer, allocatable:: mask_array(:,:,:,:,:,:,:)
13388  logical, allocatable:: judge(:,:,:,:,:,:,:)
13389  logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
13390  logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
13391  logical, allocatable:: check_negative(:,:,:,:,:,:,:)
13392  logical, allocatable:: both_negative(:,:,:,:,:,:,:)
13393 
13394 
13395  continue
13396  if (present(negative_support)) then
13397  negative_support_on = negative_support
13398  else
13399  negative_support_on = .true.
13400  end if
13401 
13402  err_flag = .false.
13403 
13404 
13405  answer_shape = shape(answer)
13406  check_shape = shape(check)
13407 
13408  consist_shape = answer_shape == check_shape
13409 
13410  if (.not. all(consist_shape)) then
13411  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
13412  write(*,*) ''
13413  write(*,*) ' shape of check is (', check_shape, ')'
13414  write(*,*) ' is INCORRECT'
13415  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
13416 
13417  call abortprogram('')
13418  end if
13419 
13420 
13421  allocate( mask_array( &
13422  & answer_shape(1), &
13423 
13424  & answer_shape(2), &
13425 
13426  & answer_shape(3), &
13427 
13428  & answer_shape(4), &
13429 
13430  & answer_shape(5), &
13431 
13432  & answer_shape(6), &
13433 
13434  & answer_shape(7) ) &
13435  & )
13436 
13437  allocate( judge( &
13438  & answer_shape(1), &
13439 
13440  & answer_shape(2), &
13441 
13442  & answer_shape(3), &
13443 
13444  & answer_shape(4), &
13445 
13446  & answer_shape(5), &
13447 
13448  & answer_shape(6), &
13449 
13450  & answer_shape(7) ) &
13451  & )
13452 
13453  allocate( judge_rev( &
13454  & answer_shape(1), &
13455 
13456  & answer_shape(2), &
13457 
13458  & answer_shape(3), &
13459 
13460  & answer_shape(4), &
13461 
13462  & answer_shape(5), &
13463 
13464  & answer_shape(6), &
13465 
13466  & answer_shape(7) ) &
13467  & )
13468 
13469  allocate( answer_negative( &
13470  & answer_shape(1), &
13471 
13472  & answer_shape(2), &
13473 
13474  & answer_shape(3), &
13475 
13476  & answer_shape(4), &
13477 
13478  & answer_shape(5), &
13479 
13480  & answer_shape(6), &
13481 
13482  & answer_shape(7) ) &
13483  & )
13484 
13485  allocate( check_negative( &
13486  & answer_shape(1), &
13487 
13488  & answer_shape(2), &
13489 
13490  & answer_shape(3), &
13491 
13492  & answer_shape(4), &
13493 
13494  & answer_shape(5), &
13495 
13496  & answer_shape(6), &
13497 
13498  & answer_shape(7) ) &
13499  & )
13500 
13501  allocate( both_negative( &
13502  & answer_shape(1), &
13503 
13504  & answer_shape(2), &
13505 
13506  & answer_shape(3), &
13507 
13508  & answer_shape(4), &
13509 
13510  & answer_shape(5), &
13511 
13512  & answer_shape(6), &
13513 
13514  & answer_shape(7) ) &
13515  & )
13516 
13517  answer_negative = answer < 0.0_dp
13518  check_negative = check < 0.0_dp
13519  both_negative = answer_negative .and. check_negative
13520  if (.not. negative_support_on) both_negative = .false.
13521 
13522  judge = answer < check
13523  where (both_negative) judge = .not. judge
13524 
13525  judge_rev = .not. judge
13526  err_flag = any(judge_rev)
13527  mask_array = 1
13528  pos = maxloc(mask_array, judge_rev)
13529 
13530  if (err_flag) then
13531 
13532  wrong = check( &
13533  & pos(1), &
13534 
13535  & pos(2), &
13536 
13537  & pos(3), &
13538 
13539  & pos(4), &
13540 
13541  & pos(5), &
13542 
13543  & pos(6), &
13544 
13545  & pos(7) )
13546 
13547  right = answer( &
13548  & pos(1), &
13549 
13550  & pos(2), &
13551 
13552  & pos(3), &
13553 
13554  & pos(4), &
13555 
13556  & pos(5), &
13557 
13558  & pos(6), &
13559 
13560  & pos(7) )
13561 
13562  write(unit=pos_array(1), fmt="(i20)") pos(1)
13563 
13564  write(unit=pos_array(2), fmt="(i20)") pos(2)
13565 
13566  write(unit=pos_array(3), fmt="(i20)") pos(3)
13567 
13568  write(unit=pos_array(4), fmt="(i20)") pos(4)
13569 
13570  write(unit=pos_array(5), fmt="(i20)") pos(5)
13571 
13572  write(unit=pos_array(6), fmt="(i20)") pos(6)
13573 
13574  write(unit=pos_array(7), fmt="(i20)") pos(7)
13575 
13576 
13577  pos_str = '(' // &
13578  & trim(adjustl(pos_array(1))) // ',' // &
13579 
13580  & trim(adjustl(pos_array(2))) // ',' // &
13581 
13582  & trim(adjustl(pos_array(3))) // ',' // &
13583 
13584  & trim(adjustl(pos_array(4))) // ',' // &
13585 
13586  & trim(adjustl(pos_array(5))) // ',' // &
13587 
13588  & trim(adjustl(pos_array(6))) // ',' // &
13589 
13590  & trim(adjustl(pos_array(7))) // ')'
13591 
13592  if ( both_negative( &
13593  & pos(1), &
13594 
13595  & pos(2), &
13596 
13597  & pos(3), &
13598 
13599  & pos(4), &
13600 
13601  & pos(5), &
13602 
13603  & pos(6), &
13604 
13605  & pos(7) ) ) then
13606 
13607  abs_mes = 'ABSOLUTE value of'
13608  else
13609  abs_mes = ''
13610 
13611  end if
13612 
13613  end if
13614  deallocate(mask_array, judge, judge_rev)
13615  deallocate(answer_negative, check_negative, both_negative)
13616 
13617 
13618 
13619 
13620  if (err_flag) then
13621  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
13622  write(*,*) ''
13623  write(*,*) ' ' // trim(abs_mes) // &
13624  & ' check' // trim(pos_str) // ' = ', wrong
13625  write(*,*) ' is NOT GREATER THAN'
13626  write(*,*) ' ' // trim(abs_mes) // &
13627  & ' answer' // trim(pos_str) // ' = ', right
13628 
13629  call abortprogram('')
13630  else
13631  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
13632  end if
13633 
13634 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint0()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint0 ( character(*), intent(in)  message,
integer, intent(in)  answer,
integer, intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9158 of file dc_test.f90.

9158  use sysdep, only: abortprogram
9159  use dc_types, only: string, token
9160  implicit none
9161  character(*), intent(in):: message
9162  integer, intent(in):: answer
9163  integer, intent(in):: check
9164  logical, intent(in), optional:: negative_support
9165  logical:: err_flag
9166  logical:: negative_support_on
9167  character(STRING):: pos_str
9168  character(TOKEN):: abs_mes
9169  integer:: wrong, right
9170 
9171 
9172 
9173  continue
9174  if (present(negative_support)) then
9175  negative_support_on = negative_support
9176  else
9177  negative_support_on = .true.
9178  end if
9179 
9180  err_flag = .false.
9181 
9182 
9183  err_flag = .not. answer < check
9184  abs_mes = ''
9185 
9186  if ( answer < 0 &
9187  & .and. check < 0 &
9188  & .and. negative_support_on ) then
9189 
9190  err_flag = .not. err_flag
9191  abs_mes = 'ABSOLUTE value of'
9192  end if
9193 
9194  wrong = check
9195  right = answer
9196  pos_str = ''
9197 
9198 
9199 
9200 
9201  if (err_flag) then
9202  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9203  write(*,*) ''
9204  write(*,*) ' ' // trim(abs_mes) // &
9205  & ' check' // trim(pos_str) // ' = ', wrong
9206  write(*,*) ' is NOT GREATER THAN'
9207  write(*,*) ' ' // trim(abs_mes) // &
9208  & ' answer' // trim(pos_str) // ' = ', right
9209 
9210  call abortprogram('')
9211  else
9212  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
9213  end if
9214 
9215 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint1()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint1 ( character(*), intent(in)  message,
integer, dimension(:), intent(in)  answer,
integer, dimension(:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9221 of file dc_test.f90.

9221  use sysdep, only: abortprogram
9222  use dc_types, only: string, token
9223  implicit none
9224  character(*), intent(in):: message
9225  integer, intent(in):: answer(:)
9226  integer, intent(in):: check(:)
9227  logical, intent(in), optional:: negative_support
9228  logical:: err_flag
9229  logical:: negative_support_on
9230  character(STRING):: pos_str
9231  character(TOKEN):: abs_mes
9232  integer:: wrong, right
9233 
9234  integer:: answer_shape(1), check_shape(1), pos(1)
9235  logical:: consist_shape(1)
9236  character(TOKEN):: pos_array(1)
9237  integer, allocatable:: mask_array(:)
9238  logical, allocatable:: judge(:)
9239  logical, allocatable:: judge_rev(:)
9240  logical, allocatable:: answer_negative(:)
9241  logical, allocatable:: check_negative(:)
9242  logical, allocatable:: both_negative(:)
9243 
9244 
9245  continue
9246  if (present(negative_support)) then
9247  negative_support_on = negative_support
9248  else
9249  negative_support_on = .true.
9250  end if
9251 
9252  err_flag = .false.
9253 
9254 
9255  answer_shape = shape(answer)
9256  check_shape = shape(check)
9257 
9258  consist_shape = answer_shape == check_shape
9259 
9260  if (.not. all(consist_shape)) then
9261  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9262  write(*,*) ''
9263  write(*,*) ' shape of check is (', check_shape, ')'
9264  write(*,*) ' is INCORRECT'
9265  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
9266 
9267  call abortprogram('')
9268  end if
9269 
9270 
9271  allocate( mask_array( &
9272 
9273  & answer_shape(1) ) &
9274  & )
9275 
9276  allocate( judge( &
9277 
9278  & answer_shape(1) ) &
9279  & )
9280 
9281  allocate( judge_rev( &
9282 
9283  & answer_shape(1) ) &
9284  & )
9285 
9286  allocate( answer_negative( &
9287 
9288  & answer_shape(1) ) &
9289  & )
9290 
9291  allocate( check_negative( &
9292 
9293  & answer_shape(1) ) &
9294  & )
9295 
9296  allocate( both_negative( &
9297 
9298  & answer_shape(1) ) &
9299  & )
9300 
9301  answer_negative = answer < 0
9302  check_negative = check < 0
9303  both_negative = answer_negative .and. check_negative
9304  if (.not. negative_support_on) both_negative = .false.
9305 
9306  judge = answer < check
9307  where (both_negative) judge = .not. judge
9308 
9309  judge_rev = .not. judge
9310  err_flag = any(judge_rev)
9311  mask_array = 1
9312  pos = maxloc(mask_array, judge_rev)
9313 
9314  if (err_flag) then
9315 
9316  wrong = check( &
9317 
9318  & pos(1) )
9319 
9320  right = answer( &
9321 
9322  & pos(1) )
9323 
9324  write(unit=pos_array(1), fmt="(i20)") pos(1)
9325 
9326 
9327  pos_str = '(' // &
9328 
9329  & trim(adjustl(pos_array(1))) // ')'
9330 
9331  if ( both_negative( &
9332 
9333  & pos(1) ) ) then
9334 
9335  abs_mes = 'ABSOLUTE value of'
9336  else
9337  abs_mes = ''
9338 
9339  end if
9340 
9341  end if
9342  deallocate(mask_array, judge, judge_rev)
9343  deallocate(answer_negative, check_negative, both_negative)
9344 
9345 
9346 
9347 
9348  if (err_flag) then
9349  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9350  write(*,*) ''
9351  write(*,*) ' ' // trim(abs_mes) // &
9352  & ' check' // trim(pos_str) // ' = ', wrong
9353  write(*,*) ' is NOT GREATER THAN'
9354  write(*,*) ' ' // trim(abs_mes) // &
9355  & ' answer' // trim(pos_str) // ' = ', right
9356 
9357  call abortprogram('')
9358  else
9359  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
9360  end if
9361 
9362 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint2()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint2 ( character(*), intent(in)  message,
integer, dimension(:,:), intent(in)  answer,
integer, dimension(:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9368 of file dc_test.f90.

9368  use sysdep, only: abortprogram
9369  use dc_types, only: string, token
9370  implicit none
9371  character(*), intent(in):: message
9372  integer, intent(in):: answer(:,:)
9373  integer, intent(in):: check(:,:)
9374  logical, intent(in), optional:: negative_support
9375  logical:: err_flag
9376  logical:: negative_support_on
9377  character(STRING):: pos_str
9378  character(TOKEN):: abs_mes
9379  integer:: wrong, right
9380 
9381  integer:: answer_shape(2), check_shape(2), pos(2)
9382  logical:: consist_shape(2)
9383  character(TOKEN):: pos_array(2)
9384  integer, allocatable:: mask_array(:,:)
9385  logical, allocatable:: judge(:,:)
9386  logical, allocatable:: judge_rev(:,:)
9387  logical, allocatable:: answer_negative(:,:)
9388  logical, allocatable:: check_negative(:,:)
9389  logical, allocatable:: both_negative(:,:)
9390 
9391 
9392  continue
9393  if (present(negative_support)) then
9394  negative_support_on = negative_support
9395  else
9396  negative_support_on = .true.
9397  end if
9398 
9399  err_flag = .false.
9400 
9401 
9402  answer_shape = shape(answer)
9403  check_shape = shape(check)
9404 
9405  consist_shape = answer_shape == check_shape
9406 
9407  if (.not. all(consist_shape)) then
9408  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9409  write(*,*) ''
9410  write(*,*) ' shape of check is (', check_shape, ')'
9411  write(*,*) ' is INCORRECT'
9412  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
9413 
9414  call abortprogram('')
9415  end if
9416 
9417 
9418  allocate( mask_array( &
9419  & answer_shape(1), &
9420 
9421  & answer_shape(2) ) &
9422  & )
9423 
9424  allocate( judge( &
9425  & answer_shape(1), &
9426 
9427  & answer_shape(2) ) &
9428  & )
9429 
9430  allocate( judge_rev( &
9431  & answer_shape(1), &
9432 
9433  & answer_shape(2) ) &
9434  & )
9435 
9436  allocate( answer_negative( &
9437  & answer_shape(1), &
9438 
9439  & answer_shape(2) ) &
9440  & )
9441 
9442  allocate( check_negative( &
9443  & answer_shape(1), &
9444 
9445  & answer_shape(2) ) &
9446  & )
9447 
9448  allocate( both_negative( &
9449  & answer_shape(1), &
9450 
9451  & answer_shape(2) ) &
9452  & )
9453 
9454  answer_negative = answer < 0
9455  check_negative = check < 0
9456  both_negative = answer_negative .and. check_negative
9457  if (.not. negative_support_on) both_negative = .false.
9458 
9459  judge = answer < check
9460  where (both_negative) judge = .not. judge
9461 
9462  judge_rev = .not. judge
9463  err_flag = any(judge_rev)
9464  mask_array = 1
9465  pos = maxloc(mask_array, judge_rev)
9466 
9467  if (err_flag) then
9468 
9469  wrong = check( &
9470  & pos(1), &
9471 
9472  & pos(2) )
9473 
9474  right = answer( &
9475  & pos(1), &
9476 
9477  & pos(2) )
9478 
9479  write(unit=pos_array(1), fmt="(i20)") pos(1)
9480 
9481  write(unit=pos_array(2), fmt="(i20)") pos(2)
9482 
9483 
9484  pos_str = '(' // &
9485  & trim(adjustl(pos_array(1))) // ',' // &
9486 
9487  & trim(adjustl(pos_array(2))) // ')'
9488 
9489  if ( both_negative( &
9490  & pos(1), &
9491 
9492  & pos(2) ) ) then
9493 
9494  abs_mes = 'ABSOLUTE value of'
9495  else
9496  abs_mes = ''
9497 
9498  end if
9499 
9500  end if
9501  deallocate(mask_array, judge, judge_rev)
9502  deallocate(answer_negative, check_negative, both_negative)
9503 
9504 
9505 
9506 
9507  if (err_flag) then
9508  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9509  write(*,*) ''
9510  write(*,*) ' ' // trim(abs_mes) // &
9511  & ' check' // trim(pos_str) // ' = ', wrong
9512  write(*,*) ' is NOT GREATER THAN'
9513  write(*,*) ' ' // trim(abs_mes) // &
9514  & ' answer' // trim(pos_str) // ' = ', right
9515 
9516  call abortprogram('')
9517  else
9518  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
9519  end if
9520 
9521 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint3()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint3 ( character(*), intent(in)  message,
integer, dimension(:,:,:), intent(in)  answer,
integer, dimension(:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9527 of file dc_test.f90.

9527  use sysdep, only: abortprogram
9528  use dc_types, only: string, token
9529  implicit none
9530  character(*), intent(in):: message
9531  integer, intent(in):: answer(:,:,:)
9532  integer, intent(in):: check(:,:,:)
9533  logical, intent(in), optional:: negative_support
9534  logical:: err_flag
9535  logical:: negative_support_on
9536  character(STRING):: pos_str
9537  character(TOKEN):: abs_mes
9538  integer:: wrong, right
9539 
9540  integer:: answer_shape(3), check_shape(3), pos(3)
9541  logical:: consist_shape(3)
9542  character(TOKEN):: pos_array(3)
9543  integer, allocatable:: mask_array(:,:,:)
9544  logical, allocatable:: judge(:,:,:)
9545  logical, allocatable:: judge_rev(:,:,:)
9546  logical, allocatable:: answer_negative(:,:,:)
9547  logical, allocatable:: check_negative(:,:,:)
9548  logical, allocatable:: both_negative(:,:,:)
9549 
9550 
9551  continue
9552  if (present(negative_support)) then
9553  negative_support_on = negative_support
9554  else
9555  negative_support_on = .true.
9556  end if
9557 
9558  err_flag = .false.
9559 
9560 
9561  answer_shape = shape(answer)
9562  check_shape = shape(check)
9563 
9564  consist_shape = answer_shape == check_shape
9565 
9566  if (.not. all(consist_shape)) then
9567  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9568  write(*,*) ''
9569  write(*,*) ' shape of check is (', check_shape, ')'
9570  write(*,*) ' is INCORRECT'
9571  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
9572 
9573  call abortprogram('')
9574  end if
9575 
9576 
9577  allocate( mask_array( &
9578  & answer_shape(1), &
9579 
9580  & answer_shape(2), &
9581 
9582  & answer_shape(3) ) &
9583  & )
9584 
9585  allocate( judge( &
9586  & answer_shape(1), &
9587 
9588  & answer_shape(2), &
9589 
9590  & answer_shape(3) ) &
9591  & )
9592 
9593  allocate( judge_rev( &
9594  & answer_shape(1), &
9595 
9596  & answer_shape(2), &
9597 
9598  & answer_shape(3) ) &
9599  & )
9600 
9601  allocate( answer_negative( &
9602  & answer_shape(1), &
9603 
9604  & answer_shape(2), &
9605 
9606  & answer_shape(3) ) &
9607  & )
9608 
9609  allocate( check_negative( &
9610  & answer_shape(1), &
9611 
9612  & answer_shape(2), &
9613 
9614  & answer_shape(3) ) &
9615  & )
9616 
9617  allocate( both_negative( &
9618  & answer_shape(1), &
9619 
9620  & answer_shape(2), &
9621 
9622  & answer_shape(3) ) &
9623  & )
9624 
9625  answer_negative = answer < 0
9626  check_negative = check < 0
9627  both_negative = answer_negative .and. check_negative
9628  if (.not. negative_support_on) both_negative = .false.
9629 
9630  judge = answer < check
9631  where (both_negative) judge = .not. judge
9632 
9633  judge_rev = .not. judge
9634  err_flag = any(judge_rev)
9635  mask_array = 1
9636  pos = maxloc(mask_array, judge_rev)
9637 
9638  if (err_flag) then
9639 
9640  wrong = check( &
9641  & pos(1), &
9642 
9643  & pos(2), &
9644 
9645  & pos(3) )
9646 
9647  right = answer( &
9648  & pos(1), &
9649 
9650  & pos(2), &
9651 
9652  & pos(3) )
9653 
9654  write(unit=pos_array(1), fmt="(i20)") pos(1)
9655 
9656  write(unit=pos_array(2), fmt="(i20)") pos(2)
9657 
9658  write(unit=pos_array(3), fmt="(i20)") pos(3)
9659 
9660 
9661  pos_str = '(' // &
9662  & trim(adjustl(pos_array(1))) // ',' // &
9663 
9664  & trim(adjustl(pos_array(2))) // ',' // &
9665 
9666  & trim(adjustl(pos_array(3))) // ')'
9667 
9668  if ( both_negative( &
9669  & pos(1), &
9670 
9671  & pos(2), &
9672 
9673  & pos(3) ) ) then
9674 
9675  abs_mes = 'ABSOLUTE value of'
9676  else
9677  abs_mes = ''
9678 
9679  end if
9680 
9681  end if
9682  deallocate(mask_array, judge, judge_rev)
9683  deallocate(answer_negative, check_negative, both_negative)
9684 
9685 
9686 
9687 
9688  if (err_flag) then
9689  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9690  write(*,*) ''
9691  write(*,*) ' ' // trim(abs_mes) // &
9692  & ' check' // trim(pos_str) // ' = ', wrong
9693  write(*,*) ' is NOT GREATER THAN'
9694  write(*,*) ' ' // trim(abs_mes) // &
9695  & ' answer' // trim(pos_str) // ' = ', right
9696 
9697  call abortprogram('')
9698  else
9699  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
9700  end if
9701 
9702 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint4()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint4 ( character(*), intent(in)  message,
integer, dimension(:,:,:,:), intent(in)  answer,
integer, dimension(:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9708 of file dc_test.f90.

9708  use sysdep, only: abortprogram
9709  use dc_types, only: string, token
9710  implicit none
9711  character(*), intent(in):: message
9712  integer, intent(in):: answer(:,:,:,:)
9713  integer, intent(in):: check(:,:,:,:)
9714  logical, intent(in), optional:: negative_support
9715  logical:: err_flag
9716  logical:: negative_support_on
9717  character(STRING):: pos_str
9718  character(TOKEN):: abs_mes
9719  integer:: wrong, right
9720 
9721  integer:: answer_shape(4), check_shape(4), pos(4)
9722  logical:: consist_shape(4)
9723  character(TOKEN):: pos_array(4)
9724  integer, allocatable:: mask_array(:,:,:,:)
9725  logical, allocatable:: judge(:,:,:,:)
9726  logical, allocatable:: judge_rev(:,:,:,:)
9727  logical, allocatable:: answer_negative(:,:,:,:)
9728  logical, allocatable:: check_negative(:,:,:,:)
9729  logical, allocatable:: both_negative(:,:,:,:)
9730 
9731 
9732  continue
9733  if (present(negative_support)) then
9734  negative_support_on = negative_support
9735  else
9736  negative_support_on = .true.
9737  end if
9738 
9739  err_flag = .false.
9740 
9741 
9742  answer_shape = shape(answer)
9743  check_shape = shape(check)
9744 
9745  consist_shape = answer_shape == check_shape
9746 
9747  if (.not. all(consist_shape)) then
9748  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9749  write(*,*) ''
9750  write(*,*) ' shape of check is (', check_shape, ')'
9751  write(*,*) ' is INCORRECT'
9752  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
9753 
9754  call abortprogram('')
9755  end if
9756 
9757 
9758  allocate( mask_array( &
9759  & answer_shape(1), &
9760 
9761  & answer_shape(2), &
9762 
9763  & answer_shape(3), &
9764 
9765  & answer_shape(4) ) &
9766  & )
9767 
9768  allocate( judge( &
9769  & answer_shape(1), &
9770 
9771  & answer_shape(2), &
9772 
9773  & answer_shape(3), &
9774 
9775  & answer_shape(4) ) &
9776  & )
9777 
9778  allocate( judge_rev( &
9779  & answer_shape(1), &
9780 
9781  & answer_shape(2), &
9782 
9783  & answer_shape(3), &
9784 
9785  & answer_shape(4) ) &
9786  & )
9787 
9788  allocate( answer_negative( &
9789  & answer_shape(1), &
9790 
9791  & answer_shape(2), &
9792 
9793  & answer_shape(3), &
9794 
9795  & answer_shape(4) ) &
9796  & )
9797 
9798  allocate( check_negative( &
9799  & answer_shape(1), &
9800 
9801  & answer_shape(2), &
9802 
9803  & answer_shape(3), &
9804 
9805  & answer_shape(4) ) &
9806  & )
9807 
9808  allocate( both_negative( &
9809  & answer_shape(1), &
9810 
9811  & answer_shape(2), &
9812 
9813  & answer_shape(3), &
9814 
9815  & answer_shape(4) ) &
9816  & )
9817 
9818  answer_negative = answer < 0
9819  check_negative = check < 0
9820  both_negative = answer_negative .and. check_negative
9821  if (.not. negative_support_on) both_negative = .false.
9822 
9823  judge = answer < check
9824  where (both_negative) judge = .not. judge
9825 
9826  judge_rev = .not. judge
9827  err_flag = any(judge_rev)
9828  mask_array = 1
9829  pos = maxloc(mask_array, judge_rev)
9830 
9831  if (err_flag) then
9832 
9833  wrong = check( &
9834  & pos(1), &
9835 
9836  & pos(2), &
9837 
9838  & pos(3), &
9839 
9840  & pos(4) )
9841 
9842  right = answer( &
9843  & pos(1), &
9844 
9845  & pos(2), &
9846 
9847  & pos(3), &
9848 
9849  & pos(4) )
9850 
9851  write(unit=pos_array(1), fmt="(i20)") pos(1)
9852 
9853  write(unit=pos_array(2), fmt="(i20)") pos(2)
9854 
9855  write(unit=pos_array(3), fmt="(i20)") pos(3)
9856 
9857  write(unit=pos_array(4), fmt="(i20)") pos(4)
9858 
9859 
9860  pos_str = '(' // &
9861  & trim(adjustl(pos_array(1))) // ',' // &
9862 
9863  & trim(adjustl(pos_array(2))) // ',' // &
9864 
9865  & trim(adjustl(pos_array(3))) // ',' // &
9866 
9867  & trim(adjustl(pos_array(4))) // ')'
9868 
9869  if ( both_negative( &
9870  & pos(1), &
9871 
9872  & pos(2), &
9873 
9874  & pos(3), &
9875 
9876  & pos(4) ) ) then
9877 
9878  abs_mes = 'ABSOLUTE value of'
9879  else
9880  abs_mes = ''
9881 
9882  end if
9883 
9884  end if
9885  deallocate(mask_array, judge, judge_rev)
9886  deallocate(answer_negative, check_negative, both_negative)
9887 
9888 
9889 
9890 
9891  if (err_flag) then
9892  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9893  write(*,*) ''
9894  write(*,*) ' ' // trim(abs_mes) // &
9895  & ' check' // trim(pos_str) // ' = ', wrong
9896  write(*,*) ' is NOT GREATER THAN'
9897  write(*,*) ' ' // trim(abs_mes) // &
9898  & ' answer' // trim(pos_str) // ' = ', right
9899 
9900  call abortprogram('')
9901  else
9902  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
9903  end if
9904 
9905 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint5()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint5 ( character(*), intent(in)  message,
integer, dimension(:,:,:,:,:), intent(in)  answer,
integer, dimension(:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 9911 of file dc_test.f90.

9911  use sysdep, only: abortprogram
9912  use dc_types, only: string, token
9913  implicit none
9914  character(*), intent(in):: message
9915  integer, intent(in):: answer(:,:,:,:,:)
9916  integer, intent(in):: check(:,:,:,:,:)
9917  logical, intent(in), optional:: negative_support
9918  logical:: err_flag
9919  logical:: negative_support_on
9920  character(STRING):: pos_str
9921  character(TOKEN):: abs_mes
9922  integer:: wrong, right
9923 
9924  integer:: answer_shape(5), check_shape(5), pos(5)
9925  logical:: consist_shape(5)
9926  character(TOKEN):: pos_array(5)
9927  integer, allocatable:: mask_array(:,:,:,:,:)
9928  logical, allocatable:: judge(:,:,:,:,:)
9929  logical, allocatable:: judge_rev(:,:,:,:,:)
9930  logical, allocatable:: answer_negative(:,:,:,:,:)
9931  logical, allocatable:: check_negative(:,:,:,:,:)
9932  logical, allocatable:: both_negative(:,:,:,:,:)
9933 
9934 
9935  continue
9936  if (present(negative_support)) then
9937  negative_support_on = negative_support
9938  else
9939  negative_support_on = .true.
9940  end if
9941 
9942  err_flag = .false.
9943 
9944 
9945  answer_shape = shape(answer)
9946  check_shape = shape(check)
9947 
9948  consist_shape = answer_shape == check_shape
9949 
9950  if (.not. all(consist_shape)) then
9951  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
9952  write(*,*) ''
9953  write(*,*) ' shape of check is (', check_shape, ')'
9954  write(*,*) ' is INCORRECT'
9955  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
9956 
9957  call abortprogram('')
9958  end if
9959 
9960 
9961  allocate( mask_array( &
9962  & answer_shape(1), &
9963 
9964  & answer_shape(2), &
9965 
9966  & answer_shape(3), &
9967 
9968  & answer_shape(4), &
9969 
9970  & answer_shape(5) ) &
9971  & )
9972 
9973  allocate( judge( &
9974  & answer_shape(1), &
9975 
9976  & answer_shape(2), &
9977 
9978  & answer_shape(3), &
9979 
9980  & answer_shape(4), &
9981 
9982  & answer_shape(5) ) &
9983  & )
9984 
9985  allocate( judge_rev( &
9986  & answer_shape(1), &
9987 
9988  & answer_shape(2), &
9989 
9990  & answer_shape(3), &
9991 
9992  & answer_shape(4), &
9993 
9994  & answer_shape(5) ) &
9995  & )
9996 
9997  allocate( answer_negative( &
9998  & answer_shape(1), &
9999 
10000  & answer_shape(2), &
10001 
10002  & answer_shape(3), &
10003 
10004  & answer_shape(4), &
10005 
10006  & answer_shape(5) ) &
10007  & )
10008 
10009  allocate( check_negative( &
10010  & answer_shape(1), &
10011 
10012  & answer_shape(2), &
10013 
10014  & answer_shape(3), &
10015 
10016  & answer_shape(4), &
10017 
10018  & answer_shape(5) ) &
10019  & )
10020 
10021  allocate( both_negative( &
10022  & answer_shape(1), &
10023 
10024  & answer_shape(2), &
10025 
10026  & answer_shape(3), &
10027 
10028  & answer_shape(4), &
10029 
10030  & answer_shape(5) ) &
10031  & )
10032 
10033  answer_negative = answer < 0
10034  check_negative = check < 0
10035  both_negative = answer_negative .and. check_negative
10036  if (.not. negative_support_on) both_negative = .false.
10037 
10038  judge = answer < check
10039  where (both_negative) judge = .not. judge
10040 
10041  judge_rev = .not. judge
10042  err_flag = any(judge_rev)
10043  mask_array = 1
10044  pos = maxloc(mask_array, judge_rev)
10045 
10046  if (err_flag) then
10047 
10048  wrong = check( &
10049  & pos(1), &
10050 
10051  & pos(2), &
10052 
10053  & pos(3), &
10054 
10055  & pos(4), &
10056 
10057  & pos(5) )
10058 
10059  right = answer( &
10060  & pos(1), &
10061 
10062  & pos(2), &
10063 
10064  & pos(3), &
10065 
10066  & pos(4), &
10067 
10068  & pos(5) )
10069 
10070  write(unit=pos_array(1), fmt="(i20)") pos(1)
10071 
10072  write(unit=pos_array(2), fmt="(i20)") pos(2)
10073 
10074  write(unit=pos_array(3), fmt="(i20)") pos(3)
10075 
10076  write(unit=pos_array(4), fmt="(i20)") pos(4)
10077 
10078  write(unit=pos_array(5), fmt="(i20)") pos(5)
10079 
10080 
10081  pos_str = '(' // &
10082  & trim(adjustl(pos_array(1))) // ',' // &
10083 
10084  & trim(adjustl(pos_array(2))) // ',' // &
10085 
10086  & trim(adjustl(pos_array(3))) // ',' // &
10087 
10088  & trim(adjustl(pos_array(4))) // ',' // &
10089 
10090  & trim(adjustl(pos_array(5))) // ')'
10091 
10092  if ( both_negative( &
10093  & pos(1), &
10094 
10095  & pos(2), &
10096 
10097  & pos(3), &
10098 
10099  & pos(4), &
10100 
10101  & pos(5) ) ) then
10102 
10103  abs_mes = 'ABSOLUTE value of'
10104  else
10105  abs_mes = ''
10106 
10107  end if
10108 
10109  end if
10110  deallocate(mask_array, judge, judge_rev)
10111  deallocate(answer_negative, check_negative, both_negative)
10112 
10113 
10114 
10115 
10116  if (err_flag) then
10117  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10118  write(*,*) ''
10119  write(*,*) ' ' // trim(abs_mes) // &
10120  & ' check' // trim(pos_str) // ' = ', wrong
10121  write(*,*) ' is NOT GREATER THAN'
10122  write(*,*) ' ' // trim(abs_mes) // &
10123  & ' answer' // trim(pos_str) // ' = ', right
10124 
10125  call abortprogram('')
10126  else
10127  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
10128  end if
10129 
10130 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint6()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint6 ( character(*), intent(in)  message,
integer, dimension(:,:,:,:,:,:), intent(in)  answer,
integer, dimension(:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 10136 of file dc_test.f90.

10136  use sysdep, only: abortprogram
10137  use dc_types, only: string, token
10138  implicit none
10139  character(*), intent(in):: message
10140  integer, intent(in):: answer(:,:,:,:,:,:)
10141  integer, intent(in):: check(:,:,:,:,:,:)
10142  logical, intent(in), optional:: negative_support
10143  logical:: err_flag
10144  logical:: negative_support_on
10145  character(STRING):: pos_str
10146  character(TOKEN):: abs_mes
10147  integer:: wrong, right
10148 
10149  integer:: answer_shape(6), check_shape(6), pos(6)
10150  logical:: consist_shape(6)
10151  character(TOKEN):: pos_array(6)
10152  integer, allocatable:: mask_array(:,:,:,:,:,:)
10153  logical, allocatable:: judge(:,:,:,:,:,:)
10154  logical, allocatable:: judge_rev(:,:,:,:,:,:)
10155  logical, allocatable:: answer_negative(:,:,:,:,:,:)
10156  logical, allocatable:: check_negative(:,:,:,:,:,:)
10157  logical, allocatable:: both_negative(:,:,:,:,:,:)
10158 
10159 
10160  continue
10161  if (present(negative_support)) then
10162  negative_support_on = negative_support
10163  else
10164  negative_support_on = .true.
10165  end if
10166 
10167  err_flag = .false.
10168 
10169 
10170  answer_shape = shape(answer)
10171  check_shape = shape(check)
10172 
10173  consist_shape = answer_shape == check_shape
10174 
10175  if (.not. all(consist_shape)) then
10176  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10177  write(*,*) ''
10178  write(*,*) ' shape of check is (', check_shape, ')'
10179  write(*,*) ' is INCORRECT'
10180  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
10181 
10182  call abortprogram('')
10183  end if
10184 
10185 
10186  allocate( mask_array( &
10187  & answer_shape(1), &
10188 
10189  & answer_shape(2), &
10190 
10191  & answer_shape(3), &
10192 
10193  & answer_shape(4), &
10194 
10195  & answer_shape(5), &
10196 
10197  & answer_shape(6) ) &
10198  & )
10199 
10200  allocate( judge( &
10201  & answer_shape(1), &
10202 
10203  & answer_shape(2), &
10204 
10205  & answer_shape(3), &
10206 
10207  & answer_shape(4), &
10208 
10209  & answer_shape(5), &
10210 
10211  & answer_shape(6) ) &
10212  & )
10213 
10214  allocate( judge_rev( &
10215  & answer_shape(1), &
10216 
10217  & answer_shape(2), &
10218 
10219  & answer_shape(3), &
10220 
10221  & answer_shape(4), &
10222 
10223  & answer_shape(5), &
10224 
10225  & answer_shape(6) ) &
10226  & )
10227 
10228  allocate( answer_negative( &
10229  & answer_shape(1), &
10230 
10231  & answer_shape(2), &
10232 
10233  & answer_shape(3), &
10234 
10235  & answer_shape(4), &
10236 
10237  & answer_shape(5), &
10238 
10239  & answer_shape(6) ) &
10240  & )
10241 
10242  allocate( check_negative( &
10243  & answer_shape(1), &
10244 
10245  & answer_shape(2), &
10246 
10247  & answer_shape(3), &
10248 
10249  & answer_shape(4), &
10250 
10251  & answer_shape(5), &
10252 
10253  & answer_shape(6) ) &
10254  & )
10255 
10256  allocate( both_negative( &
10257  & answer_shape(1), &
10258 
10259  & answer_shape(2), &
10260 
10261  & answer_shape(3), &
10262 
10263  & answer_shape(4), &
10264 
10265  & answer_shape(5), &
10266 
10267  & answer_shape(6) ) &
10268  & )
10269 
10270  answer_negative = answer < 0
10271  check_negative = check < 0
10272  both_negative = answer_negative .and. check_negative
10273  if (.not. negative_support_on) both_negative = .false.
10274 
10275  judge = answer < check
10276  where (both_negative) judge = .not. judge
10277 
10278  judge_rev = .not. judge
10279  err_flag = any(judge_rev)
10280  mask_array = 1
10281  pos = maxloc(mask_array, judge_rev)
10282 
10283  if (err_flag) then
10284 
10285  wrong = check( &
10286  & pos(1), &
10287 
10288  & pos(2), &
10289 
10290  & pos(3), &
10291 
10292  & pos(4), &
10293 
10294  & pos(5), &
10295 
10296  & pos(6) )
10297 
10298  right = answer( &
10299  & pos(1), &
10300 
10301  & pos(2), &
10302 
10303  & pos(3), &
10304 
10305  & pos(4), &
10306 
10307  & pos(5), &
10308 
10309  & pos(6) )
10310 
10311  write(unit=pos_array(1), fmt="(i20)") pos(1)
10312 
10313  write(unit=pos_array(2), fmt="(i20)") pos(2)
10314 
10315  write(unit=pos_array(3), fmt="(i20)") pos(3)
10316 
10317  write(unit=pos_array(4), fmt="(i20)") pos(4)
10318 
10319  write(unit=pos_array(5), fmt="(i20)") pos(5)
10320 
10321  write(unit=pos_array(6), fmt="(i20)") pos(6)
10322 
10323 
10324  pos_str = '(' // &
10325  & trim(adjustl(pos_array(1))) // ',' // &
10326 
10327  & trim(adjustl(pos_array(2))) // ',' // &
10328 
10329  & trim(adjustl(pos_array(3))) // ',' // &
10330 
10331  & trim(adjustl(pos_array(4))) // ',' // &
10332 
10333  & trim(adjustl(pos_array(5))) // ',' // &
10334 
10335  & trim(adjustl(pos_array(6))) // ')'
10336 
10337  if ( both_negative( &
10338  & pos(1), &
10339 
10340  & pos(2), &
10341 
10342  & pos(3), &
10343 
10344  & pos(4), &
10345 
10346  & pos(5), &
10347 
10348  & pos(6) ) ) then
10349 
10350  abs_mes = 'ABSOLUTE value of'
10351  else
10352  abs_mes = ''
10353 
10354  end if
10355 
10356  end if
10357  deallocate(mask_array, judge, judge_rev)
10358  deallocate(answer_negative, check_negative, both_negative)
10359 
10360 
10361 
10362 
10363  if (err_flag) then
10364  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10365  write(*,*) ''
10366  write(*,*) ' ' // trim(abs_mes) // &
10367  & ' check' // trim(pos_str) // ' = ', wrong
10368  write(*,*) ' is NOT GREATER THAN'
10369  write(*,*) ' ' // trim(abs_mes) // &
10370  & ' answer' // trim(pos_str) // ' = ', right
10371 
10372  call abortprogram('')
10373  else
10374  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
10375  end if
10376 
10377 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanint7()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanint7 ( character(*), intent(in)  message,
integer, dimension(:,:,:,:,:,:,:), intent(in)  answer,
integer, dimension(:,:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 10383 of file dc_test.f90.

10383  use sysdep, only: abortprogram
10384  use dc_types, only: string, token
10385  implicit none
10386  character(*), intent(in):: message
10387  integer, intent(in):: answer(:,:,:,:,:,:,:)
10388  integer, intent(in):: check(:,:,:,:,:,:,:)
10389  logical, intent(in), optional:: negative_support
10390  logical:: err_flag
10391  logical:: negative_support_on
10392  character(STRING):: pos_str
10393  character(TOKEN):: abs_mes
10394  integer:: wrong, right
10395 
10396  integer:: answer_shape(7), check_shape(7), pos(7)
10397  logical:: consist_shape(7)
10398  character(TOKEN):: pos_array(7)
10399  integer, allocatable:: mask_array(:,:,:,:,:,:,:)
10400  logical, allocatable:: judge(:,:,:,:,:,:,:)
10401  logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
10402  logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
10403  logical, allocatable:: check_negative(:,:,:,:,:,:,:)
10404  logical, allocatable:: both_negative(:,:,:,:,:,:,:)
10405 
10406 
10407  continue
10408  if (present(negative_support)) then
10409  negative_support_on = negative_support
10410  else
10411  negative_support_on = .true.
10412  end if
10413 
10414  err_flag = .false.
10415 
10416 
10417  answer_shape = shape(answer)
10418  check_shape = shape(check)
10419 
10420  consist_shape = answer_shape == check_shape
10421 
10422  if (.not. all(consist_shape)) then
10423  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10424  write(*,*) ''
10425  write(*,*) ' shape of check is (', check_shape, ')'
10426  write(*,*) ' is INCORRECT'
10427  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
10428 
10429  call abortprogram('')
10430  end if
10431 
10432 
10433  allocate( mask_array( &
10434  & answer_shape(1), &
10435 
10436  & answer_shape(2), &
10437 
10438  & answer_shape(3), &
10439 
10440  & answer_shape(4), &
10441 
10442  & answer_shape(5), &
10443 
10444  & answer_shape(6), &
10445 
10446  & answer_shape(7) ) &
10447  & )
10448 
10449  allocate( judge( &
10450  & answer_shape(1), &
10451 
10452  & answer_shape(2), &
10453 
10454  & answer_shape(3), &
10455 
10456  & answer_shape(4), &
10457 
10458  & answer_shape(5), &
10459 
10460  & answer_shape(6), &
10461 
10462  & answer_shape(7) ) &
10463  & )
10464 
10465  allocate( judge_rev( &
10466  & answer_shape(1), &
10467 
10468  & answer_shape(2), &
10469 
10470  & answer_shape(3), &
10471 
10472  & answer_shape(4), &
10473 
10474  & answer_shape(5), &
10475 
10476  & answer_shape(6), &
10477 
10478  & answer_shape(7) ) &
10479  & )
10480 
10481  allocate( answer_negative( &
10482  & answer_shape(1), &
10483 
10484  & answer_shape(2), &
10485 
10486  & answer_shape(3), &
10487 
10488  & answer_shape(4), &
10489 
10490  & answer_shape(5), &
10491 
10492  & answer_shape(6), &
10493 
10494  & answer_shape(7) ) &
10495  & )
10496 
10497  allocate( check_negative( &
10498  & answer_shape(1), &
10499 
10500  & answer_shape(2), &
10501 
10502  & answer_shape(3), &
10503 
10504  & answer_shape(4), &
10505 
10506  & answer_shape(5), &
10507 
10508  & answer_shape(6), &
10509 
10510  & answer_shape(7) ) &
10511  & )
10512 
10513  allocate( both_negative( &
10514  & answer_shape(1), &
10515 
10516  & answer_shape(2), &
10517 
10518  & answer_shape(3), &
10519 
10520  & answer_shape(4), &
10521 
10522  & answer_shape(5), &
10523 
10524  & answer_shape(6), &
10525 
10526  & answer_shape(7) ) &
10527  & )
10528 
10529  answer_negative = answer < 0
10530  check_negative = check < 0
10531  both_negative = answer_negative .and. check_negative
10532  if (.not. negative_support_on) both_negative = .false.
10533 
10534  judge = answer < check
10535  where (both_negative) judge = .not. judge
10536 
10537  judge_rev = .not. judge
10538  err_flag = any(judge_rev)
10539  mask_array = 1
10540  pos = maxloc(mask_array, judge_rev)
10541 
10542  if (err_flag) then
10543 
10544  wrong = check( &
10545  & pos(1), &
10546 
10547  & pos(2), &
10548 
10549  & pos(3), &
10550 
10551  & pos(4), &
10552 
10553  & pos(5), &
10554 
10555  & pos(6), &
10556 
10557  & pos(7) )
10558 
10559  right = answer( &
10560  & pos(1), &
10561 
10562  & pos(2), &
10563 
10564  & pos(3), &
10565 
10566  & pos(4), &
10567 
10568  & pos(5), &
10569 
10570  & pos(6), &
10571 
10572  & pos(7) )
10573 
10574  write(unit=pos_array(1), fmt="(i20)") pos(1)
10575 
10576  write(unit=pos_array(2), fmt="(i20)") pos(2)
10577 
10578  write(unit=pos_array(3), fmt="(i20)") pos(3)
10579 
10580  write(unit=pos_array(4), fmt="(i20)") pos(4)
10581 
10582  write(unit=pos_array(5), fmt="(i20)") pos(5)
10583 
10584  write(unit=pos_array(6), fmt="(i20)") pos(6)
10585 
10586  write(unit=pos_array(7), fmt="(i20)") pos(7)
10587 
10588 
10589  pos_str = '(' // &
10590  & trim(adjustl(pos_array(1))) // ',' // &
10591 
10592  & trim(adjustl(pos_array(2))) // ',' // &
10593 
10594  & trim(adjustl(pos_array(3))) // ',' // &
10595 
10596  & trim(adjustl(pos_array(4))) // ',' // &
10597 
10598  & trim(adjustl(pos_array(5))) // ',' // &
10599 
10600  & trim(adjustl(pos_array(6))) // ',' // &
10601 
10602  & trim(adjustl(pos_array(7))) // ')'
10603 
10604  if ( both_negative( &
10605  & pos(1), &
10606 
10607  & pos(2), &
10608 
10609  & pos(3), &
10610 
10611  & pos(4), &
10612 
10613  & pos(5), &
10614 
10615  & pos(6), &
10616 
10617  & pos(7) ) ) then
10618 
10619  abs_mes = 'ABSOLUTE value of'
10620  else
10621  abs_mes = ''
10622 
10623  end if
10624 
10625  end if
10626  deallocate(mask_array, judge, judge_rev)
10627  deallocate(answer_negative, check_negative, both_negative)
10628 
10629 
10630 
10631 
10632  if (err_flag) then
10633  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10634  write(*,*) ''
10635  write(*,*) ' ' // trim(abs_mes) // &
10636  & ' check' // trim(pos_str) // ' = ', wrong
10637  write(*,*) ' is NOT GREATER THAN'
10638  write(*,*) ' ' // trim(abs_mes) // &
10639  & ' answer' // trim(pos_str) // ' = ', right
10640 
10641  call abortprogram('')
10642  else
10643  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
10644  end if
10645 
10646 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal0()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal0 ( character(*), intent(in)  message,
real, intent(in)  answer,
real, intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 10652 of file dc_test.f90.

10652  use sysdep, only: abortprogram
10653  use dc_types, only: string, token
10654  implicit none
10655  character(*), intent(in):: message
10656  real, intent(in):: answer
10657  real, intent(in):: check
10658  logical, intent(in), optional:: negative_support
10659  logical:: err_flag
10660  logical:: negative_support_on
10661  character(STRING):: pos_str
10662  character(TOKEN):: abs_mes
10663  real:: wrong, right
10664 
10665 
10666 
10667  continue
10668  if (present(negative_support)) then
10669  negative_support_on = negative_support
10670  else
10671  negative_support_on = .true.
10672  end if
10673 
10674  err_flag = .false.
10675 
10676 
10677  err_flag = .not. answer < check
10678  abs_mes = ''
10679 
10680  if ( answer < 0.0 &
10681  & .and. check < 0.0 &
10682  & .and. negative_support_on ) then
10683 
10684  err_flag = .not. err_flag
10685  abs_mes = 'ABSOLUTE value of'
10686  end if
10687 
10688  wrong = check
10689  right = answer
10690  pos_str = ''
10691 
10692 
10693 
10694 
10695  if (err_flag) then
10696  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10697  write(*,*) ''
10698  write(*,*) ' ' // trim(abs_mes) // &
10699  & ' check' // trim(pos_str) // ' = ', wrong
10700  write(*,*) ' is NOT GREATER THAN'
10701  write(*,*) ' ' // trim(abs_mes) // &
10702  & ' answer' // trim(pos_str) // ' = ', right
10703 
10704  call abortprogram('')
10705  else
10706  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
10707  end if
10708 
10709 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal1()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal1 ( character(*), intent(in)  message,
real, dimension(:), intent(in)  answer,
real, dimension(:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 10715 of file dc_test.f90.

10715  use sysdep, only: abortprogram
10716  use dc_types, only: string, token
10717  implicit none
10718  character(*), intent(in):: message
10719  real, intent(in):: answer(:)
10720  real, intent(in):: check(:)
10721  logical, intent(in), optional:: negative_support
10722  logical:: err_flag
10723  logical:: negative_support_on
10724  character(STRING):: pos_str
10725  character(TOKEN):: abs_mes
10726  real:: wrong, right
10727 
10728  integer:: answer_shape(1), check_shape(1), pos(1)
10729  logical:: consist_shape(1)
10730  character(TOKEN):: pos_array(1)
10731  integer, allocatable:: mask_array(:)
10732  logical, allocatable:: judge(:)
10733  logical, allocatable:: judge_rev(:)
10734  logical, allocatable:: answer_negative(:)
10735  logical, allocatable:: check_negative(:)
10736  logical, allocatable:: both_negative(:)
10737 
10738 
10739  continue
10740  if (present(negative_support)) then
10741  negative_support_on = negative_support
10742  else
10743  negative_support_on = .true.
10744  end if
10745 
10746  err_flag = .false.
10747 
10748 
10749  answer_shape = shape(answer)
10750  check_shape = shape(check)
10751 
10752  consist_shape = answer_shape == check_shape
10753 
10754  if (.not. all(consist_shape)) then
10755  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10756  write(*,*) ''
10757  write(*,*) ' shape of check is (', check_shape, ')'
10758  write(*,*) ' is INCORRECT'
10759  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
10760 
10761  call abortprogram('')
10762  end if
10763 
10764 
10765  allocate( mask_array( &
10766 
10767  & answer_shape(1) ) &
10768  & )
10769 
10770  allocate( judge( &
10771 
10772  & answer_shape(1) ) &
10773  & )
10774 
10775  allocate( judge_rev( &
10776 
10777  & answer_shape(1) ) &
10778  & )
10779 
10780  allocate( answer_negative( &
10781 
10782  & answer_shape(1) ) &
10783  & )
10784 
10785  allocate( check_negative( &
10786 
10787  & answer_shape(1) ) &
10788  & )
10789 
10790  allocate( both_negative( &
10791 
10792  & answer_shape(1) ) &
10793  & )
10794 
10795  answer_negative = answer < 0.0
10796  check_negative = check < 0.0
10797  both_negative = answer_negative .and. check_negative
10798  if (.not. negative_support_on) both_negative = .false.
10799 
10800  judge = answer < check
10801  where (both_negative) judge = .not. judge
10802 
10803  judge_rev = .not. judge
10804  err_flag = any(judge_rev)
10805  mask_array = 1
10806  pos = maxloc(mask_array, judge_rev)
10807 
10808  if (err_flag) then
10809 
10810  wrong = check( &
10811 
10812  & pos(1) )
10813 
10814  right = answer( &
10815 
10816  & pos(1) )
10817 
10818  write(unit=pos_array(1), fmt="(i20)") pos(1)
10819 
10820 
10821  pos_str = '(' // &
10822 
10823  & trim(adjustl(pos_array(1))) // ')'
10824 
10825  if ( both_negative( &
10826 
10827  & pos(1) ) ) then
10828 
10829  abs_mes = 'ABSOLUTE value of'
10830  else
10831  abs_mes = ''
10832 
10833  end if
10834 
10835  end if
10836  deallocate(mask_array, judge, judge_rev)
10837  deallocate(answer_negative, check_negative, both_negative)
10838 
10839 
10840 
10841 
10842  if (err_flag) then
10843  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10844  write(*,*) ''
10845  write(*,*) ' ' // trim(abs_mes) // &
10846  & ' check' // trim(pos_str) // ' = ', wrong
10847  write(*,*) ' is NOT GREATER THAN'
10848  write(*,*) ' ' // trim(abs_mes) // &
10849  & ' answer' // trim(pos_str) // ' = ', right
10850 
10851  call abortprogram('')
10852  else
10853  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
10854  end if
10855 
10856 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal2()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal2 ( character(*), intent(in)  message,
real, dimension(:,:), intent(in)  answer,
real, dimension(:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 10862 of file dc_test.f90.

10862  use sysdep, only: abortprogram
10863  use dc_types, only: string, token
10864  implicit none
10865  character(*), intent(in):: message
10866  real, intent(in):: answer(:,:)
10867  real, intent(in):: check(:,:)
10868  logical, intent(in), optional:: negative_support
10869  logical:: err_flag
10870  logical:: negative_support_on
10871  character(STRING):: pos_str
10872  character(TOKEN):: abs_mes
10873  real:: wrong, right
10874 
10875  integer:: answer_shape(2), check_shape(2), pos(2)
10876  logical:: consist_shape(2)
10877  character(TOKEN):: pos_array(2)
10878  integer, allocatable:: mask_array(:,:)
10879  logical, allocatable:: judge(:,:)
10880  logical, allocatable:: judge_rev(:,:)
10881  logical, allocatable:: answer_negative(:,:)
10882  logical, allocatable:: check_negative(:,:)
10883  logical, allocatable:: both_negative(:,:)
10884 
10885 
10886  continue
10887  if (present(negative_support)) then
10888  negative_support_on = negative_support
10889  else
10890  negative_support_on = .true.
10891  end if
10892 
10893  err_flag = .false.
10894 
10895 
10896  answer_shape = shape(answer)
10897  check_shape = shape(check)
10898 
10899  consist_shape = answer_shape == check_shape
10900 
10901  if (.not. all(consist_shape)) then
10902  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
10903  write(*,*) ''
10904  write(*,*) ' shape of check is (', check_shape, ')'
10905  write(*,*) ' is INCORRECT'
10906  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
10907 
10908  call abortprogram('')
10909  end if
10910 
10911 
10912  allocate( mask_array( &
10913  & answer_shape(1), &
10914 
10915  & answer_shape(2) ) &
10916  & )
10917 
10918  allocate( judge( &
10919  & answer_shape(1), &
10920 
10921  & answer_shape(2) ) &
10922  & )
10923 
10924  allocate( judge_rev( &
10925  & answer_shape(1), &
10926 
10927  & answer_shape(2) ) &
10928  & )
10929 
10930  allocate( answer_negative( &
10931  & answer_shape(1), &
10932 
10933  & answer_shape(2) ) &
10934  & )
10935 
10936  allocate( check_negative( &
10937  & answer_shape(1), &
10938 
10939  & answer_shape(2) ) &
10940  & )
10941 
10942  allocate( both_negative( &
10943  & answer_shape(1), &
10944 
10945  & answer_shape(2) ) &
10946  & )
10947 
10948  answer_negative = answer < 0.0
10949  check_negative = check < 0.0
10950  both_negative = answer_negative .and. check_negative
10951  if (.not. negative_support_on) both_negative = .false.
10952 
10953  judge = answer < check
10954  where (both_negative) judge = .not. judge
10955 
10956  judge_rev = .not. judge
10957  err_flag = any(judge_rev)
10958  mask_array = 1
10959  pos = maxloc(mask_array, judge_rev)
10960 
10961  if (err_flag) then
10962 
10963  wrong = check( &
10964  & pos(1), &
10965 
10966  & pos(2) )
10967 
10968  right = answer( &
10969  & pos(1), &
10970 
10971  & pos(2) )
10972 
10973  write(unit=pos_array(1), fmt="(i20)") pos(1)
10974 
10975  write(unit=pos_array(2), fmt="(i20)") pos(2)
10976 
10977 
10978  pos_str = '(' // &
10979  & trim(adjustl(pos_array(1))) // ',' // &
10980 
10981  & trim(adjustl(pos_array(2))) // ')'
10982 
10983  if ( both_negative( &
10984  & pos(1), &
10985 
10986  & pos(2) ) ) then
10987 
10988  abs_mes = 'ABSOLUTE value of'
10989  else
10990  abs_mes = ''
10991 
10992  end if
10993 
10994  end if
10995  deallocate(mask_array, judge, judge_rev)
10996  deallocate(answer_negative, check_negative, both_negative)
10997 
10998 
10999 
11000 
11001  if (err_flag) then
11002  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11003  write(*,*) ''
11004  write(*,*) ' ' // trim(abs_mes) // &
11005  & ' check' // trim(pos_str) // ' = ', wrong
11006  write(*,*) ' is NOT GREATER THAN'
11007  write(*,*) ' ' // trim(abs_mes) // &
11008  & ' answer' // trim(pos_str) // ' = ', right
11009 
11010  call abortprogram('')
11011  else
11012  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
11013  end if
11014 
11015 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal3()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal3 ( character(*), intent(in)  message,
real, dimension(:,:,:), intent(in)  answer,
real, dimension(:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 11021 of file dc_test.f90.

11021  use sysdep, only: abortprogram
11022  use dc_types, only: string, token
11023  implicit none
11024  character(*), intent(in):: message
11025  real, intent(in):: answer(:,:,:)
11026  real, intent(in):: check(:,:,:)
11027  logical, intent(in), optional:: negative_support
11028  logical:: err_flag
11029  logical:: negative_support_on
11030  character(STRING):: pos_str
11031  character(TOKEN):: abs_mes
11032  real:: wrong, right
11033 
11034  integer:: answer_shape(3), check_shape(3), pos(3)
11035  logical:: consist_shape(3)
11036  character(TOKEN):: pos_array(3)
11037  integer, allocatable:: mask_array(:,:,:)
11038  logical, allocatable:: judge(:,:,:)
11039  logical, allocatable:: judge_rev(:,:,:)
11040  logical, allocatable:: answer_negative(:,:,:)
11041  logical, allocatable:: check_negative(:,:,:)
11042  logical, allocatable:: both_negative(:,:,:)
11043 
11044 
11045  continue
11046  if (present(negative_support)) then
11047  negative_support_on = negative_support
11048  else
11049  negative_support_on = .true.
11050  end if
11051 
11052  err_flag = .false.
11053 
11054 
11055  answer_shape = shape(answer)
11056  check_shape = shape(check)
11057 
11058  consist_shape = answer_shape == check_shape
11059 
11060  if (.not. all(consist_shape)) then
11061  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11062  write(*,*) ''
11063  write(*,*) ' shape of check is (', check_shape, ')'
11064  write(*,*) ' is INCORRECT'
11065  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
11066 
11067  call abortprogram('')
11068  end if
11069 
11070 
11071  allocate( mask_array( &
11072  & answer_shape(1), &
11073 
11074  & answer_shape(2), &
11075 
11076  & answer_shape(3) ) &
11077  & )
11078 
11079  allocate( judge( &
11080  & answer_shape(1), &
11081 
11082  & answer_shape(2), &
11083 
11084  & answer_shape(3) ) &
11085  & )
11086 
11087  allocate( judge_rev( &
11088  & answer_shape(1), &
11089 
11090  & answer_shape(2), &
11091 
11092  & answer_shape(3) ) &
11093  & )
11094 
11095  allocate( answer_negative( &
11096  & answer_shape(1), &
11097 
11098  & answer_shape(2), &
11099 
11100  & answer_shape(3) ) &
11101  & )
11102 
11103  allocate( check_negative( &
11104  & answer_shape(1), &
11105 
11106  & answer_shape(2), &
11107 
11108  & answer_shape(3) ) &
11109  & )
11110 
11111  allocate( both_negative( &
11112  & answer_shape(1), &
11113 
11114  & answer_shape(2), &
11115 
11116  & answer_shape(3) ) &
11117  & )
11118 
11119  answer_negative = answer < 0.0
11120  check_negative = check < 0.0
11121  both_negative = answer_negative .and. check_negative
11122  if (.not. negative_support_on) both_negative = .false.
11123 
11124  judge = answer < check
11125  where (both_negative) judge = .not. judge
11126 
11127  judge_rev = .not. judge
11128  err_flag = any(judge_rev)
11129  mask_array = 1
11130  pos = maxloc(mask_array, judge_rev)
11131 
11132  if (err_flag) then
11133 
11134  wrong = check( &
11135  & pos(1), &
11136 
11137  & pos(2), &
11138 
11139  & pos(3) )
11140 
11141  right = answer( &
11142  & pos(1), &
11143 
11144  & pos(2), &
11145 
11146  & pos(3) )
11147 
11148  write(unit=pos_array(1), fmt="(i20)") pos(1)
11149 
11150  write(unit=pos_array(2), fmt="(i20)") pos(2)
11151 
11152  write(unit=pos_array(3), fmt="(i20)") pos(3)
11153 
11154 
11155  pos_str = '(' // &
11156  & trim(adjustl(pos_array(1))) // ',' // &
11157 
11158  & trim(adjustl(pos_array(2))) // ',' // &
11159 
11160  & trim(adjustl(pos_array(3))) // ')'
11161 
11162  if ( both_negative( &
11163  & pos(1), &
11164 
11165  & pos(2), &
11166 
11167  & pos(3) ) ) then
11168 
11169  abs_mes = 'ABSOLUTE value of'
11170  else
11171  abs_mes = ''
11172 
11173  end if
11174 
11175  end if
11176  deallocate(mask_array, judge, judge_rev)
11177  deallocate(answer_negative, check_negative, both_negative)
11178 
11179 
11180 
11181 
11182  if (err_flag) then
11183  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11184  write(*,*) ''
11185  write(*,*) ' ' // trim(abs_mes) // &
11186  & ' check' // trim(pos_str) // ' = ', wrong
11187  write(*,*) ' is NOT GREATER THAN'
11188  write(*,*) ' ' // trim(abs_mes) // &
11189  & ' answer' // trim(pos_str) // ' = ', right
11190 
11191  call abortprogram('')
11192  else
11193  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
11194  end if
11195 
11196 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal4()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal4 ( character(*), intent(in)  message,
real, dimension(:,:,:,:), intent(in)  answer,
real, dimension(:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 11202 of file dc_test.f90.

11202  use sysdep, only: abortprogram
11203  use dc_types, only: string, token
11204  implicit none
11205  character(*), intent(in):: message
11206  real, intent(in):: answer(:,:,:,:)
11207  real, intent(in):: check(:,:,:,:)
11208  logical, intent(in), optional:: negative_support
11209  logical:: err_flag
11210  logical:: negative_support_on
11211  character(STRING):: pos_str
11212  character(TOKEN):: abs_mes
11213  real:: wrong, right
11214 
11215  integer:: answer_shape(4), check_shape(4), pos(4)
11216  logical:: consist_shape(4)
11217  character(TOKEN):: pos_array(4)
11218  integer, allocatable:: mask_array(:,:,:,:)
11219  logical, allocatable:: judge(:,:,:,:)
11220  logical, allocatable:: judge_rev(:,:,:,:)
11221  logical, allocatable:: answer_negative(:,:,:,:)
11222  logical, allocatable:: check_negative(:,:,:,:)
11223  logical, allocatable:: both_negative(:,:,:,:)
11224 
11225 
11226  continue
11227  if (present(negative_support)) then
11228  negative_support_on = negative_support
11229  else
11230  negative_support_on = .true.
11231  end if
11232 
11233  err_flag = .false.
11234 
11235 
11236  answer_shape = shape(answer)
11237  check_shape = shape(check)
11238 
11239  consist_shape = answer_shape == check_shape
11240 
11241  if (.not. all(consist_shape)) then
11242  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11243  write(*,*) ''
11244  write(*,*) ' shape of check is (', check_shape, ')'
11245  write(*,*) ' is INCORRECT'
11246  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
11247 
11248  call abortprogram('')
11249  end if
11250 
11251 
11252  allocate( mask_array( &
11253  & answer_shape(1), &
11254 
11255  & answer_shape(2), &
11256 
11257  & answer_shape(3), &
11258 
11259  & answer_shape(4) ) &
11260  & )
11261 
11262  allocate( judge( &
11263  & answer_shape(1), &
11264 
11265  & answer_shape(2), &
11266 
11267  & answer_shape(3), &
11268 
11269  & answer_shape(4) ) &
11270  & )
11271 
11272  allocate( judge_rev( &
11273  & answer_shape(1), &
11274 
11275  & answer_shape(2), &
11276 
11277  & answer_shape(3), &
11278 
11279  & answer_shape(4) ) &
11280  & )
11281 
11282  allocate( answer_negative( &
11283  & answer_shape(1), &
11284 
11285  & answer_shape(2), &
11286 
11287  & answer_shape(3), &
11288 
11289  & answer_shape(4) ) &
11290  & )
11291 
11292  allocate( check_negative( &
11293  & answer_shape(1), &
11294 
11295  & answer_shape(2), &
11296 
11297  & answer_shape(3), &
11298 
11299  & answer_shape(4) ) &
11300  & )
11301 
11302  allocate( both_negative( &
11303  & answer_shape(1), &
11304 
11305  & answer_shape(2), &
11306 
11307  & answer_shape(3), &
11308 
11309  & answer_shape(4) ) &
11310  & )
11311 
11312  answer_negative = answer < 0.0
11313  check_negative = check < 0.0
11314  both_negative = answer_negative .and. check_negative
11315  if (.not. negative_support_on) both_negative = .false.
11316 
11317  judge = answer < check
11318  where (both_negative) judge = .not. judge
11319 
11320  judge_rev = .not. judge
11321  err_flag = any(judge_rev)
11322  mask_array = 1
11323  pos = maxloc(mask_array, judge_rev)
11324 
11325  if (err_flag) then
11326 
11327  wrong = check( &
11328  & pos(1), &
11329 
11330  & pos(2), &
11331 
11332  & pos(3), &
11333 
11334  & pos(4) )
11335 
11336  right = answer( &
11337  & pos(1), &
11338 
11339  & pos(2), &
11340 
11341  & pos(3), &
11342 
11343  & pos(4) )
11344 
11345  write(unit=pos_array(1), fmt="(i20)") pos(1)
11346 
11347  write(unit=pos_array(2), fmt="(i20)") pos(2)
11348 
11349  write(unit=pos_array(3), fmt="(i20)") pos(3)
11350 
11351  write(unit=pos_array(4), fmt="(i20)") pos(4)
11352 
11353 
11354  pos_str = '(' // &
11355  & trim(adjustl(pos_array(1))) // ',' // &
11356 
11357  & trim(adjustl(pos_array(2))) // ',' // &
11358 
11359  & trim(adjustl(pos_array(3))) // ',' // &
11360 
11361  & trim(adjustl(pos_array(4))) // ')'
11362 
11363  if ( both_negative( &
11364  & pos(1), &
11365 
11366  & pos(2), &
11367 
11368  & pos(3), &
11369 
11370  & pos(4) ) ) then
11371 
11372  abs_mes = 'ABSOLUTE value of'
11373  else
11374  abs_mes = ''
11375 
11376  end if
11377 
11378  end if
11379  deallocate(mask_array, judge, judge_rev)
11380  deallocate(answer_negative, check_negative, both_negative)
11381 
11382 
11383 
11384 
11385  if (err_flag) then
11386  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11387  write(*,*) ''
11388  write(*,*) ' ' // trim(abs_mes) // &
11389  & ' check' // trim(pos_str) // ' = ', wrong
11390  write(*,*) ' is NOT GREATER THAN'
11391  write(*,*) ' ' // trim(abs_mes) // &
11392  & ' answer' // trim(pos_str) // ' = ', right
11393 
11394  call abortprogram('')
11395  else
11396  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
11397  end if
11398 
11399 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal5()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal5 ( character(*), intent(in)  message,
real, dimension(:,:,:,:,:), intent(in)  answer,
real, dimension(:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 11405 of file dc_test.f90.

11405  use sysdep, only: abortprogram
11406  use dc_types, only: string, token
11407  implicit none
11408  character(*), intent(in):: message
11409  real, intent(in):: answer(:,:,:,:,:)
11410  real, intent(in):: check(:,:,:,:,:)
11411  logical, intent(in), optional:: negative_support
11412  logical:: err_flag
11413  logical:: negative_support_on
11414  character(STRING):: pos_str
11415  character(TOKEN):: abs_mes
11416  real:: wrong, right
11417 
11418  integer:: answer_shape(5), check_shape(5), pos(5)
11419  logical:: consist_shape(5)
11420  character(TOKEN):: pos_array(5)
11421  integer, allocatable:: mask_array(:,:,:,:,:)
11422  logical, allocatable:: judge(:,:,:,:,:)
11423  logical, allocatable:: judge_rev(:,:,:,:,:)
11424  logical, allocatable:: answer_negative(:,:,:,:,:)
11425  logical, allocatable:: check_negative(:,:,:,:,:)
11426  logical, allocatable:: both_negative(:,:,:,:,:)
11427 
11428 
11429  continue
11430  if (present(negative_support)) then
11431  negative_support_on = negative_support
11432  else
11433  negative_support_on = .true.
11434  end if
11435 
11436  err_flag = .false.
11437 
11438 
11439  answer_shape = shape(answer)
11440  check_shape = shape(check)
11441 
11442  consist_shape = answer_shape == check_shape
11443 
11444  if (.not. all(consist_shape)) then
11445  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11446  write(*,*) ''
11447  write(*,*) ' shape of check is (', check_shape, ')'
11448  write(*,*) ' is INCORRECT'
11449  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
11450 
11451  call abortprogram('')
11452  end if
11453 
11454 
11455  allocate( mask_array( &
11456  & answer_shape(1), &
11457 
11458  & answer_shape(2), &
11459 
11460  & answer_shape(3), &
11461 
11462  & answer_shape(4), &
11463 
11464  & answer_shape(5) ) &
11465  & )
11466 
11467  allocate( judge( &
11468  & answer_shape(1), &
11469 
11470  & answer_shape(2), &
11471 
11472  & answer_shape(3), &
11473 
11474  & answer_shape(4), &
11475 
11476  & answer_shape(5) ) &
11477  & )
11478 
11479  allocate( judge_rev( &
11480  & answer_shape(1), &
11481 
11482  & answer_shape(2), &
11483 
11484  & answer_shape(3), &
11485 
11486  & answer_shape(4), &
11487 
11488  & answer_shape(5) ) &
11489  & )
11490 
11491  allocate( answer_negative( &
11492  & answer_shape(1), &
11493 
11494  & answer_shape(2), &
11495 
11496  & answer_shape(3), &
11497 
11498  & answer_shape(4), &
11499 
11500  & answer_shape(5) ) &
11501  & )
11502 
11503  allocate( check_negative( &
11504  & answer_shape(1), &
11505 
11506  & answer_shape(2), &
11507 
11508  & answer_shape(3), &
11509 
11510  & answer_shape(4), &
11511 
11512  & answer_shape(5) ) &
11513  & )
11514 
11515  allocate( both_negative( &
11516  & answer_shape(1), &
11517 
11518  & answer_shape(2), &
11519 
11520  & answer_shape(3), &
11521 
11522  & answer_shape(4), &
11523 
11524  & answer_shape(5) ) &
11525  & )
11526 
11527  answer_negative = answer < 0.0
11528  check_negative = check < 0.0
11529  both_negative = answer_negative .and. check_negative
11530  if (.not. negative_support_on) both_negative = .false.
11531 
11532  judge = answer < check
11533  where (both_negative) judge = .not. judge
11534 
11535  judge_rev = .not. judge
11536  err_flag = any(judge_rev)
11537  mask_array = 1
11538  pos = maxloc(mask_array, judge_rev)
11539 
11540  if (err_flag) then
11541 
11542  wrong = check( &
11543  & pos(1), &
11544 
11545  & pos(2), &
11546 
11547  & pos(3), &
11548 
11549  & pos(4), &
11550 
11551  & pos(5) )
11552 
11553  right = answer( &
11554  & pos(1), &
11555 
11556  & pos(2), &
11557 
11558  & pos(3), &
11559 
11560  & pos(4), &
11561 
11562  & pos(5) )
11563 
11564  write(unit=pos_array(1), fmt="(i20)") pos(1)
11565 
11566  write(unit=pos_array(2), fmt="(i20)") pos(2)
11567 
11568  write(unit=pos_array(3), fmt="(i20)") pos(3)
11569 
11570  write(unit=pos_array(4), fmt="(i20)") pos(4)
11571 
11572  write(unit=pos_array(5), fmt="(i20)") pos(5)
11573 
11574 
11575  pos_str = '(' // &
11576  & trim(adjustl(pos_array(1))) // ',' // &
11577 
11578  & trim(adjustl(pos_array(2))) // ',' // &
11579 
11580  & trim(adjustl(pos_array(3))) // ',' // &
11581 
11582  & trim(adjustl(pos_array(4))) // ',' // &
11583 
11584  & trim(adjustl(pos_array(5))) // ')'
11585 
11586  if ( both_negative( &
11587  & pos(1), &
11588 
11589  & pos(2), &
11590 
11591  & pos(3), &
11592 
11593  & pos(4), &
11594 
11595  & pos(5) ) ) then
11596 
11597  abs_mes = 'ABSOLUTE value of'
11598  else
11599  abs_mes = ''
11600 
11601  end if
11602 
11603  end if
11604  deallocate(mask_array, judge, judge_rev)
11605  deallocate(answer_negative, check_negative, both_negative)
11606 
11607 
11608 
11609 
11610  if (err_flag) then
11611  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11612  write(*,*) ''
11613  write(*,*) ' ' // trim(abs_mes) // &
11614  & ' check' // trim(pos_str) // ' = ', wrong
11615  write(*,*) ' is NOT GREATER THAN'
11616  write(*,*) ' ' // trim(abs_mes) // &
11617  & ' answer' // trim(pos_str) // ' = ', right
11618 
11619  call abortprogram('')
11620  else
11621  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
11622  end if
11623 
11624 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal6()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal6 ( character(*), intent(in)  message,
real, dimension(:,:,:,:,:,:), intent(in)  answer,
real, dimension(:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 11630 of file dc_test.f90.

11630  use sysdep, only: abortprogram
11631  use dc_types, only: string, token
11632  implicit none
11633  character(*), intent(in):: message
11634  real, intent(in):: answer(:,:,:,:,:,:)
11635  real, intent(in):: check(:,:,:,:,:,:)
11636  logical, intent(in), optional:: negative_support
11637  logical:: err_flag
11638  logical:: negative_support_on
11639  character(STRING):: pos_str
11640  character(TOKEN):: abs_mes
11641  real:: wrong, right
11642 
11643  integer:: answer_shape(6), check_shape(6), pos(6)
11644  logical:: consist_shape(6)
11645  character(TOKEN):: pos_array(6)
11646  integer, allocatable:: mask_array(:,:,:,:,:,:)
11647  logical, allocatable:: judge(:,:,:,:,:,:)
11648  logical, allocatable:: judge_rev(:,:,:,:,:,:)
11649  logical, allocatable:: answer_negative(:,:,:,:,:,:)
11650  logical, allocatable:: check_negative(:,:,:,:,:,:)
11651  logical, allocatable:: both_negative(:,:,:,:,:,:)
11652 
11653 
11654  continue
11655  if (present(negative_support)) then
11656  negative_support_on = negative_support
11657  else
11658  negative_support_on = .true.
11659  end if
11660 
11661  err_flag = .false.
11662 
11663 
11664  answer_shape = shape(answer)
11665  check_shape = shape(check)
11666 
11667  consist_shape = answer_shape == check_shape
11668 
11669  if (.not. all(consist_shape)) then
11670  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11671  write(*,*) ''
11672  write(*,*) ' shape of check is (', check_shape, ')'
11673  write(*,*) ' is INCORRECT'
11674  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
11675 
11676  call abortprogram('')
11677  end if
11678 
11679 
11680  allocate( mask_array( &
11681  & answer_shape(1), &
11682 
11683  & answer_shape(2), &
11684 
11685  & answer_shape(3), &
11686 
11687  & answer_shape(4), &
11688 
11689  & answer_shape(5), &
11690 
11691  & answer_shape(6) ) &
11692  & )
11693 
11694  allocate( judge( &
11695  & answer_shape(1), &
11696 
11697  & answer_shape(2), &
11698 
11699  & answer_shape(3), &
11700 
11701  & answer_shape(4), &
11702 
11703  & answer_shape(5), &
11704 
11705  & answer_shape(6) ) &
11706  & )
11707 
11708  allocate( judge_rev( &
11709  & answer_shape(1), &
11710 
11711  & answer_shape(2), &
11712 
11713  & answer_shape(3), &
11714 
11715  & answer_shape(4), &
11716 
11717  & answer_shape(5), &
11718 
11719  & answer_shape(6) ) &
11720  & )
11721 
11722  allocate( answer_negative( &
11723  & answer_shape(1), &
11724 
11725  & answer_shape(2), &
11726 
11727  & answer_shape(3), &
11728 
11729  & answer_shape(4), &
11730 
11731  & answer_shape(5), &
11732 
11733  & answer_shape(6) ) &
11734  & )
11735 
11736  allocate( check_negative( &
11737  & answer_shape(1), &
11738 
11739  & answer_shape(2), &
11740 
11741  & answer_shape(3), &
11742 
11743  & answer_shape(4), &
11744 
11745  & answer_shape(5), &
11746 
11747  & answer_shape(6) ) &
11748  & )
11749 
11750  allocate( both_negative( &
11751  & answer_shape(1), &
11752 
11753  & answer_shape(2), &
11754 
11755  & answer_shape(3), &
11756 
11757  & answer_shape(4), &
11758 
11759  & answer_shape(5), &
11760 
11761  & answer_shape(6) ) &
11762  & )
11763 
11764  answer_negative = answer < 0.0
11765  check_negative = check < 0.0
11766  both_negative = answer_negative .and. check_negative
11767  if (.not. negative_support_on) both_negative = .false.
11768 
11769  judge = answer < check
11770  where (both_negative) judge = .not. judge
11771 
11772  judge_rev = .not. judge
11773  err_flag = any(judge_rev)
11774  mask_array = 1
11775  pos = maxloc(mask_array, judge_rev)
11776 
11777  if (err_flag) then
11778 
11779  wrong = check( &
11780  & pos(1), &
11781 
11782  & pos(2), &
11783 
11784  & pos(3), &
11785 
11786  & pos(4), &
11787 
11788  & pos(5), &
11789 
11790  & pos(6) )
11791 
11792  right = answer( &
11793  & pos(1), &
11794 
11795  & pos(2), &
11796 
11797  & pos(3), &
11798 
11799  & pos(4), &
11800 
11801  & pos(5), &
11802 
11803  & pos(6) )
11804 
11805  write(unit=pos_array(1), fmt="(i20)") pos(1)
11806 
11807  write(unit=pos_array(2), fmt="(i20)") pos(2)
11808 
11809  write(unit=pos_array(3), fmt="(i20)") pos(3)
11810 
11811  write(unit=pos_array(4), fmt="(i20)") pos(4)
11812 
11813  write(unit=pos_array(5), fmt="(i20)") pos(5)
11814 
11815  write(unit=pos_array(6), fmt="(i20)") pos(6)
11816 
11817 
11818  pos_str = '(' // &
11819  & trim(adjustl(pos_array(1))) // ',' // &
11820 
11821  & trim(adjustl(pos_array(2))) // ',' // &
11822 
11823  & trim(adjustl(pos_array(3))) // ',' // &
11824 
11825  & trim(adjustl(pos_array(4))) // ',' // &
11826 
11827  & trim(adjustl(pos_array(5))) // ',' // &
11828 
11829  & trim(adjustl(pos_array(6))) // ')'
11830 
11831  if ( both_negative( &
11832  & pos(1), &
11833 
11834  & pos(2), &
11835 
11836  & pos(3), &
11837 
11838  & pos(4), &
11839 
11840  & pos(5), &
11841 
11842  & pos(6) ) ) then
11843 
11844  abs_mes = 'ABSOLUTE value of'
11845  else
11846  abs_mes = ''
11847 
11848  end if
11849 
11850  end if
11851  deallocate(mask_array, judge, judge_rev)
11852  deallocate(answer_negative, check_negative, both_negative)
11853 
11854 
11855 
11856 
11857  if (err_flag) then
11858  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11859  write(*,*) ''
11860  write(*,*) ' ' // trim(abs_mes) // &
11861  & ' check' // trim(pos_str) // ' = ', wrong
11862  write(*,*) ' is NOT GREATER THAN'
11863  write(*,*) ' ' // trim(abs_mes) // &
11864  & ' answer' // trim(pos_str) // ' = ', right
11865 
11866  call abortprogram('')
11867  else
11868  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
11869  end if
11870 
11871 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118

◆ dctestassertgreaterthanreal7()

subroutine dc_test::assertgreaterthan::dctestassertgreaterthanreal7 ( character(*), intent(in)  message,
real, dimension(:,:,:,:,:,:,:), intent(in)  answer,
real, dimension(:,:,:,:,:,:,:), intent(in)  check,
logical, intent(in), optional  negative_support 
)
private

Definition at line 11877 of file dc_test.f90.

11877  use sysdep, only: abortprogram
11878  use dc_types, only: string, token
11879  implicit none
11880  character(*), intent(in):: message
11881  real, intent(in):: answer(:,:,:,:,:,:,:)
11882  real, intent(in):: check(:,:,:,:,:,:,:)
11883  logical, intent(in), optional:: negative_support
11884  logical:: err_flag
11885  logical:: negative_support_on
11886  character(STRING):: pos_str
11887  character(TOKEN):: abs_mes
11888  real:: wrong, right
11889 
11890  integer:: answer_shape(7), check_shape(7), pos(7)
11891  logical:: consist_shape(7)
11892  character(TOKEN):: pos_array(7)
11893  integer, allocatable:: mask_array(:,:,:,:,:,:,:)
11894  logical, allocatable:: judge(:,:,:,:,:,:,:)
11895  logical, allocatable:: judge_rev(:,:,:,:,:,:,:)
11896  logical, allocatable:: answer_negative(:,:,:,:,:,:,:)
11897  logical, allocatable:: check_negative(:,:,:,:,:,:,:)
11898  logical, allocatable:: both_negative(:,:,:,:,:,:,:)
11899 
11900 
11901  continue
11902  if (present(negative_support)) then
11903  negative_support_on = negative_support
11904  else
11905  negative_support_on = .true.
11906  end if
11907 
11908  err_flag = .false.
11909 
11910 
11911  answer_shape = shape(answer)
11912  check_shape = shape(check)
11913 
11914  consist_shape = answer_shape == check_shape
11915 
11916  if (.not. all(consist_shape)) then
11917  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
11918  write(*,*) ''
11919  write(*,*) ' shape of check is (', check_shape, ')'
11920  write(*,*) ' is INCORRECT'
11921  write(*,*) ' Correct shape of answer is (', answer_shape, ')'
11922 
11923  call abortprogram('')
11924  end if
11925 
11926 
11927  allocate( mask_array( &
11928  & answer_shape(1), &
11929 
11930  & answer_shape(2), &
11931 
11932  & answer_shape(3), &
11933 
11934  & answer_shape(4), &
11935 
11936  & answer_shape(5), &
11937 
11938  & answer_shape(6), &
11939 
11940  & answer_shape(7) ) &
11941  & )
11942 
11943  allocate( judge( &
11944  & answer_shape(1), &
11945 
11946  & answer_shape(2), &
11947 
11948  & answer_shape(3), &
11949 
11950  & answer_shape(4), &
11951 
11952  & answer_shape(5), &
11953 
11954  & answer_shape(6), &
11955 
11956  & answer_shape(7) ) &
11957  & )
11958 
11959  allocate( judge_rev( &
11960  & answer_shape(1), &
11961 
11962  & answer_shape(2), &
11963 
11964  & answer_shape(3), &
11965 
11966  & answer_shape(4), &
11967 
11968  & answer_shape(5), &
11969 
11970  & answer_shape(6), &
11971 
11972  & answer_shape(7) ) &
11973  & )
11974 
11975  allocate( answer_negative( &
11976  & answer_shape(1), &
11977 
11978  & answer_shape(2), &
11979 
11980  & answer_shape(3), &
11981 
11982  & answer_shape(4), &
11983 
11984  & answer_shape(5), &
11985 
11986  & answer_shape(6), &
11987 
11988  & answer_shape(7) ) &
11989  & )
11990 
11991  allocate( check_negative( &
11992  & answer_shape(1), &
11993 
11994  & answer_shape(2), &
11995 
11996  & answer_shape(3), &
11997 
11998  & answer_shape(4), &
11999 
12000  & answer_shape(5), &
12001 
12002  & answer_shape(6), &
12003 
12004  & answer_shape(7) ) &
12005  & )
12006 
12007  allocate( both_negative( &
12008  & answer_shape(1), &
12009 
12010  & answer_shape(2), &
12011 
12012  & answer_shape(3), &
12013 
12014  & answer_shape(4), &
12015 
12016  & answer_shape(5), &
12017 
12018  & answer_shape(6), &
12019 
12020  & answer_shape(7) ) &
12021  & )
12022 
12023  answer_negative = answer < 0.0
12024  check_negative = check < 0.0
12025  both_negative = answer_negative .and. check_negative
12026  if (.not. negative_support_on) both_negative = .false.
12027 
12028  judge = answer < check
12029  where (both_negative) judge = .not. judge
12030 
12031  judge_rev = .not. judge
12032  err_flag = any(judge_rev)
12033  mask_array = 1
12034  pos = maxloc(mask_array, judge_rev)
12035 
12036  if (err_flag) then
12037 
12038  wrong = check( &
12039  & pos(1), &
12040 
12041  & pos(2), &
12042 
12043  & pos(3), &
12044 
12045  & pos(4), &
12046 
12047  & pos(5), &
12048 
12049  & pos(6), &
12050 
12051  & pos(7) )
12052 
12053  right = answer( &
12054  & pos(1), &
12055 
12056  & pos(2), &
12057 
12058  & pos(3), &
12059 
12060  & pos(4), &
12061 
12062  & pos(5), &
12063 
12064  & pos(6), &
12065 
12066  & pos(7) )
12067 
12068  write(unit=pos_array(1), fmt="(i20)") pos(1)
12069 
12070  write(unit=pos_array(2), fmt="(i20)") pos(2)
12071 
12072  write(unit=pos_array(3), fmt="(i20)") pos(3)
12073 
12074  write(unit=pos_array(4), fmt="(i20)") pos(4)
12075 
12076  write(unit=pos_array(5), fmt="(i20)") pos(5)
12077 
12078  write(unit=pos_array(6), fmt="(i20)") pos(6)
12079 
12080  write(unit=pos_array(7), fmt="(i20)") pos(7)
12081 
12082 
12083  pos_str = '(' // &
12084  & trim(adjustl(pos_array(1))) // ',' // &
12085 
12086  & trim(adjustl(pos_array(2))) // ',' // &
12087 
12088  & trim(adjustl(pos_array(3))) // ',' // &
12089 
12090  & trim(adjustl(pos_array(4))) // ',' // &
12091 
12092  & trim(adjustl(pos_array(5))) // ',' // &
12093 
12094  & trim(adjustl(pos_array(6))) // ',' // &
12095 
12096  & trim(adjustl(pos_array(7))) // ')'
12097 
12098  if ( both_negative( &
12099  & pos(1), &
12100 
12101  & pos(2), &
12102 
12103  & pos(3), &
12104 
12105  & pos(4), &
12106 
12107  & pos(5), &
12108 
12109  & pos(6), &
12110 
12111  & pos(7) ) ) then
12112 
12113  abs_mes = 'ABSOLUTE value of'
12114  else
12115  abs_mes = ''
12116 
12117  end if
12118 
12119  end if
12120  deallocate(mask_array, judge, judge_rev)
12121  deallocate(answer_negative, check_negative, both_negative)
12122 
12123 
12124 
12125 
12126  if (err_flag) then
12127  write(*,*) ' *** Error [AssertGT] *** Checking ' // trim(message) // ' FAILURE'
12128  write(*,*) ''
12129  write(*,*) ' ' // trim(abs_mes) // &
12130  & ' check' // trim(pos_str) // ' = ', wrong
12131  write(*,*) ' is NOT GREATER THAN'
12132  write(*,*) ' ' // trim(abs_mes) // &
12133  & ' answer' // trim(pos_str) // ' = ', right
12134 
12135  call abortprogram('')
12136  else
12137  write(*,*) ' *** MESSAGE [AssertGT] *** Checking ' // trim(message) // ' OK'
12138  end if
12139 
12140 
dc_types::token
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118
The documentation for this interface was generated from the following file: