treeValue.f90 Source File

This File Depends On

sourcefile~~treevalue.f90~~EfferentGraph sourcefile~treevalue.f90 treeValue.f90 sourcefile~node.f90 node.f90 sourcefile~node.f90->sourcefile~treevalue.f90 sourcefile~kinds.f90 kinds.f90 sourcefile~kinds.f90->sourcefile~treevalue.f90 sourcefile~kinds.f90->sourcefile~node.f90 sourcefile~text.f90 text.f90 sourcefile~kinds.f90->sourcefile~text.f90 sourcefile~time.f90 time.f90 sourcefile~kinds.f90->sourcefile~time.f90 sourcefile~text.f90->sourcefile~node.f90 sourcefile~time.f90->sourcefile~text.f90
Help

Files Dependent On This One

sourcefile~~treevalue.f90~~AfferentGraph sourcefile~treevalue.f90 treeValue.f90 sourcefile~expression.f90 expression.f90 sourcefile~treevalue.f90->sourcefile~expression.f90 sourcefile~testexpression.f90 testExpression.f90 sourcefile~expression.f90->sourcefile~testexpression.f90
Help

Source Code


Source Code

module treeValue_mod
	use kinds_mod
	use node_mod
	implicit none
	
	!========================================!
	!= Evaluation Tree Types and Interfaces =!
	!========================================!
	
	! real_t
	type,extends(node_t)::real_t
		real(wp)::value
	contains
		procedure::evalR => evalR_real
		procedure::evalZ => evalZ_real
	end type
	
	interface real_t
		module procedure newReal
	end interface
	
	! imag_t
	type,extends(node_t)::imag_t
		real(wp)::value
	contains
		procedure::evalR => evalR_imag
		procedure::evalZ => evalZ_imag
	end type
	
	interface imag_t
		module procedure newImag
	end interface
	
	! var_t
	type,extends(node_t)::var_t
		integer::idx
	contains
		procedure::evalR => evalR_var
		procedure::evalZ => evalZ_var
	end type
	
	interface var_t
		module procedure newVar
	end interface

contains

	!============================!
	!= Evaluation Tree Routines =!
	!============================!

	! real_t
	function newReal(value) result(self)
		real(wp),intent(in)::value
		type(real_t)::self
		
		self%value = value
	end function newReal

	function evalR_real(self,args) result(o)
		class(real_t),intent(in)::self
		real(wp),dimension(:),intent(in)::args
		real(wp)::o
		
		o = self%value
	end function evalR_real

	function evalZ_real(self,args) result(o)
		class(real_t),intent(in)::self
		complex(wp),dimension(:),intent(in)::args
		complex(wp)::o
		
		o = self%value
	end function evalZ_real

	! imag_t
	function newImag(value) result(self)
		real(wp),intent(in)::value
		type(imag_t)::self
		
		self%value = value
	end function newImag

	function evalR_imag(self,args) result(o)
		class(imag_t),intent(in)::self
		real(wp),dimension(:),intent(in)::args
		real(wp)::o
		
		stop 'Imaginary number encountered in real evaluation'
	end function evalR_imag

	function evalZ_imag(self,args) result(o)
		class(imag_t),intent(in)::self
		complex(wp),dimension(:),intent(in)::args
		complex(wp)::o
		
		o = self%value
	end function evalZ_imag

	! var_t
	function newVar(idx) result(self)
		integer,intent(in)::idx
		type(var_t)::self
		
		self%idx = idx
	end function newVar

	function evalR_var(self,args) result(o)
		class(var_t),intent(in)::self
		real(wp),dimension(:),intent(in)::args
		real(wp)::o
		
		integer::N
		
		N = size(args)
		
		if(self%idx>N) then
			write(*,*) 'Invalid argument index: '//intToChar(self%idx)
			stop 'Error in eval_var'
		end if
		
		o = args(self%idx)
	end function evalR_var

	function evalZ_var(self,args) result(o)
		class(var_t),intent(in)::self
		complex(wp),dimension(:),intent(in)::args
		complex(wp)::o
		
		integer::N
		
		N = size(args)
		
		if(self%idx>N) then
			write(*,*) 'Invalid argument index: '//intToChar(self%idx)
			stop 'Error in eval_var'
		end if
		
		o = args(self%idx)
	end function evalZ_var

end module treeValue_mod