前記事
https://qiita.com/cure_honey/items/aa477bdf364a0604d416
ユーザー定義コンストラクタ
派生型変数に単に値を与える場合ならば、デフォルトのコンストラクタで十分ですが、代入時に値チェックなどをしようとすると、ユーザー定義のコンストラクタを書く必要が出てきます。これを実現する方法としては、初期化用の関数を定義して、interface によって、この関数でデフォルトコンストラクタを上書きする方法がとられます。
しかし、この方法には欠点があって、右辺で関数の返り値として生成されるオブジェクトは、左辺にディープ・コピーによって代入され、直後に解放される一時オブジェクトであり、代入直後に解放されるという無駄な処理がなされます。
本来、関数の返り値として生成されたオブジェクトの番地だけを渡せばいいのですが、Fortran の allocatable は、原則ディープ・コピーされるので無駄が生じます。allocatable 変数の参照番地は move_alloc サブルーチンで move することが出来ますが、関数の返り値を引数に取ることは出来ないようです。
参照番地のコピーはポインタを使えば可能で、関数の返り値の属性を allocatable ではなく pointer にすれば、この問題は解決しますが pointer は最適化を妨げ、解放処理を人間側が明示的に行わねばならないので、できれば使いたくありません。
assignment 演算子 (=) のユーザー定義上書きによる方法
operator overload を使って、代入をユーザー定義のサブルーチンで上書きする方法があります。これは Fortran 90 によって導入された機能で、代入演算子の両辺の型とそれぞれ一致する型を持つ引数のサブルーチンを呼び出させられます。ただしこれは、コンパイル・リンク時の静的に解決です。
この機能は Fortran 90 での導入なので、Fortran 95 で導入された elemental 属性による引数の rank によらない記述や、Fortran 2003 で導入されたいわゆる継承の扱いがうまくできないという問題があります。（Fortran 2008 で assumed rank という配列の rank によらない仮引数の仕組みが導入されましたが、あくまで C 言語との相互運用用で Fortran 内では使いようがない感じです。）
プログラム例
ここでは有理数（分数）を念頭に、２つの整数変数を要素成分にもつ派生型を定義して、その分母にあたる成分に０を代入しようとすると警告文を表示する例を考えます。
またファイナライザを定義することで、オブジェクト解放のタイミングを観察します。
第１の方法として、初期化関数をデフォルト・コンストラクタに上書きする方法を、第２の方法として、初期化サブルーチンを assignment 演算子に上書きする方法を見てみます。
第一の方法では、elemental 属性をつけることで rank に依らず、静的か allocatable かにもよらず、また左辺の（継承でゆるされる）型に依らないコンストラクタを定義出来ます。しかし、無駄なオブジェクト生成・解放が行われます。
第二の方法では、スカラーか配列かによってそれぞれ用のサブルーチンを用意する必要があります。また静的に型が固定されているので、代入の左右両辺の型毎にもサブルーチンを用意する必要があります。用意されていない組み合わせには、デフォルト・コンストラクタが適用されます。また左辺の変数が静的か allocatable かを区別する処理も必要になります。
module m_test
implicit none
interface t_rat1
procedure :: init_rat1
end interface
interface assignment (=)
procedure :: init_rat2_alloc, init_rat2_alloc_arr
end interface
type :: t_rat1
integer :: inume = 0, ideno = 1
contains
final :: fin_rat1
end type t_rat1
type :: t_rat2
integer :: inume = 0, ideno = 1
contains
final :: fin_rat2
end type t_rat2
contains
impure elemental function init_rat1(inume, ideno) result(res)
integer, intent(in) :: inume, ideno
type (t_rat1) :: res
if (ideno == 0) print *, '**************!!denominator is 0!!**************'
res%inume = inume
res%ideno = ideno
end function init_rat1
subroutine fin_rat1(this)
type(t_rat1), intent(in out) :: this
print *, '..fin_rat1', this%inume, this%ideno
end subroutine fin_rat1
subroutine init_rat2_alloc(b, a)
type(t_rat2), intent(in ) :: a
type(t_rat2), intent(in out), allocatable :: b
if (a%ideno == 0) print *, '**************!!denominator is 0!!**************'
if (allocated(b)) then
b%inume = a%inume
b%ideno = a%ideno
else
allocate(b, source = a)
end if
end subroutine init_rat2_alloc
subroutine init_rat2_alloc_arr(b, a)
type(t_rat2), intent(in ) :: a(:)
type(t_rat2), intent(out), allocatable :: b(:)
if (any(a%ideno == 0)) print *, '**************!!denominator is 0!!**************'
allocate(b, source = a)
end subroutine init_rat2_alloc_arr
subroutine fin_rat2(this)
type(t_rat2), intent(in out) :: this
print *, '..fin_rat2', this%inume, this%ideno
end subroutine fin_rat2
end module m_test
program mycnstrctr
use m_test
implicit none
print *, 'rational number: 1'
block
type(t_rat1), allocatable :: x, y, z, w(:)
print *, ' before: x = t_rat1(5, 2)'
x = t_rat1(5, 2)
print *, ' before: y = t_rat1(1, 0)'
y = t_rat1(1, 0)
print *, ' before: z = y'
z = y
print *, ' before y = t_rat1(0, 0)'
y = t_rat1(0, 0)
print *, ' before w = t_rat1([1, 1], [2, 2])'
w = t_rat1([1, 1], [2, 2])
print *, ' after w = t_rat1([1, 1], [2, 2])'
print *, w
print *, ' before w = [t_rat1(1, 1), t_rat1(2, 2)]'
w = [t_rat1(1, 0), t_rat1(2, 2)]
print *, ' after w = [t_rat1(1, 1), t_rat1(2, 2)]'
print *, w
print *, 'end of block'
end block
print *
print *, 'rational number: 2'
block
type(t_rat2), allocatable :: x, y, z, w(:)
print *, ' before: x = t_rat2(5, 2)'
x = t_rat2(5, 2)
print *, ' before: y = t_rat2(1, 0)'
y = t_rat2(1, 0)
print *, ' before: z = y'
z = y
print *, ' before y = t_rat2(0, 0)'
y = t_rat2(0, 0)
print *, ' after y = t_rat2(0, 0)'
! w = t_rat2([1, 1], [2, 2])
! print *, ' after w = t_rat2([1, 1], [2, 2])'
! print *, w
print *, ' before w = [t_rat2(1, 1), t_rat2(2, 2)]'
w = [t_rat2(1, 0), t_rat2(2, 2)]
print *, ' after w = [t_rat2(1, 1), t_rat2(2, 2)]'
print *, w
print *, 'end of block'
end block
stop 'normal termination'
end program mycnstrctr
実行結果
intel fortran v.19
実行結果をみると、デフォルト・コンストラクタを上書きする方法では t_rat1 コンストラクタを呼び出すごとに、
..fin_rat1 5 2
のような表示がなされ、ファイナライザが起動されていることが分かります。これに対して、assignment 演算子を上書きする方法では、block 構造を抜け出る時にのみ解放処理が行われています。また
z = y
のような変数間の代入の場合、第１の方法は t_rat1 コンストラクタを明示的に用いていないので、分母 0 チェックがなされません。ところが第２の方法では、代入演算子が上書きされているので、このような場合でも分母 0 チェックがなされています。
配列の扱いにも少し違いが出てきます。第２の方法は、配列用のサブルーチンを用意する必要があり、より厳しい制限がでます。
rational number: 1
before: x = t_rat1(5, 2)
..fin_rat1 5 2
before: y = t_rat1(1, 0)
**************!!denominator is 0!!**************
..fin_rat1 1 0
before: z = y
before y = t_rat1(0, 0)
**************!!denominator is 0!!**************
..fin_rat1 1 0
..fin_rat1 0 0
before w = t_rat1([1, 1], [2, 2])
..fin_rat1 1 2
after w = t_rat1([1, 1], [2, 2])
1 2 1 2
before w = [t_rat1(1, 1), t_rat1(2, 2)]
**************!!denominator is 0!!**************
..fin_rat1 2 2
..fin_rat1 1 0
after w = [t_rat1(1, 1), t_rat1(2, 2)]
1 0 2 2
end of block
..fin_rat1 5 2
..fin_rat1 0 0
..fin_rat1 1 0
rational number: 2
before: x = t_rat2(5, 2)
before: y = t_rat2(1, 0)
**************!!denominator is 0!!**************
before: z = y
**************!!denominator is 0!!**************
before y = t_rat2(0, 0)
**************!!denominator is 0!!**************
after y = t_rat2(0, 0)
before w = [t_rat2(1, 1), t_rat2(2, 2)]
**************!!denominator is 0!!**************
after w = [t_rat2(1, 1), t_rat2(2, 2)]
1 0 2 2
end of block
..fin_rat2 5 2
..fin_rat2 0 0
..fin_rat2 1 0
normal termination
第２の方法では左右両辺の型が t_rat2 の場合のみに代入演算子の上書きが有効で、基底クラス t_base を t_rat2 で allocate した場合には、型の組み合わせが一致しないため、普通の代入が行われ分母チェックはなされません。
また、第２の方法では、static に確保された実引数と、allocatable な実引数の区別がつかないので、実行時に区別する必要があります。
まとめ
assignment 演算子の上書きによる方法は、コンストラクタの代わりにはなりえないと思われますが便利な性質もあるので、どうしても重たい一時オブジェクトを作りたくない時などに利用できるかもしれません。