Consider one of the classic OOP examples (see source code at the end of the post):
Abstract base class Shape
Class Rectangle extending Shape
Questions:
In the source code below I've tried to define a constructor for the abstract class Shape using class(Shape), pointer :: this as result without ever allocating the pointer. Is this the correct way of defining a constructor for an abstract class in Fortran?
How can I invoke the constructor of the base class (Shape) in the constructor of the extending class (Rectangle)?
Example Source Code
Updated with suggestion from Ed Smith which works for non-abstract base classes.
module Shape_mod
implicit none
private
public Shape
type, abstract :: Shape
private
double precision :: centerPoint(2)
contains
procedure :: getCenterPoint
procedure(getArea), deferred :: getArea
end type Shape
interface Shape
module procedure constructor
end interface Shape
abstract interface
function getArea(this) result(area)
import
class(Shape), intent(in) :: this
double precision :: area
end function getArea
end interface
contains
!Correct way of defining a constructor for an abstract class?
function constructor(xCenter, yCenter) result(this)
class(Shape), pointer :: this
double precision, intent(in) :: xCenter
double precision, intent(in) :: yCenter
print *, "constructing base shape"
this%centerPoint = [xCenter, yCenter]
end function constructor
function getCenterPoint(this) result(point)
class(Shape), intent(in) :: this
double precision point(2)
point = this%centerPoint
end function getCenterPoint
end module Shape_mod
module Rectangle_mod
use Shape_mod
implicit none
private
public Rectangle
type, extends(Shape) :: Rectangle
private
double precision :: length
double precision :: width
contains
procedure :: getArea
end type Rectangle
interface Rectangle
module procedure constructor
end interface Rectangle
contains
function constructor(length, width, xCenter, yCenter) result(this)
type(Rectangle), pointer :: this
double precision :: length
double precision :: width
double precision :: xCenter
double precision :: yCenter
print *, "Constructing rectangle"
allocate(this)
this%length = length
this%width = width
!How to invoke the base class constructor here?
!The line below works for non-abstract base classes where the
!constructor result can be type(Shape)
this%Shape = Shape(xCenter, yCenter)
end function constructor
function getArea(this) result(area)
class(Rectangle), intent(in) :: this
double precision :: area
area = this%length * this%width
end function getArea
end module Rectangle_mod
program main
use Rectangle_mod
implicit none
type(Rectangle) :: r
r = Rectangle(4.0d0, 3.0d0, 0.0d0, 2.0d0)
print *, "Rectangle with center point", r%getCenterPoint(), " has area ", r%getArea()
end program main
This program gives the following output:
Constructing rectangle
Rectangle with center point 6.9194863361077724E-310 6.9194863361077724E-310 has area 12.000000000000000
Since the base class constructor haven't been invoked the centerPoint variable isn't initalized. In this simple example the variable could be initialized manually from the Rectangle constructor, but for more complex cases this might lead to significant duplication of code.
This is a good question and I hope someone with more experience of oop in fortran can give a better answer. For your first question, you shouldn't need a pointer, instead you can define the constructor as,
type(Shape) function constructor(xCenter, yCenter)
double precision, intent(in) :: xCenter
double precision, intent(in) :: yCenter
print *, "constructing base shape"
constructor%centerPoint = [xCenter, yCenter]
end function constructor
For your second question, the answer should be to call the parent in the rectangle constructor with the line constructor%Shape = Shape(xCenter, yCenter) in the rectangle constructor function.
type(Rectangle) function constructor(length, width, xCenter, yCenter)
type(Rectangle), pointer :: this
double precision, intent(in) :: xCenter
double precision, intent(in) :: yCenter
double precision, intent(in) :: length
double precision, intent(in) :: width
print *, "Constructing rectangle"
!invoke the base class constructor here
constructor%Shape_ = Shape(xCenter, yCenter)
constructor%length = length
constructor%width = width
end function constructor
I cannot get this to work with the intel compiler v13.0.1. It returns the error: If the rightmost part-name is of abstract type, data-ref shall be polymorphic. As I understand it, the fortran 2008 standard should allow you to call the constructor of an abstract type if it is the parent of the current type. This may work in later compilers, check out this answer (and try for your case).
If not, as a minimal working solution of what you want, the solution I eventually used was to have an abstract shape class which defines the interface, and then define the constructor in the fist object which inherits this, here a shape type (similar to section 11.3.2 of this fortran oop example). The solution is as follows,
module shape_mod
type, abstract :: abstractshape
integer :: color
logical :: filled
integer :: x
integer :: y
end type abstractshape
interface abstractshape
module procedure initShape
end interface abstractshape
type, EXTENDS (abstractshape) :: shape
end type shape
type, EXTENDS (shape) :: rectangle
integer :: length
integer :: width
end type rectangle
interface rectangle
module procedure initRectangle
end interface rectangle
contains
! initialize shape objects
subroutine initShape(this, color, filled, x, y)
class(shape) :: this
integer :: color
logical :: filled
integer :: x
integer :: y
this%color = color
this%filled = filled
this%x = x
this%y = y
end subroutine initShape
! initialize rectangle objects
subroutine initRectangle(this, color, filled, x, y, length, width)
class(rectangle) :: this
integer :: color
logical :: filled
integer :: x
integer :: y
integer, optional :: length
integer, optional :: width
this%shape = shape(color, filled, x, y)
if (present(length)) then
this%length = length
else
this%length = 0
endif
if (present(width)) then
this%width = width
else
this%width = 0
endif
end subroutine initRectangle
end module shape_mod
program test_oop
use shape_mod
implicit none
! declare an instance of rectangle
type(rectangle) :: rect
! calls initRectangle
rect = rectangle(2, .false., 100, 200, 11, 22)
print*, rect%color, rect%filled, rect%x, rect%y, rect%length, rect%width
end program test_oop
Sorry, the notation is slightly different from your example but hopefully this will help...
The "constructor" concept that you are looking for is best achieved by having an "initialise" subroutine that takes a an INTENT([IN] OUT) polymorphic argument with declared type of the abstract parent, as shown in the second part of Ed Smith's answer.
As conceptual background - you cannot create values in Fortran that are of abstract type (that would defeat the meaning of ABSTRACT), but that is exactly what you are trying to do with your constructor function for the parent.
(There is a difference here in creating a value, and then storing that value in some other object. A value of non-abstract type might be stored in a polymorphic object that has a declared type that is abstract and that is a parent type of the type of the value.)
Related
I am still wrapping my head around Fortran with an "object oriented" flavor.
Is it possible to initialize a variable in a derived type, and what if I'd like that variable to be a parameter?
For example, a classic animal, cat, bee set of types that should set the number of legs of each animal:
animal module
module animal_module
implicit none
type, abstract :: animal
private
integer, public :: nlegs = -1
contains
...
cat module
module cat_module
use animal_module, only : animal
implicit none
type, extends(animal) :: cat
private
! error here about redefining nlegs...
integer, public :: nlegs = 4
...
I've found online the keyword initial, but my compiler (Intel) complains about the keyword with a syntax error.
Addendum
I've tried a custom constructor but apparently I am unable to write one for derived types. This is my attempt, only on the cat type:
module cat_module
use animal_module, only : animal
implicit none
type, extends(animal) :: cat
private
real :: hidden = 23.
contains
procedure :: setlegs => setlegs
procedure :: speak
end type cat
interface cat
module procedure init_cat
end interface cat
contains
type(cat) function init_cat(this)
class(cat), intent(inout) :: this
this%nlegs = -4
end function init_cat
...
program oo
use animal_module
use cat_module
use bee_module
implicit none
character(len = 3) :: what = "cat"
class(animal), allocatable :: q
select case(what)
case("cat")
print *, "you will see a cat"
allocate(cat :: q)
...
print *, "this animal has ", q%legs(), " legs."
As the animal type has integer, public :: nlegs = -1, I expected the cat to have -4 legs, but alas, it's still -1.
It is not possible for a component to be a named constant. Also, it isn't possible to declare a component of an abstract type and then define default initialization for its value in an extending type. Attempting to redeclare the component with default initialization leads to the error of the question.
High Performance Mark's comment offers one route: provide a custom constructor for each extending type setting the value appropriately. You can further set the component to private for encapsulation or protection.
Alternatively, you can provide a "getter" type-bound procedure which references a named constant:
module animal_module
implicit none
type, abstract :: animal
contains
procedure(getter), deferred :: nlegs
end type animal
abstract interface
integer function getter(creature)
import animal
class(animal) creature
end function getter
end interface
end module animal_module
module cat_module
use animal_module, only : animal
implicit none
type, extends(animal) :: cat
contains
procedure :: nlegs => nlegs_cat
end type cat
contains
integer function nlegs_cat(creature)
class(cat) creature
integer, parameter :: my_cat_has_legs=3
nlegs_cat = my_cat_has_legs
end function nlegs_cat
end module cat_module
use cat_module
implicit none
class(animal), allocatable :: fido
fido = cat()
print*, "Fido has", fido%nlegs(), "legs"
end
Finally, initial is not standard Fortran (and would have similar problems).
I have a code with lots of different features and methods. Some methods are all for the same feature, i.e. only one among a selection can be selected.
Furthermore, depending on a feature I might need to do modify subroutines elsewhere. So in a loop in routine inject I might have a small if statement asking if I have used feature A, then do a few extra operations.
This is very frustating since different features seems to be connected with others routines very arbirarirly, and can be difficult to maintain.
I have decided to do following to avoid this:
I define an object t_inject with the purpose to execture routine inject. I rewrite my routine inject such that it contains only the code that is common for all different scenarios.
type t_inject
contains
procedure,nopass :: inject => inject_default
end type
Now I have another object to handle my feature A in case it is selected.
type,extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
end type
My subroutines inject_a and inject have same interface. E.g.
subroutine inject_a( part )
type(t_part) , intent(inout) :: part % an external data type
call inject(part)
! do the extra bit of stuff you need to do
end subroutine
subroutine inject( part)
type(t_part) , intent(inout) :: part % an external data type
! carry out the default stuff
end subroutine
Now in my main program
class(t_inject) :: inj
allocate(inj :: t_inject_a)
call inj% inject ( part)
Is that the way you would do it and is it valid?
I initially thought of doing an abstract declared type with a deferred inject procedure where I then could extent.
But for a very trivial problem I might not need that - I am also wondering whether my call call inj% inject(part) is sufficient for the compiler to know to where to go. Sometimes I see codes which need the class is condition before making the call.
I think three points should be modified:
The type-bound procedures need to refer to actual procedure names (via =>). So, I have changed the name of a module procedure inject() to inject_default(). (But please see test2.f90 also).
We need to attach allocatable to a class variable (e.g., inj2) to allocate it with a concrete type (e.g., t_inject_a).
In the allocate statement, the name of a concrete type should appear before ::, such that allocate( t_inject_a :: inj2 ).
The modified code may look like this:
!! test.f90
module test_mod
implicit none
type t_inject
contains
procedure, nopass :: inject => inject_default
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject_default( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
endsubroutine
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject_default( part )
print *, "y = ", part % y
endsubroutine
end
program main
use test_mod
implicit none
class( t_inject ), allocatable :: inj1, inj2
type( t_part ) :: part
!! Polymorphic allocation with concrete types.
allocate( t_inject :: inj1 )
allocate( t_inject_a :: inj2 )
print *, "inj1:"
call inj1 % inject( part )
print *, "inj2:"
call inj2 % inject( part )
end
"gfortran-8 test.90 && ./a.out" gives
inj1:
x = 100
inj2:
x = 100
y = 200
We can also use a module procedure inject() (rather than inject_default()) by using procedure, nopass :: inject, for example:
!! test2.f90
module test_mod
implicit none
type t_inject
contains
procedure, nopass :: inject
! procedure, nopass :: inject => inject !! this also works
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
endsubroutine
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject( part )
print *, "y = ", part % y
endsubroutine
end
!! The remaining part (and the result) is the same...
In addition, one can also separate actual procedures like inject() in a different file and use them to define new types like t_inject (see mylib.f90 and test3.f90 below). This might be useful to reuse routines in some library file.
!! mylib.f90
module mylib
implicit none
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
end
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject( part )
print *, "y = ", part % y
end
end
!! test3.f90
module test_mod
use mylib
implicit none
type t_inject
contains
procedure, nopass :: inject
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
end
!! The main program is the same as test.f90.
!! compile: gfortran-8 mylib.f90 test3.f90
I am trying to make a data tree structure with features that mimic the linked list kind of thing using polymorphism in Fortran. Each box or object has a pointer to its children and one to its parent, both pointers of same object type. Because I thought of a having a reference to the root of data tree structure I initially define a declared type as follows:
type r_oct
integer :: max_depth
class(*), pointer :: root
end type
Then, I extends this to another type which contains the main attributes of this data structure
type, extends(r_oct) :: element_oct
rea :: pts
type(element_oct), pointer :: parent
type(element_oct), pointer :: children(:)
end type
Now I wanted to have two different constructors so I declare following
interface r_oct
module procedure :: INIT_r_oct
module procedure :: INIT_element_oct
end interface r_oct
In my function INIT_r_oct I simply have
function INIT_r_oct( max_depth ) result( oct )
implicit none
class(r_oct), pointer :: oct
integer, intent(in) :: max_depth
if( associated(oct) )then
print*, "ERROR, called more than once"
stop
else
allocate(oct)
nullify(oct% root)
oct% max_depth = max_depth
endif
end function INIT_r_oct
Everything sofar is good. But now the following function is where I got the problems.
The Idea is that I want to keep the root pointer pointing to the first instance of the parent pointer of the child object, namely, element_oct :: parent
function INIT_element_oct (this, pts ) result( ele_oct )
class(r_oct), pointer, intent(inout) :: this
real, intent(in) :: pts
type(element_oct), pointer :: ele_oct
allocate(ele_oct)
this%root => ele_oct
this%root%parent%pts = 1 ! this does not work
end function INIT_element_oct
It complains that the this%root does not have the parent attribute, as if it does not do what I intend this%root => ele_oct
I am bit new to this way of programming in Fortran, So I am guessing that something is not fully understood by myself, I hope you can come up with some better suggestions to what i am trying to do.
UPDATE
So it seems that select type might help me out.
In function INIT_element_oct I do this instead:
function INIT_element_oct (this, pts ) result( ele_oct )
class(r_oct), pointer, intent(inout) :: this
real, intent(in) :: pts
type(element_oct), pointer :: ele_oct
allocate(ele_oct)
this%root => ele_oct
select type ( aux => this% root)
type is (element_oct)
aux = ele_oct%parent ! this now works!!!
end select
end function INIT_element_oct
But is this%root now really pointing to ele_oct%parent?, i.e. if you later on want the pointer to the very first element, can I use the root pointer to get, because it seems like this is a temporary pointing to it.
Is there a way to use the deferred type to solve this
Calling from Main program
program TEST_OCT
use mod_oct
implicit none
class(r_oct), pointer :: first
class(element_oct), pointer :: octree
integer :: i,j, max_d
max_d = 10
first => r_oct(max_num_point)
oct => r_oct(first, 1.0)
Given the minimal working example below, I would like to modify it to avoid copy/pasting the calls of
call func_some_calc1(par)
call func_some_calc2(par)
in both main_func_problem1 and main_func_problem2.
Ideally I want to have one function main_func that is behaving differently for input parameters of type t_parameters_problem1 and t_parameters_problem2. I could declare its par parameter of base type class(t_parameters_base), but then having a switch inside that function depending on the actual argument type (using select type) is architecturally not good.
To solve this I tried to create a procedure in type t_parameters_base, which is calling those routines, to implement something like this (C++ syntax):
class t_parameters_base {
virtual void main_func() {
func_some_calc1(this)
func_some_calc2(this)
}
}
class t_parameters_problem1: public t_parameters_base {
virtual void main_func() {
t_parameters_base::main_func();
func_some_calc3_problem1(this);
}
}
But the problem is that those routines are using an input parameter of this type, which leads to circular dependency. How is it possible to solve this problem?
Update: Note that I really want to keep the implementation of func_some_calc1 and func_some_calc2 in different files (modulus/classes) as they implement very different logic using some private functions from their classes.
module parameters_base
type, public :: t_parameters_base
integer :: n
end type t_parameters_base
end module parameters_base
module parameters_problem1
use parameters_base
implicit none
type, extends(t_parameters_base), public :: t_parameters_problem1
integer :: p1
end type t_parameters_problem1
end module parameters_problem1
module parameters_problem2
use parameters_base
implicit none
type, extends(t_parameters_base), public :: t_parameters_problem2
integer :: p2
end type t_parameters_problem2
end module parameters_problem2
module some_calc1
use parameters_base
implicit none
contains
subroutine func_some_calc1(par)
class(t_parameters_base) :: par
end subroutine func_some_calc1
end module some_calc1
module some_calc2
use parameters_base
implicit none
contains
subroutine func_some_calc2(par)
class(t_parameters_base) :: par
end subroutine func_some_calc2
end module some_calc2
module some_calc3_problem1
use parameters_problem1
implicit none
contains
subroutine func_some_calc3_problem1(par)
type(t_parameters_problem1) :: par
print*, par%p1
end subroutine func_some_calc3_problem1
end module some_calc3_problem1
module some_calc3_problem2
use parameters_problem2
implicit none
contains
subroutine func_some_calc3_problem2(par)
type(t_parameters_problem2) :: par
print*, par%p2
end subroutine func_some_calc3_problem2
end module some_calc3_problem2
module main_problem1
use parameters_problem1
use some_calc1
use some_calc2
use some_calc3_problem1
implicit none
contains
subroutine main_func_problem1(par)
type(t_parameters_problem1) :: par
call func_some_calc1(par)
call func_some_calc2(par)
call func_some_calc3_problem1(par)
end subroutine main_func_problem1
end module main_problem1
module main_problem2
use parameters_problem2
use some_calc1
use some_calc2
use some_calc3_problem2
implicit none
contains
subroutine main_func_problem2(par)
type(t_parameters_problem2) :: par
call func_some_calc1(par)
call func_some_calc2(par)
call func_some_calc3_problem2(par)
end subroutine main_func_problem2
end module main_problem2
program module_test
use parameters_problem1
use parameters_problem2
use main_problem1
use main_problem2
implicit none
type(t_parameters_problem1) :: par1
type(t_parameters_problem2) :: par2
par1%p1 = 1
par2%p2 = 2
call main_func_problem1(par1)
call main_func_problem2(par2)
end program module_test
I think, what you are aiming for are polymorphic types with type bound procedures. Below you find a working example. To keep it simple, I do not have added any data to the types, but of course, that can be easily done. The routine invokeCalc12 is only defined in the base type, but can be invoked from the derived types, and as in Fortran all methods are virtual, it will call the right methods.
module calc_base
implicit none
type, abstract :: CalcBase
contains
procedure(calcInterface), deferred :: calc1
procedure(calcInterface), deferred :: calc2
procedure :: invokeCalc12
end type CalcBase
interface
subroutine calcInterface(self, ii)
import :: CalcBase
class(CalcBase), intent(inout) :: self
integer, intent(in) :: ii
end subroutine calcInterface
end interface
contains
subroutine invokeCalc12(self, ii)
class(CalcBase), intent(inout) :: self
integer, intent(in) :: ii
call self%calc1(ii)
call self%calc2(ii)
end subroutine invokeCalc12
end module calc_base
module some_calc
use calc_base
implicit none
type, extends(CalcBase) :: SomeCalc
contains
procedure :: calc1
procedure :: calc2
procedure :: calc3
end type SomeCalc
contains
subroutine calc1(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
print *, "SomeCalc1:calc1", ii
end subroutine calc1
subroutine calc2(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
print *, "SomeCalc1:calc2", ii
end subroutine calc2
subroutine calc3(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
call self%%invokeCalc12(ii)
end subroutine calc3
end module some_calc
program test
use some_calc
implicit none
type(SomeCalc) :: mySimulation
call mySimulation%calc3(42)
end program test
Note: I've seen that similar question has been posted at comp.lang.fortran, but at the moment I did not find a working example there, therefore the posting here.
Is there a way to overload the = operator so that you can write an assignment like in this example:
module constants_mod
integer,parameter :: dpn = selected_real_kind(14)
end module
module vectorField_mod
use constants_mod
implicit none
private
public :: vectorField
public :: allocateX,allocateY,allocateZ
public :: delete
! public :: operator(=)
type vectorField
integer,dimension(3) :: sx,sy,sz
real(dpn),dimension(:,:,:),allocatable :: x,y,z
end type
interface delete
module procedure deallocateVectorField
end interface
! interface operator (=)
! module procedure vectorAssign
! end interface
contains
! function vectorAssign(f) result(q)
! implicit none
! real(dpn),intent(in) :: f
! type(vectorField) :: q
! q%x = f; q%y = f; q%z = f
! end function
! subroutine vectorAssign(f,g)
! implicit none
! type(vectorField),intent(inout) :: f
! real(dpn),intent(in) :: g
! f%x = g; f%y = g; f%z = g
! end subroutine
subroutine allocateX(field,Nx,Ny,Nz)
implicit none
type(vectorField),intent(inout) :: field
integer,intent(in) :: Nx,Ny,Nz
if (allocated(field%x)) deallocate(field%x)
allocate(field%x(Nx,Ny,Nz))
field%sx = shape(field%x)
end subroutine
subroutine allocateY(field,Nx,Ny,Nz)
implicit none
type(vectorField),intent(inout) :: field
integer,intent(in) :: Nx,Ny,Nz
if (allocated(field%y)) deallocate(field%y)
allocate(field%y(Nx,Ny,Nz))
field%sy = shape(field%y)
end subroutine
subroutine allocateZ(field,Nx,Ny,Nz)
implicit none
type(vectorField),intent(inout) :: field
integer,intent(in) :: Nx,Ny,Nz
if (allocated(field%z)) deallocate(field%z)
allocate(field%z(Nx,Ny,Nz))
field%sz = shape(field%z)
end subroutine
subroutine deallocateVectorField(field)
implicit none
type(vectorField),intent(inout) :: field
deallocate(field%x,field%y,field%z)
field%sx = 0; field%sy = 0; field%sz = 0
end subroutine
end module
program test
use constants_mod
use vectorField_mod
implicit none
type(vectorField) :: a
integer :: N = 1
real(dpn) :: dt = 0.1
call allocateX(a,N,N,N)
call allocateY(a,N,N,N)
call allocateZ(a,N,N,N)
a%x = dble(1.0) ! want to avoid this
a%y = dble(1.0) ! want to avoid this
a%z = dble(1.0) ! want to avoid this
a = real(1.0,dpn) ! want this instead (does not compile)
call delete(a)
end program
I've tried two different ways (shown in comments) but I get errors saying that there is a syntax error in generic specification (for publicizing the = operator).
= is not an operator, it is an assignment in Fortran and they are very different beasts.
To the classical possibility found in Fortran 90 and explained well in other answers, Fortran 2003 added a better possibility to bind the overloaded operators and assignments with the derived type.
This way you are sure you will not import the type without the assignment (beware of public and private statement in this case!). It can have very unpleasant consequences and can be hard to debug:
type vectorField
integer,dimension(3) :: sx,sy,sz
real(dpn),dimension(:,:,:),allocatable :: x,y,z
contains
procedure :: assignVector
generic :: assignment(=) => assignVector
end type
This way you do not have to be that careful to not forget the public :: assignment (=)
For defined assignment operator(=) is not correct, but assignment(=) is: see Fortran 2008 12.4.3.4.3. So you instead want the two lumps
public :: assignment (=)
and
interface assignment (=)
module procedure vectorAssign
end interface
Note that the correct way to define the assignment is by the subroutine as you have it (although the assignee could have intent(out) instead of intent(inout)).
Yes, you can overload the assignment operator. The syntax and requirements are different for the assignment operator than for other operators because the semantics are fundamentally different: all other operators compute a new value based on one or two arguments, without changing the arguments, whereas assignment changes the value of the left-hand argument.
In your case, I think it should look like this:
module vectorField_mod
! ...
interface assignment (=)
module procedure vectorAssign
end interface
contains
! ...
subroutine vectorAssign(f,g)
implicit none
type(vectorField),intent(out) :: f
real(kind = dpn), intent(in) :: g
f%x = g
f%y = g
f%z = g
end subroutine vectorAssign
end module vectorField_mod