#!/usr/bin/env ruby
# -*- f90 -*-
# vi: set sw=4 ts=8:
require("intrinsic_types")
require("optparse")
#
# "sysdepabort-****.f90" Generator with Ruby.
#
opt = OptionParser.new
opt.on('--aborttype=VAL') {|v| $aborttype = v}
opt.parse!(ARGV)
$aborttype = "ABORT" unless $aborttype
print <<"__EndOfFortran90Code__"
!--
#{rb2f90_header_comment}!
!++
!
!== SysdepAbort - 環境依存性ルーチン (プログラム停止)
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: sysdepabort.rb2f90,v 1.3 2006-02-05 08:20:07 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20080812 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! メッセージを表示してプログラムを停止します。
! 通常の処理系では abort() があるのでこの組み込み手続きを利用します。
! たいていは異常終了します。
! abort() が実装されていない処理系では何もしない abort() を造ると
! あとの stop でとめることが可能です。
!
__EndOfFortran90Code__

print <<"__EndOfFortran90Code__"

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
  !
#{ifelse($aborttype, "EXIT", %Q{
  call exit(3)
}, $aborttype, "SETRCD", %Q{
  ! --- fqs ffc ---
  call setrcd(3)
  call exit
}, $aborttype, "ERRTRA-SETRCD", %Q{
  ! --- lahey ---
  call errtra
  call setrcd(13)
  call exit(3)
}, $aborttype, "ABORT", %Q{
  call abort() ! --- dvf, sun ---
}, %Q{
  ! --- hitachi ---
  stop 3
})}
  stop 'failsafe'
end subroutine
__EndOfFortran90Code__

print <<"__EndOfFooter__"
!--
! vi:set readonly sw=4 ts=8:
!
#{rb2f90_emacs_readonly}!
!++
__EndOfFooter__