data_mediator_base.F90 coverage: 50.00 %func 68.18 %block
1) module Data_Mediator_Base_class
2)
3) use Dataset_Global_HDF5_class
4)
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12) #include "petsc/finclude/petscvec.h"
13) #include "petsc/finclude/petscvec.h90"
14)
15) type, public :: data_mediator_base_type
16) character(len=MAXWORDLENGTH) :: name
17) class(data_mediator_base_type), pointer :: next
18) contains
19) procedure, public :: AddToList => DataMediatorBaseAddToList
20) procedure, public :: Update => DataMediatorBaseUpdate
21) procedure, public :: Strip => DataMediatorBaseStrip
22) end type data_mediator_base_type
23)
24) public :: DataMediatorBaseCreate
25)
26) contains
27)
28) ! ************************************************************************** !
29)
30) subroutine DataMediatorBaseCreate(this)
31) !
32) ! Creates a data mediator object
33) !
34) ! Author: Glenn Hammond
35) ! Date: 03/23/15
36) !
37)
38) implicit none
39)
40) class(data_mediator_base_type) :: this
41)
42) ! Cannot allocate here. Allocation takes place in daughter class
43) this%name = ''
44) nullify(this%next)
45)
46) end subroutine DataMediatorBaseCreate
47)
48) ! ************************************************************************** !
49)
50) recursive subroutine DataMediatorBaseAddToList(this,list)
51) !
52) ! Adds a data mediator object to linked list
53) !
54) ! Author: Glenn Hammond
55) ! Date: 03/23/15
56) !
57)
58) implicit none
59)
60) class(data_mediator_base_type), target :: this
61) class(data_mediator_base_type), pointer :: list
62)
63) if (associated(list)) then
64) call this%AddToList(list%next)
65) else
66) list => this
67) endif
68)
69) end subroutine DataMediatorBaseAddToList
70)
71) ! ************************************************************************** !
72)
73) recursive subroutine DataMediatorBaseUpdate(this,data_mediator_vec,option)
74) !
75) ! Adds contribution of data mediator object to vector
76) !
77) ! Author: Glenn Hammond
78) ! Date: 03/23/15
79) !
80) use Option_module
81)
82) implicit none
83)
84) #include "petsc/finclude/petscvec.h"
85) #include "petsc/finclude/petscvec.h90"
86)
87) class(data_mediator_base_type) :: this
88) Vec :: data_mediator_vec
89) type(option_type) :: option
90) print *, 'Must extend DataMediatorBaseUpdate.'
91) stop
92)
93) end subroutine DataMediatorBaseUpdate
94)
95) ! ************************************************************************** !
96)
97) recursive subroutine DataMediatorBaseStrip(this)
98) !
99) ! Destroys a data mediator object
100) !
101) ! Author: Glenn Hammond
102) ! Date: 03/24/15
103) !
104)
105) implicit none
106)
107) class(data_mediator_base_type) :: this
108)
109) PetscErrorCode :: ierr
110)
111) end subroutine DataMediatorBaseStrip
112)
113) end module Data_Mediator_Base_class