Oop 在具有派生类型的Fortran中，具有多个加法器的运算符（+；）的定义。可分配数组的一个问题
我试图在描述矩阵的Fortran派生类型（线性运算符）之间定义（+）运算符。 我的目标是隐式定义一个矩阵M=M1+M2+M3，这样，给定一个向量x，Mx=M1x+M2x+M3x 首先，我定义了一个抽象类型（abs_linop），它带有矩阵向量乘法（y=M*x）的抽象接口。 然后，我构建了一个派生类型（add_linop），扩展了抽象类型（abs_linop）。 运算符（+）是为类型定义的（add_linop）。然后，我创建了一个具体类型（eye）的示例，扩展了描述身份矩阵的抽象类型（abs_linop）。此类型在主程序中使用。这是源代码Oop 在具有派生类型的Fortran中，具有多个加法器的运算符（+；）的定义。可分配数组的一个问题,oop,fortran,operator-overloading,gfortran,derived-types,Oop,Fortran,Operator Overloading,Gfortran,Derived Types,我试图在描述矩阵的Fortran派生类型（线性运算符）之间定义（+）运算符。 我的目标是隐式定义一个矩阵M=M1+M2+M3，这样，给定一个向量x，Mx=M1x+M2x+M3x 首先，我定义了一个抽象类型（abs_linop），它带有矩阵向量乘法（y=M*x）的抽象接口。 然后，我构建了一个派生类型（add_linop），扩展了抽象类型（abs_linop）。 运算符（+）是为类型定义的（add_linop）。然后，我创建了一个具体类型（eye）的示例，扩展了描述身份矩阵的抽象类型（abs_li
module LinearOperator
implicit none
private
public :: abs_linop,multiplication
type, abstract :: abs_linop
integer :: nrow=0
integer :: ncol=0
character(len=20) :: name='empty'
contains
!> Procedure for computation of (matrix) times (vector)
procedure(multiplication), deferred :: Mxv
end type abs_linop
abstract interface
!>-------------------------------------------------------------
!> Abstract procedure defining the interface for a general
!<-------------------------------------------------------------
subroutine multiplication(this,vec_in,vec_out,info,lun_err)
import abs_linop
implicit none
class(abs_linop), intent(inout) :: this
real(kind=8), intent(in ) :: vec_in(this%ncol)
real(kind=8), intent(inout) :: vec_out(this%nrow)
integer, optional, intent(inout) :: info
integer, optional, intent(in ) :: lun_err
end subroutine multiplication
end interface
!>---------------------------------------------------------
!> Structure variable for Identity matrix
!> (rectangular case included)
!>---------------------------------------------------------
type, extends(abs_linop), public :: eye
contains
!> Static constructor
procedure, public, pass :: init => init_eye
!> Compute matrix times vector operatoration
procedure, public, pass :: Mxv => apply_eye
end type eye
!>----------------------------------------------------------------
!> Structure variable to build implicit matrix defined
!> as composition and sum of linear operator
!>----------------------------------------------------------------
public :: add_linop, operator(+)
type, extends(abs_linop) :: add_linop
class(abs_linop) , pointer :: matrix_1
class(abs_linop) , pointer :: matrix_2
real(kind=8), allocatable :: scr(:)
contains
procedure, public , pass:: Mxv => add_Mxv
end type add_linop
INTERFACE OPERATOR (+)
module PROCEDURE mmsum
END INTERFACE OPERATOR (+)
contains
!>------------------------------------------------------
!> Function that give two linear operator A1 and A2
!> defines, implicitely, the linear operator
!> A=A1+A2
!> (public procedure for class add_linop)
!>
!> usage:
!> 'var' = A1 + A2
!<-------------------------------------------------------------
function mmsum(matrix_1,matrix_2) result(this)
implicit none
class(abs_linop), target, intent(in) :: matrix_1
class(abs_linop), target, intent(in) :: matrix_2
type(add_linop) :: this
! local
integer :: res
character(len=20) :: n1,n2
if (matrix_1%nrow .ne. matrix_2%nrow) &
write(*,*) 'Error mmproc dimension must agree '
if (matrix_1%ncol .ne. matrix_2%ncol) &
write(*,*) 'Error mmproc dimension must agree '
this%matrix_1 => matrix_1
this%matrix_2 => matrix_2
this%nrow = matrix_1%nrow
this%ncol = matrix_2%ncol
this%name=etb(matrix_1%name)//'+'//etb(matrix_2%name)
write(*,*) 'Sum Matrix initialization '
write(*,*) 'M1 : ',this%matrix_1%name
write(*,*) 'M2 : ',this%matrix_2%name
write(*,*) 'sum : ',this%name
allocate(this%scr(this%nrow),stat=res)
contains
function etb(strIn) result(strOut)
implicit none
! vars
character(len=*), intent(in) :: strIn
character(len=len_trim(adjustl(strIn))) :: strOut
strOut=trim(adjustl(strIn))
end function etb
end function mmsum
recursive subroutine add_Mxv(this,vec_in,vec_out,info,lun_err)
implicit none
class(add_linop), intent(inout) :: this
real(kind=8), intent(in ) :: vec_in(this%ncol)
real(kind=8), intent(inout) :: vec_out(this%nrow)
integer, optional, intent(inout) :: info
integer, optional, intent(in ) :: lun_err
write(*,*) 'Matrix vector multipliction',&
'matrix:',this%name,&
'M1: ',this%matrix_1%name,&
'M2: ',this%matrix_2%name
select type (mat=>this%matrix_1)
type is (add_linop)
write(*,*) 'is allocated(mat%scr) ?', allocated(mat%scr)
end select
call this%matrix_1%Mxv(vec_in,this%scr,info=info,lun_err=lun_err)
call this%matrix_2%Mxv(vec_in,vec_out,info=info,lun_err=lun_err)
vec_out = this%scr + vec_out
end subroutine add_Mxv
subroutine init_eye(this,nrow)
implicit none
class(eye), intent(inout) :: this
integer, intent(in ) :: nrow
this%nrow = nrow
this%ncol = nrow
end subroutine init_eye
subroutine apply_eye(this,vec_in,vec_out,info,lun_err)
class(eye), intent(inout) :: this
real(kind=8), intent(in ) :: vec_in(this%ncol)
real(kind=8), intent(inout) :: vec_out(this%nrow)
integer, optional, intent(inout) :: info
integer, optional, intent(in ) :: lun_err
! local
integer :: mindim
vec_out = vec_in
if (present(info)) info=0
end subroutine apply_eye
end module LinearOperator
program main
use LinearOperator
implicit none
real(kind=8) :: x(2),y(2),z(2),t(2)
type(eye) :: id1,id2,id3
type(add_linop) :: sum12,sum23,sum123_ok,sum123_ko
integer :: i
call id1%init(2)
id1%name='I1'
call id2%init(2)
id2%name='I2'
call id3%init(2)
id3%name='I3'
x=1.0d0
y=1.0d0
z=1.0d0
write(*,*) ' Vector x =', x
call id1%Mxv(x,t)
write(*,*) ' Vector t = I1 *x', t
write(*,*) ' '
sum12 = id1 + id2
call sum12%Mxv(x,t)
write(*,*) ' Vector t = (I1 +I2) *x', t
write(*,*) ' '
sum23 = id2 + id3
sum123_ok = id1 + sum23
call sum123_ok%Mxv(x,t)
write(*,*) ' Vector t = ( I1 + (I2 + I3) )*x', t
write(*,*) ' '
sum123_ko = id1 + id2 + id3
call sum123_ko%Mxv(x,t)
write(*,*) ' Vector t = ( I1 +I2 + I3) *x', t
end program main
模块线性化器
隐式无
私有的
公共：：abs_linop，乘法
类型，抽象：：abs_linop
整数：：nrow=0
整数：：ncol=0
字符（len=20）：：name='empty'
包含
!> 计算（矩阵）时间（向量）的程序
过程（乘法），延迟：：Mxv
端型abs_linop
抽象接口
!>-------------------------------------------------------------
!> 定义通用接口的抽象过程
!---------------------------------------------------------
!> 单位矩阵的结构变量
!> （包括长方形箱子）
!>---------------------------------------------------------
类型，扩展（abs_linop），公共：：眼睛
包含
!> 静态构造函数
过程，公共，通过：：init=>init\u
!> 计算矩阵乘以向量运算
程序，公开，通过：：Mxv=>应用
端型眼
!>----------------------------------------------------------------
!> 结构变量来构建定义的隐式矩阵
!> 作为线性算子的合成和
!>----------------------------------------------------------------
public:：add_linop，运算符（+）
类型，扩展（abs\u linop）：：添加
类（abs_linop），指针：：矩阵1
类（abs_linop），指针：：矩阵2
实数（种类=8），可分配：：scr（：）
包含
过程，公共，通过：：Mxv=>add_Mxv
末端类型添加
接口运算符（+）
模块过程mmsum
结束接口运算符（+）
包含
!>------------------------------------------------------
!> 给出两个线性算子A1和A2的函数
!> 隐式定义线性运算符
!> A=A1+A2
!> （类添加的公共程序）
!>
!> 用法：
!> 'var'=A1+A2
! 矩阵_1
此%matrix_2=>matrix_2
此%nrow=矩阵_1%nrow
此%ncol=矩阵_2%ncol
此%name=etb（矩阵_1%name）//'+'//etb（矩阵_2%name）
写入（*，*）“和矩阵初始化”
写入（*，*）“M1:”，此%matrix_1%名称
写入（*，*）“M2:”，此%matrix_2%名称
写入（*，*）“总和：”，此%name
分配（此%scr（此%nrow），stat=res）
包含
功能etb（strIn）结果（strOut）
隐式无
! 瓦尔斯
字符（len=*），意图（in）：：strIn
字符（len=len_trim（adjustl（strIn））：：strOut
strOut=微调（调整（strIn））
端函数
端函数mmsum
递归子例程add_Mxv（this、vec_in、vec_out、info、lun_err）
隐式无
类（add_linop），意图（inout）：：此
真实（种类=8），意图（in）：：向量（此%ncol）
真实（种类=8），意图（输入）：：向量输出（此%n当前）
整数，可选，意图（输入输出）：：信息
整数，可选，意图（in）：：lun\u错误
写入（*，*）“矩阵向量乘法”&
“矩阵：”，此%name&
“M1:”，此%matrix_1%名称&
“M2:”，此%2%矩阵名称
选择类型（mat=>this%matrix_1）
类型为（添加linop）
写入（*，*）“已分配（物料%scr）？”，已分配（物料%scr）
结束选择
调用此%matrix\u 1%Mxv（vec\u-in，此%scr，info=info，lun\u-err=lun\u-err）
调用此%matrix\u 2%Mxv（向量输入，向量输出，信息=信息，lun\u错误=lun\u错误）
vec\u out=此%scr+vec\u out
结束子例程add_Mxv
子例程init_eye（this，nrow）
隐式无
类（眼睛），意图（输入）：这个
整数，意图（in）：：nrow
此%nrow=nrow
此%ncol=nrow
end子例程init_eye
子例程apply\u eye（this、vec\u in、vec\u out、info、lun\u err）
类（眼睛），意图（输入）：这个
真实（种类=8），意图（in）：：向量（此%ncol）
真实（种类=8），意图（输入）：：向量输出（此%n当前）
整数，可选，意图（输入输出）：：信息
整数，可选，意图（in）：：lun\u错误
! 地方的
整数：：mindim
向量输出=向量输入
如果（当前（信息））信息=0
结束子程序应用
端模线性振荡器
主程序
使用划线器
隐式无
实数（种类=8）：x（2），y（2），z（2），t（2）
类型（眼睛）：id1、id2、id3
类型（添加linop）：sum12、sum23、sum123\u正常、sum123\u高
整数：：i
调用id1%init（2）
id1%name='I1'
调用id2%init（2）
id2%name='I2'
呼叫id3%init（2）
id3%name='I3'
x=1.0d0
y=1.0d0
z=1.0d0
写入（*，*）‘向量x=’，x
呼叫id1%Mxv（x，t）
写入（*，*）'向量t=I1*x'，t
写（*，*）“”
sum12=id1+id2
调用sum12%Mxv（x，t）
写入（*，*）'向量t=（I1+I2）*x'，t
写（*，*）“”
sum23=id2+id3
sum123_ok=id1+sum23
呼叫sum123_ok%Mxv（x，t）
写入（*，*）'向量t=（I1+（I2+I3））*x'，t
写（*，*）“”
sum123_ko=id1+id2+id3
呼叫sum123_ko%Mxv（x，t）
写入（*，*）'向量t=（I1+I2+I3）*x'，t
主程序结束
#Gfortran compiler
FC = gfortran
OPENMP = -fopenmp
MODEL = -mcmodel=medium
OFLAGS = -O5 -ffree-line-length-none
DFLAGS = -g -C -Wall -fcheck=all -O -ffree-line-length-none
#DFLAGS = -g -C -Wall -ffree-line-length-none -fcheck=all
PFLAGS = -pg
CPPFLAGS = -D_GFORTRAN_COMP
ARFLAGS =
ODIR = objs
MDIR = mods
LDIR = libs
INCLUDE = -J$(MODDIR)
OBJDIR = $(CURDIR)/$(ODIR)
MODDIR = $(CURDIR)/$(MDIR)
LIBDIR = $(CURDIR)/$(LDIR)
INCLUDE += -I$(MODDIR)
FFLAGS = $(OFLAGS) $(MODEL) $(INCLUDE)
LIBSRCS =
DEST = .
EXTHDRS =
HDRS =
LIBS = -llapack -lblas
LIBMODS =
LDFLAGS = $(MODEL) $(INCLUDE) -L. -L/usr/lib -L/usr/local/lib -L$(LIBDIR)
LINKER = $(FC)
MAKEFILE = Makefile
PRINT = pr
CAT = cat
PROGRAM = main.out
SRCS = LinearOperator.f90
OBJS = LinearOperator.f90
PRJS= $(SRCS:jo=.prj)
OBJECTS = $(SRCS:%.f90=$(OBJDIR)/%.o)
MODULES = $(addprefix $(MODDIR)/,$(MODS))
.SUFFIXES: .prj .f90
print-% :
@echo $* = $($*)
.f.prj:
ftnchek -project -declare -noverbose $<
.f90.o:
$(FC) $(FFLAGS) $(INCLUDE) -c $<
all::
@make dirs
@make $(PROGRAM)
$(PROGRAM): $(LIBS) $(MODULES) $(OBJECTS)
$(LINKER) -o $(PROGRAM) $(LDFLAGS) $(OBJECTS) $(LIBS)
$(LIBS):
@set -e; for i in $(LIBSRCS); do cd $$i; $(MAKE) --no-print-directory -e CURDIR=$(CURDIR); cd $(CURDIR); done
$(OBJECTS): $(OBJDIR)/%.o: %.f90
$(FC) $(CPPFLAGS) $(FFLAGS) -o $@ -c $<
dirs:
@-mkdir -p $(OBJDIR) $(MODDIR) $(LIBDIR)
clean-emacs:
@-rm -f $(CURDIR)/*.*~
@-rm -f $(CURDIR)/*\#*
check: $(PRJS)
ftnchek -noverbose -declare $(PRJS) -project -noextern -library > $(PROGRAM).ftn
profile:; @make "FFLAGS=$(PFLAGS) $(MODEL) " "CFLAGS=$(PFLAGS) $(MODEL)" "LDFLAGS=$(PFLAGS) $(LDFLAGS)" $(PROGRAM)
debug:; @make "FFLAGS=$(DFLAGS) $(MODEL) $(INCLUDE)" "LDFLAGS=$(DFLAGS) $(LDFLAGS)" $(PROGRAM)
openmp:; @make "FFLAGS=$(OFLAGS) $(OPENMP) $(MODEL) $(INCLUDE)" "LDFLAGS=$(LDFLAGS) $(OPENMP)" $(PROGRAM)
clean:; @rm -f $(OBJECTS) $(MODULES) $(PROGRAM).cat $(PROGRAM).ftn
@set -e; for i in $(LIBSRCS); do cd $$i; $(MAKE) --no-print-directory clean; cd $(CURDIR); done
clobber:; @rm -f $(OBJECTS) $(MODULES) $(PROGRAM).cat $(PROGRAM).ftn $(PROGRAM)
@-rm -rf $(OBJDIR) $(MODDIR) $(LIBDIR)
@-rm -f $(CURDIR)/*.*~
@-rm -f $(CURDIR)/*\#*
.PHONY: mods
index:; ctags -wx $(HDRS) $(SRCS)
install: $(PROGRAM)
install -s $(PROGRAM) $(DEST)
print:; $(PRINT) $(HDRS) $(SRCS)
cat:; $(CAT) $(HDRS) $(SRCS) > $(PROGRAM).cat
program: $(PROGRAM)
profile: $(PROFILE)
tags: $(HDRS) $(SRCS); ctags $(HDRS) $(SRCS)
update: $(DEST)/$(PROGRAM)
main.o: linearoperator.mod
# DO NOT EDIT --- auto-generated file
linearoperator.mod : LinearOperator.f90
$(FC) $(FCFLAGS) -c $<