check 子例程

public subroutine check(condition, msg, code, warn)

检查逻辑条件的值 (规范)

行为

如果 condition == .false. 并且

  • 没有提供其他参数，它将使用默认消息和退出代码 1 停止程序；
  • 提供了 msg，它将打印 msg 的值；
  • 提供了 code，它将使用给定的退出代码停止程序；
  • 提供了 warn 且为 .true.，它不会停止程序并打印消息。
示例
  • 如果 a /= 5，则使用退出代码 1 停止程序并打印 Check failed.
  call check(a == 5)
  • 如上所述，但打印 a == 5 failed。
  call check(a == 5, msg='a == 5 failed.')
  • 如上所述，但不会停止程序。
  call check(a == 5, msg='a == 5 failed.', warn=.true.)
  • 如示例 #2 所述，但使用退出代码 77 停止程序
  call check(a == 5, msg='a == 5 failed.', code=77)

参数

类型 意图可选 属性 名称
逻辑型， intent(in) :: condition
字符型(len=*), intent(in), 可选 :: msg
整型， intent(in), 可选 :: code
逻辑型， intent(in), 可选 :: warn

源代码

subroutine check(condition, msg, code, warn)
    !! version: experimental
    !!
    !! Checks the value of a logical condition
    !! ([Specification](../page/specs/stdlib_error.html#description))
    !!
    !!##### Behavior
    !!
    !! If `condition == .false.` and:
    !!
    !!   * No other arguments are provided, it stops the program with the default
    !!     message and exit code `1`;
    !!   * `msg` is provided, it prints the value of `msg`;
    !!   * `code` is provided, it stops the program with the given exit code;
    !!   * `warn` is provided and `.true.`, it doesn't stop the program and prints
    !!     the message.
    !!
    !!##### Examples
    !!
    !!* If `a /= 5`, stops the program with exit code `1`
    !!  and prints `Check failed.`
    !!``` fortran
    !!  call check(a == 5)
    !!```
    !!
    !!* As above, but prints `a == 5 failed`.
    !!``` fortran
    !!  call check(a == 5, msg='a == 5 failed.')
    !!```
    !!
    !!* As above, but doesn't stop the program.
    !!``` fortran
    !!  call check(a == 5, msg='a == 5 failed.', warn=.true.)
    !!```
    !!
    !!* As example #2, but stops the program with exit code `77`
    !!``` fortran
    !!  call check(a == 5, msg='a == 5 failed.', code=77)
    !!```

    !
    ! Arguments
    ! ---------

    logical, intent(in) :: condition
    character(*), intent(in), optional :: msg
    integer, intent(in), optional :: code
    logical, intent(in), optional :: warn
    character(*), parameter :: msg_default = 'Check failed.'

    if (.not. condition) then
        if (optval(warn, .false.)) then
            write(stderr,*) optval(msg, msg_default)
        else
            call error_stop(optval(msg, msg_default), optval(code, 1))
        end if
    end if

end subroutine check