sysdep.f90

Go to the documentation of this file.

! -*- coding: utf-8; mode: f90 -*-
!==   sysdep.f90 - module providing interface for system dependent procedures
!
! Authors::   Youhei SASAKI, Eizi TOYODA, Yasuhiro MORIKAWA
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2017. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides sysdep
!

module sysdep
  !
  != module providing interface for system dependent procedures
  !
  ! このモジュールはシステムに依存する手続きに関する
  ! インタフェースを提供します。
  ! 言い換えると、このモジュールではシステムに依存するサブルーチンと関数の
  ! インタフェース宣言がなされています。
  ! これらの手続きは対応する名前がついたファイル内において実装されています
  ! (すなわち <tt>sysdep</tt> で始まる名前のファイル群において、です)。
  !
  ! 従って、ある名前の手続きがあったとして、その手続きの実装は実際には
  ! 複数のファイルにおいて行われている可能性があるので気をつけてください。
  !
  ! この sysdep モジュールは他のモジュールに依存しません。
  !
  !
  ! It provides interface for system dependent procedures.
  ! In other words, there is interface declaration of a function and
  ! subroutines whose feature is regarded as system dependent.
  ! Implementation of these procedures are given in files with
  ! corresponding name (i.e. that begins with <tt>sysdep</tt>-).
  !
  ! Note that a procedure with one name may have several implementations.
  !
  ! The sysdep has no dependence to other modules.
  !
  use, intrinsic :: iso_c_binding
  implicit none
  private
  public :: abortprogram
  public :: sysdepargget
  public :: sysdepargcount
  public :: sysdepenvget

  interface
    subroutine dc_f_abort() &
      ! bind(C, name="dc_c_abort")
      bind(c, name="abort")
      import
    end subroutine dc_f_abort
  end interface

contains

  subroutine abortprogram(message)
    use dc_types, only: stderr
    implicit none
    character(len=*), intent(in), optional :: message
    continue
    if (present(message)) write(stderr, *) trim(message)
    call dc_f_abort()
  end subroutine abortprogram

  integer function sysdepargcount()
    implicit none
    sysdepargcount = command_argument_count()
  end function sysdepargcount

  subroutine sysdepargget(index, val)
    implicit none
    integer,            intent(in)  :: index
    character(len = *), intent(out) :: val
    !
    integer:: idx
    integer:: argc
    continue
    argc = sysdepargcount()
    if (index < 0) then
      idx = argc + 1 + index
    else
      idx = index
    endif
    if (idx > argc) then
      val = ''
    else
      call get_command_argument(index, val)
    end if
  end subroutine sysdepargget

  subroutine sysdepenvget(env, str)
    character(len = *), intent(in)  :: env
    character(len = *), intent(out) :: str
    call get_environment_variable(trim(adjustl(env)), str)
  end subroutine sysdepenvget

end module sysdep