data_mediator_vec.F90 coverage: 100.00 %func 63.89 %block
1) module Data_Mediator_Vec_class
2)
3) use Data_Mediator_Base_class
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10) #include "petsc/finclude/petscvec.h"
11) #include "petsc/finclude/petscvec.h90"
12)
13) type, public, extends(data_mediator_base_type) :: data_mediator_vec_type
14) VecScatter :: scatter_ctx ! scatter context from vec to residual_vec
15) Vec :: vec
16) contains
17) procedure, public :: Update => DataMediatorVecUpdate
18) procedure, public :: Strip => DataMediatorVecStrip
19) end type data_mediator_vec_type
20)
21) public :: DataMediatorVecCreate
22)
23) contains
24)
25) ! ************************************************************************** !
26)
27) function DataMediatorVecCreate()
28) !
29) ! Creates a data mediator object
30) !
31) ! Author: Glenn Hammond
32) ! Date: 03/24/15
33) !
34)
35) implicit none
36)
37) class(data_mediator_vec_type), pointer :: DataMediatorVecCreate
38)
39) class(data_mediator_vec_type), pointer :: data_mediator
40)
41) allocate(data_mediator)
42) call DataMediatorBaseCreate(data_mediator)
43) data_mediator%vec = 0
44) data_mediator%scatter_ctx = 0
45) DataMediatorVecCreate => data_mediator
46)
47) end function DataMediatorVecCreate
48)
49) ! ************************************************************************** !
50)
51) recursive subroutine DataMediatorVecUpdate(this,data_mediator_vec,option)
52) !
53) ! Updates a data mediator object transfering data from
54) ! the buffer into the PETSc Vec
55) !
56) ! Author: Glenn Hammond
57) ! Date: 03/24/15
58) !
59)
60) use Option_module
61)
62) implicit none
63)
64) #include "petsc/finclude/petscvec.h"
65) #include "petsc/finclude/petscvec.h90"
66)
67) class(data_mediator_vec_type) :: this
68) Vec :: data_mediator_vec
69) type(option_type) :: option
70)
71) PetscErrorCode :: ierr
72)
73) call VecScatterBegin(this%scatter_ctx,this%vec, &
74) data_mediator_vec,ADD_VALUES, &
75) SCATTER_FORWARD,ierr);CHKERRQ(ierr)
76) call VecScatterEnd(this%scatter_ctx,this%vec, &
77) data_mediator_vec,ADD_VALUES, &
78) SCATTER_FORWARD,ierr);CHKERRQ(ierr)
79)
80) end subroutine DataMediatorVecUpdate
81)
82) ! ************************************************************************** !
83)
84) recursive subroutine DataMediatorVecStrip(this)
85) !
86) ! Destroys a data mediator object
87) !
88) ! Author: Glenn Hammond
89) ! Date: 03/24/15
90) !
91)
92) implicit none
93)
94) class(data_mediator_vec_type) :: this
95)
96) PetscErrorCode :: ierr
97)
98) ! update the next one
99) if (associated(this%next)) then
100) call this%next%Strip()
101) deallocate(this%next)
102) nullify(this%next)
103) endif
104)
105) ! Simply nullify the pointer as the dataset resides in a list to be
106) ! destroyed separately.
107) !nullify(data_mediator%dataset)
108) if (this%scatter_ctx /= 0) then
109) call VecScatterDestroy(this%scatter_ctx,ierr);CHKERRQ(ierr)
110) endif
111) if (this%vec /= 0) then
112) call VecDestroy(this%vec,ierr);CHKERRQ(ierr)
113) endif
114)
115) end subroutine DataMediatorVecStrip
116)
117) end module Data_Mediator_Vec_class