#万能(unlimited)クラス class(*)
Fortran 2003 で、型を実行時に決められる、万能(unlimited)型の class(*) が導入されたので、実際に色々な型を入れてみます。
Fortran の型体系は、型と種の二つのパラメータを持っています。型は REAL や INTEGER のような大枠を指定し、種によって単精度、倍精度、バイト長などの指定をします。このほうが real16, real32 云々のように型名を増やして行くより合理的な気がします。
ただし、種はコンパイル時に決まっていなければならず、実行時の動的パラメータにはなりません(多分・・・)。従って、parameter によって与えたり、ある場合は列挙羅列する必要があります。
また Fortran はスカラーや配列の次元(Rank)に厳しいので、class(*) がいくら万能と言っても、Rank の異なるものは扱えません。ただ C言語との相互運用のために、Fortran 2018 あたりから、Rank に関してチェックを緩めてきているので、そのうち何とかなるかもしれません。
##プログラム
万能 Class 変数に、実数の単精度、倍精度、4倍精度、文字列、整数を次々代入して(正確には allocate/reallocate) して、その値を画面に出力しています。万能 Class(*) は実行時に型情報も持ち運んでいると思うのですが、WRITE 文はそれを理解しないので、select type で自分で場合分けした上で write 文に渡してあげる必要があります。また型と種それぞれについて、場合分けが必要です。
program test
implicit none
class(*), allocatable :: x
x = 4 * atan(1.0) ! allocate(x, source = 4 * atan(1.0))
call pr(x)
x = 4 * atan(1.0d0)
call pr(x)
x = 4 * atan(1.0q0)
call pr(x)
x = 'abc'
call pr(x)
x = 123
call pr(x)
stop
contains
subroutine pr(x)
class(*), intent(in) :: x
select type (x)
type is (real(kind(1.0e0)))
print *, x
type is (real(kind(1.0d0)))
print *, x
type is (real(kind(1.0q0)))
print *, x
type is (character(*))
print *, x
class default
print *, 'data type not supported'
end select
end subroutine pr
end program test
##実行例
3.141593
3.14159265358979
3.14159265358979323846264338327950
abc
data type not supported
続行するには何かキーを押してください . . .
##class(*) からの代入 [H30.7.11 補足]
この場合もいちいち select type で型(種)を定めてからでないと代入できません。どうするのが、うまい手かよく分かりません。取りあえず個別に書いて総称名で束ねてみます。assignment operator のオーバーロードは、型判別かぶりにのためできませんでした。
###プログラム
module m_type
use, intrinsic :: iso_fortran_env
implicit none
interface asgn
module procedure :: int_asgn, real_asgn, dble_asgn, quad_asgn, cha_asgn
end interface
contains
subroutine int_asgn(x, i)
class(*), intent(in ) :: x
integer , intent(out) :: i
select type (x)
type is (integer)
i = x
class default
i = -9999
end select
end subroutine int_asgn
subroutine real_asgn(x, r)
class(*) , intent(in ) :: x
real(real32), intent(out) :: r
select type (x)
type is (real(real32))
r = x
class default
r = -huge(r)
end select
end subroutine real_asgn
subroutine dble_asgn(x, d)
class(*) , intent(in ) :: x
real(real64), intent(out) :: d
select type (x)
type is (real(real64))
d = x
class default
d = -huge(d)
end select
end subroutine dble_asgn
subroutine quad_asgn(x, q)
class(*) , intent(in ) :: x
real(real128), intent(out) :: q
select type (x)
type is (real(real128))
q = x
class default
q = -huge(q)
end select
end subroutine quad_asgn
subroutine cha_asgn(x, s)
class(*), intent(in) :: x
character(:), allocatable :: s
select type (x)
type is (character(*))
s = x
class default
s = ''
end select
end subroutine cha_asgn
end module m_type
program test
use m_type
implicit none
class(*), allocatable :: x
integer :: i
real(kind(0.0e0)) :: r
real(kind(0.0d0)) :: d
real(kind(0.0q0)) :: q
character(len = :), allocatable :: s
x = 4 * atan(1.0)
call asgn(x, r)
print *, r
x = 4 * atan(1.0d0)
call asgn(x, d)
print *, d
x = 4 * atan(1.0q0)
call asgn(x, q)
print *, q
x = 'abc'
call asgn(x, s)
print *, s
x = 123
call asgn(x, i)
print *, i
end program test
###実行結果
3.141593
3.14159265358979
3.14159265358979323846264338327950
abc
123