sysdepabort-setrcd.f90

Path: sysdepabort-setrcd.f90
Last Update: Sun Feb 05 21:50:59 +0900 2006

SysdepAbort - 環境依存性ルーチン (プログラム停止)

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: sysdepabort-setrcd.f90,v 1.7 2006-02-05 12:50:59 morikawa Exp $
Tag Name:$Name: gt4f90io-20080605 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

メッセージを表示してプログラムを停止します。 通常の処理系では abort() があるのでこの組み込み手続きを利用します。 たいていは異常終了します。 abort() が実装されていない処理系では何もしない abort() を造ると あとの stop でとめることが可能です。

Required files

gtdata_generic.f90   dc_trace.f90  

Methods

SysdepAbort  

Included Modules

gtdata_generic dc_trace

Public Instance methods

SysdepAbort( string )
Subroutine :
string :character(len = *), intent(in)

この手続きは、引数 string を装置 * に出力後、 プログラムを強制終了させます。 AbortProgram というのは総称名です。 実際にはソースコードを簡単に見つけるため、 SysdepAbort というサブルーチン名を与えられています。 多くの実装では終了コードをゼロ以外にしようと試みていますが、 それをあまり当てにするべきではありません。

This procedure terminates program after string is outputted to unit "*". AbortProgram is a generic name of a subroutine. In fact, the subroutine was given another name SysdepAbort, in order to make it easier to find the source code. Though many implementations are trying to set exit code other than zero, that should not be relied upon.

[Source]

subroutine SysdepAbort(string)
  !
  ! この手続きは、引数 _string_ を装置 * に出力後、
  ! プログラムを強制終了させます。
  ! *AbortProgram* というのは総称名です。
  ! 実際にはソースコードを簡単に見つけるため、
  ! *SysdepAbort* というサブルーチン名を与えられています。
  ! 多くの実装では終了コードをゼロ以外にしようと試みていますが、
  ! それをあまり当てにするべきではありません。
  !
  ! This procedure terminates program after _string_ is
  ! outputted to unit "*".
  ! *AbortProgram* is a generic name of a subroutine.
  ! In fact, the subroutine was given another name *SysdepAbort*,
  ! in order to make it easier to find the source code.
  ! Though many implementations are trying to set exit code
  ! other than zero, that should *not* be relied upon.
  !
  use gtdata_generic, only: gtvarsync
  use dc_trace, only: dbg_scratch
  implicit none
  character(len = *), intent(in):: string
  integer  :: stat
continue
  write(*, *) trim(string)
  call dbg_scratch(.false.)
  call gtvarsync(stat=stat)
  !
  ! Selected by Makefile using m4
  !
  ! --- fqs ffc ---
  call setrcd(3)
  call exit
  stop 'failsafe'
end subroutine

[Validate]