#万能(unlimited)クラス class(*)

Fortran 2003 で、型を実行時に決められる、万能(unlimited)型の class(*) が導入されたので、実際に色々な型を入れてみます。

Fortran の型体系は、型と種の二つのパラメータを持っています。型は REAL や INTEGER のような大枠を指定し、種によって単精度、倍精度、バイト長などの指定をします。このほうが real16, real32 云々のように型名を増やして行くより合理的な気がします。

ただし、種はコンパイル時に決まっていなければならず、実行時の動的パラメータにはなりません（多分･･･）。従って、parameter によって与えたり、ある場合は列挙羅列する必要があります。

また Fortran はスカラーや配列の次元（Rank）に厳しいので、class(*) がいくら万能と言っても、Rank の異なるものは扱えません。ただ C言語との相互運用のために、Fortran 2018 あたりから、Rank に関してチェックを緩めてきているので、そのうち何とかなるかもしれません。

##プログラム
万能 Class 変数に、実数の単精度、倍精度、４倍精度、文字列、整数を次々代入して（正確には 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