debug.F90 coverage: 75.00 %func 22.83 %block
1) module Debug_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) type, public :: debug_type
12) PetscBool :: vecview_residual
13) PetscBool :: vecview_solution
14) PetscBool :: matview_Jacobian
15) PetscBool :: matview_Jacobian_detailed
16) PetscBool :: norm_Jacobian
17)
18) PetscBool :: binary_format
19)
20) PetscBool :: print_numerical_derivatives
21)
22) PetscBool :: print_couplers
23) character(len=MAXSTRINGLENGTH) :: coupler_string
24) PetscBool :: print_waypoints
25) end type debug_type
26)
27) public :: DebugCreate, DebugRead, DebugCreateViewer, DebugDestroy
28)
29) contains
30)
31) ! ************************************************************************** !
32)
33) function DebugCreate()
34) !
35) ! Create object that stores debugging options for PFLOW
36) !
37) ! Author: Glenn Hammond
38) ! Date: 12/21/07
39) !
40)
41) implicit none
42)
43) type(debug_type), pointer :: DebugCreate
44)
45) type(debug_type), pointer :: debug
46)
47) allocate(debug)
48)
49) debug%vecview_residual = PETSC_FALSE
50) debug%vecview_solution = PETSC_FALSE
51) debug%matview_Jacobian = PETSC_FALSE
52) debug%matview_Jacobian_detailed = PETSC_FALSE
53) debug%norm_Jacobian = PETSC_FALSE
54)
55) debug%binary_format = PETSC_FALSE
56)
57) debug%print_numerical_derivatives = PETSC_FALSE
58)
59) debug%print_couplers = PETSC_FALSE
60) debug%coupler_string = ''
61) debug%print_waypoints = PETSC_FALSE
62)
63) DebugCreate => debug
64)
65) end function DebugCreate
66)
67) ! ************************************************************************** !
68)
69) subroutine DebugRead(debug,input,option)
70) !
71) ! Reads debugging data from the input file
72) !
73) ! Author: Glenn Hammond
74) ! Date: 12/21/07
75) !
76)
77) use Option_module
78) use Input_Aux_module
79)
80) implicit none
81)
82) type(debug_type) :: debug
83) type(input_type), pointer :: input
84) type(option_type) :: option
85)
86) character(len=MAXWORDLENGTH) :: keyword
87)
88) input%ierr = 0
89) do
90)
91) call InputReadPflotranString(input,option)
92)
93) if (InputCheckExit(input,option)) exit
94)
95) call InputReadWord(input,option,keyword,PETSC_TRUE)
96) call InputErrorMsg(input,option,'keyword','DEBUG')
97)
98) select case(trim(keyword))
99)
100) case('PRINT_SOLUTION','VECVIEW_SOLUTION','VIEW_SOLUTION')
101) debug%vecview_solution = PETSC_TRUE
102) case('PRINT_RESIDUAL','VECVIEW_RESIDUAL','VIEW_RESIDUAL')
103) debug%vecview_residual = PETSC_TRUE
104) case('PRINT_JACOBIAN','MATVIEW_JACOBIAN','VIEW_JACOBIAN')
105) debug%matview_Jacobian = PETSC_TRUE
106) case('PRINT_JACOBIAN_NORM','NORM_JACOBIAN')
107) debug%norm_Jacobian = PETSC_TRUE
108) case('PRINT_COUPLERS','PRINT_COUPLER')
109) debug%print_couplers = PETSC_TRUE
110) debug%coupler_string = trim(adjustl(input%buf))
111) case('PRINT_JACOBIAN_DETAILED','MATVIEW_JACOBIAN_DETAILED','VIEW_JACOBIAN_DETAILED')
112) debug%matview_Jacobian_detailed = PETSC_TRUE
113) case('PRINT_NUMERICAL_DERIVATIVES','VIEW_NUMERICAL_DERIVATIVES')
114) debug%print_numerical_derivatives = PETSC_TRUE
115) case('WAYPOINTS')
116) debug%print_waypoints = PETSC_TRUE
117) case('BINARY_FORMAT')
118) debug%binary_format = PETSC_TRUE
119) case default
120) call InputKeywordUnrecognized(keyword,'DEBUG',option)
121) end select
122)
123) enddo
124)
125) end subroutine DebugRead
126)
127) ! ************************************************************************** !
128)
129) subroutine DebugCreateViewer(debug,viewer_name_prefix,option,viewer)
130) !
131) ! Creates a PETSc viewer for saving PETSc vector or matrix in ASCII or
132) ! binary format
133) !
134) ! Author: Gautam Bisht
135) ! Date: 09/23/14
136) !
137)
138) use Option_module
139) implicit none
140)
141) #include "petsc/finclude/petscsys.h"
142) #include "petsc/finclude/petscviewer.h"
143)
144) type(debug_type), pointer :: debug
145) character(len=MAXSTRINGLENGTH), intent(in) :: viewer_name_prefix
146) type(option_type) :: option
147) PetscViewer, intent (inout) :: viewer
148)
149) character(len=MAXWORDLENGTH) :: viewer_name
150) PetscErrorCode :: ierr
151)
152) if (debug%binary_format) then
153) viewer_name = trim(adjustl(viewer_name_prefix)) // '.bin'
154) call PetscViewerBinaryOpen(option%mycomm,viewer_name, &
155) FILE_MODE_WRITE,viewer,ierr);CHKERRQ(ierr)
156) else
157) viewer_name = trim(viewer_name_prefix) // '.out'
158) call PetscViewerASCIIOpen(option%mycomm,viewer_name,viewer, &
159) ierr);CHKERRQ(ierr)
160) endif
161)
162)
163) end subroutine DebugCreateViewer
164)
165) ! ************************************************************************** !
166)
167) subroutine DebugDestroy(debug)
168) !
169) ! Deallocates memory associated with debug object
170) !
171) ! Author: Glenn Hammond
172) ! Date: 12/21/07
173) !
174) implicit none
175)
176) type(debug_type), pointer :: debug
177)
178) if (.not.associated(debug)) return
179)
180) deallocate(debug)
181) nullify(debug)
182)
183) end subroutine DebugDestroy
184)
185) end module Debug_module