ddx 0.6.0
Libary for domain-decomposition methods for polarizable continuum models
ddx_workspace.f90
Go to the documentation of this file.
1
13
15module ddx_workspace
16! Get ddx_params_type and all compile-time definitions
17use ddx_parameters
18! Get ddx_constants_type and all run-time constants
19use ddx_constants
20
21implicit none
22
23
25type ddx_workspace_type
28 real(dp), allocatable :: tmp_pot(:,:)
31 real(dp), allocatable :: tmp_vplm(:, :)
34 real(dp), allocatable :: tmp_vylm(:, :)
37 real(dp), allocatable :: tmp_vdylm(:, :, :)
40 real(dp), allocatable :: tmp_work(:, :)
43 real(dp), allocatable :: tmp_vcos(:, :)
46 real(dp), allocatable :: tmp_vsin(:, :)
49 complex(dp), allocatable :: tmp_bessel(:, :)
52 real(dp), allocatable :: tmp_sph(:, :)
56 real(dp), allocatable :: tmp_sph2(:, :)
58 real(dp), allocatable :: tmp_rhs(:, :)
61 real(dp), allocatable :: tmp_sph_grad(:, :, :)
64 real(dp), allocatable :: tmp_sph_l(:, :)
67 real(dp), allocatable :: tmp_sph_l_grad(:, :, :)
70 real(dp), allocatable :: tmp_sph_l_grad2(:, :, :)
73 real(dp), allocatable :: tmp_node_m(:, :)
76 real(dp), allocatable :: tmp_node_l(:, :)
79 real(dp), allocatable :: tmp_grid(:, :)
82 real(dp), allocatable :: tmp_grid2(:, :)
85 real(dp), allocatable :: tmp_cav(:)
87 real(dp), allocatable :: tmp_efld(:, :)
89 real(dp), allocatable :: tmp_x_new(:)
91 real(dp), allocatable :: tmp_y(:)
93 real(dp), allocatable :: tmp_x_diis(:, :)
95 real(dp), allocatable :: tmp_e_diis(:, :)
97 real(dp), allocatable :: tmp_bmat(:, :)
99 real(dp), allocatable :: ddcosmo_guess(:,:), hsp_guess(:,:)
101 real(dp) :: xs_time, s_time, hsp_time, hsp_adj_time
102end type ddx_workspace_type
103
104contains
105
113subroutine workspace_init(params, constants, workspace, ddx_error)
114 !! Inputs
115 type(ddx_params_type), intent(in) :: params
116 type(ddx_constants_type), intent(in) :: constants
117 !! Outputs
118 type(ddx_workspace_type), intent(out) :: workspace
119 type(ddx_error_type), intent(inout) :: ddx_error
120 !! Local variables
121 integer :: info
122 !! The code
123 if (ddx_error % flag .ne. 0) then
124 call update_error(ddx_error, "workspace_init received input in error " // &
125 & " state, exiting")
126 return
127 end if
128 allocate(workspace % tmp_pot(params % ngrid, params % nproc), &
129 & workspace % tmp_vplm(constants % vgrid_nbasis, params % nproc), &
130 & workspace % tmp_vcos(constants % vgrid_dmax+1, params % nproc), &
131 & workspace % tmp_vsin(constants % vgrid_dmax+1, params % nproc), &
132 & workspace % tmp_work(constants % vgrid_dmax+1, params % nproc), &
133 & stat=info)
134 if (info .ne. 0) then
135 call update_error(ddx_error, "workspace_init: `tmp_vplm`, `tmp_vcos` " // &
136 & "and `tmp_vsin` allocations failed")
137 return
138 end if
139 allocate(workspace % tmp_vylm(constants % vgrid_nbasis, params % nproc), &
140 & workspace % tmp_vdylm(3, constants % vgrid_nbasis, params % nproc), &
141 & stat=info)
142 if (info .ne. 0) then
143 call update_error(ddx_error, "workspace_init: `tmp_vylm` " &
144 & // "and `tmp_vdylm` allocations failed")
145 return
146 end if
147 allocate(workspace % tmp_sph(constants % nbasis, params % nsph), &
148 & stat=info)
149 if (info .ne. 0) then
150 call update_error(ddx_error, "workspace_init: `tmp_sph` " // &
151 & "allocation failed")
152 return
153 end if
154 if (params % fmm .eq. 1) then
155 allocate(workspace % tmp_sph2(constants % grad_nbasis, params % nsph), &
156 & stat=info)
157 if (info .ne. 0) then
158 call update_error(ddx_error, "workspace_init: `tmp_sph2` " // &
159 & "allocation failed")
160 return
161 end if
162 allocate(workspace % tmp_sph_grad( &
163 & constants % grad_nbasis, 3, params % nsph), &
164 & stat=info)
165 if (info .ne. 0) then
166 call update_error(ddx_error, "workspace_init: `tmp_sph_grad` " // &
167 & "allocation failed")
168 return
169 end if
170 allocate(workspace % tmp_sph_l((params % pl+1)**2, params % nsph), &
171 & stat=info)
172 if (info .ne. 0) then
173 call update_error(ddx_error, "workspace_init: `tmp_sph_l` " // &
174 & "allocation failed")
175 return
176 end if
177 allocate(workspace % tmp_sph_l_grad( &
178 & (params % pl+1)**2, 3, params % nsph), &
179 & stat=info)
180 if (info .ne. 0) then
181 call update_error(ddx_error, "workspace_init: `tmp_sph_l_grad` " // &
182 & "allocation failed")
183 return
184 end if
185 allocate(workspace % tmp_sph_l_grad2( &
186 & (params % pl+1)**2, 3, params % nsph), &
187 & stat=info)
188 if (info .ne. 0) then
189 call update_error(ddx_error, "workspace_init: `tmp_sph_l_grad2` " // &
190 & "allocation failed")
191 return
192 end if
193 allocate(workspace % tmp_node_m((params % pm+1)**2, &
194 & constants % nclusters), stat=info)
195 if (info .ne. 0) then
196 call update_error(ddx_error, "workspace_init: `tmp_node_m` " // &
197 & "allocation failed")
198 return
199 end if
200 allocate(workspace % tmp_node_l((params % pl+1)**2, &
201 & constants % nclusters), stat=info)
202 if (info .ne. 0) then
203 call update_error(ddx_error, "workspace_init: `tmp_node_l` " // &
204 & "allocation failed")
205 return
206 end if
207 end if
208 allocate(workspace % tmp_grid(params % ngrid, params % nsph), &
209 & stat=info)
210 if (info .ne. 0) then
211 call update_error(ddx_error, "workspace_init: `tmp_grid` " // &
212 & "allocation failed")
213 return
214 end if
215 allocate(workspace % tmp_grid2(params % ngrid, params % nsph), &
216 & stat=info)
217 if (info .ne. 0) then
218 call update_error(ddx_error, "workspace_init: `tmp_grid2` " // &
219 & "allocation failed")
220 return
221 end if
222 allocate(workspace % tmp_cav(constants % ncav), stat=info)
223 if (info .ne. 0) then
224 call update_error(ddx_error, "workspace_init: `tmp_cav` " // &
225 & "allocation failed")
226 return
227 end if
228 allocate(workspace % tmp_efld(3, constants % ncav), stat=info)
229 if (info .ne. 0) then
230 call update_error(ddx_error, "workspace_init: `tmp_efld` " // &
231 & "allocation failed")
232 return
233 end if
234 allocate(workspace % tmp_x_new(constants % n), stat=info)
235 if (info .ne. 0) then
236 call update_error(ddx_error, "workspace_init: `tmp_x_new` " // &
237 & "allocation failed")
238 return
239 end if
240 allocate(workspace % tmp_y(constants % n), stat=info)
241 if (info .ne. 0) then
242 call update_error(ddx_error, "workspace_init: `tmp_y` " // &
243 & "allocation failed")
244 return
245 end if
246 allocate(workspace % tmp_x_diis(constants % n, 2*params % jacobi_ndiis), &
247 & stat=info)
248 if (info .ne. 0) then
249 call update_error(ddx_error, "workspace_init: `tmp_x_diis` " // &
250 & "allocation failed")
251 return
252 end if
253 allocate(workspace % tmp_e_diis(constants % n, 2*params % jacobi_ndiis), &
254 & stat=info)
255 if (info .ne. 0) then
256 call update_error(ddx_error, "workspace_init: `tmp_e_diis` " // &
257 & "allocation failed")
258 return
259 end if
260 allocate(workspace % tmp_bmat(2*params % jacobi_ndiis + 2, &
261 & 2*params % jacobi_ndiis + 2), stat=info)
262 if (info .ne. 0) then
263 call update_error(ddx_error, "workspace_init: `tmp_bmat` " // &
264 & "allocation failed")
265 return
266 end if
267 ! Allocations for LPB model
268 if (params % model .eq. 3) then
269 allocate(workspace % tmp_bessel(max(2, params % lmax+1), &
270 & params % nproc), workspace % ddcosmo_guess(constants % nbasis, params % nsph), &
271 & workspace % hsp_guess(constants % nbasis, params % nsph), stat=info)
272 if (info .ne. 0) then
273 call update_error(ddx_error, "workspace_init: `tmp_bessel` " // &
274 & "allocation failed")
275 return
276 end if
277 end if
278end subroutine workspace_init
279
285subroutine workspace_free(workspace, ddx_error)
286 implicit none
287 type(ddx_workspace_type), intent(out) :: workspace
288 type(ddx_error_type), intent(inout) :: ddx_error
289 integer :: istat
290
291 istat = 0
292
293 if (allocated(workspace % tmp_pot)) then
294 deallocate(workspace % tmp_pot, stat=istat)
295 if (istat .ne. 0) then
296 call update_error(ddx_error, "`tmp_pot` deallocation failed!")
297 end if
298 end if
299 if (allocated(workspace % tmp_vplm)) then
300 deallocate(workspace % tmp_vplm, stat=istat)
301 if (istat .ne. 0) then
302 call update_error(ddx_error, "`tmp_vplm` deallocation failed!")
303 end if
304 end if
305 if (allocated(workspace % tmp_vcos)) then
306 deallocate(workspace % tmp_vcos, stat=istat)
307 if (istat .ne. 0) then
308 call update_error(ddx_error, "`tmp_vcos` deallocation failed!")
309 end if
310 end if
311 if (allocated(workspace % tmp_vsin)) then
312 deallocate(workspace % tmp_vsin, stat=istat)
313 if (istat .ne. 0) then
314 call update_error(ddx_error, "`tmp_vsin` deallocation failed!")
315 end if
316 end if
317 if (allocated(workspace % tmp_work)) then
318 deallocate(workspace % tmp_work, stat=istat)
319 if (istat .ne. 0) then
320 call update_error(ddx_error, "`tmp_work` deallocation failed!")
321 end if
322 end if
323 if (allocated(workspace % tmp_vylm)) then
324 deallocate(workspace % tmp_vylm, stat=istat)
325 if (istat .ne. 0) then
326 call update_error(ddx_error, "`tmp_vylm` deallocation failed!")
327 end if
328 end if
329 if (allocated(workspace % tmp_vdylm)) then
330 deallocate(workspace % tmp_vdylm, stat=istat)
331 if (istat .ne. 0) then
332 call update_error(ddx_error, "`tmp_vdylm` deallocation failed!")
333 end if
334 end if
335 if (allocated(workspace % tmp_sph)) then
336 deallocate(workspace % tmp_sph, stat=istat)
337 if (istat .ne. 0) then
338 call update_error(ddx_error, "`tmp_sph` deallocation failed!")
339 end if
340 end if
341 if (allocated(workspace % tmp_sph2)) then
342 deallocate(workspace % tmp_sph2, stat=istat)
343 if (istat .ne. 0) then
344 call update_error(ddx_error, "`tmp_sph2` deallocation failed!")
345 end if
346 end if
347 if (allocated(workspace % tmp_sph_grad)) then
348 deallocate(workspace % tmp_sph_grad, stat=istat)
349 if (istat .ne. 0) then
350 call update_error(ddx_error, "`tmp_sph_grad` deallocation failed!")
351 end if
352 end if
353 if (allocated(workspace % tmp_sph_l)) then
354 deallocate(workspace % tmp_sph_l, stat=istat)
355 if (istat .ne. 0) then
356 call update_error(ddx_error, "`tmp_sph_l` deallocation failed!")
357 end if
358 end if
359 if (allocated(workspace % tmp_sph_l_grad)) then
360 deallocate(workspace % tmp_sph_l_grad, stat=istat)
361 if (istat .ne. 0) then
362 call update_error(ddx_error, "`tmp_sph_l_grad` deallocation failed!")
363 end if
364 end if
365 if (allocated(workspace % tmp_sph_l_grad2)) then
366 deallocate(workspace % tmp_sph_l_grad2, stat=istat)
367 if (istat .ne. 0) then
368 call update_error(ddx_error, "`tmp_sph_l_grad2` deallocation failed!")
369 end if
370 end if
371 if (allocated(workspace % tmp_node_m)) then
372 deallocate(workspace % tmp_node_m, stat=istat)
373 if (istat .ne. 0) then
374 call update_error(ddx_error, "`tmp_node_m` deallocation failed!")
375 end if
376 end if
377 if (allocated(workspace % tmp_node_l)) then
378 deallocate(workspace % tmp_node_l, stat=istat)
379 if (istat .ne. 0) then
380 call update_error(ddx_error, "`tmp_node_l` deallocation failed!")
381 end if
382 end if
383 if (allocated(workspace % tmp_grid)) then
384 deallocate(workspace % tmp_grid, stat=istat)
385 if (istat .ne. 0) then
386 call update_error(ddx_error, "`tmp_grid` deallocation failed!")
387 end if
388 end if
389 if (allocated(workspace % tmp_grid2)) then
390 deallocate(workspace % tmp_grid2, stat=istat)
391 if (istat .ne. 0) then
392 call update_error(ddx_error, "`tmp_grid2` deallocation failed!")
393 end if
394 end if
395 if (allocated(workspace % tmp_cav)) then
396 deallocate(workspace % tmp_cav, stat=istat)
397 if (istat .ne. 0) then
398 call update_error(ddx_error, "`tmp_cav` deallocation failed!")
399 end if
400 end if
401 if (allocated(workspace % tmp_efld)) then
402 deallocate(workspace % tmp_efld, stat=istat)
403 if (istat .ne. 0) then
404 call update_error(ddx_error, "`tmp_efld` deallocation failed!")
405 end if
406 end if
407 if (allocated(workspace % tmp_x_new)) then
408 deallocate(workspace % tmp_x_new, stat=istat)
409 if (istat .ne. 0) then
410 call update_error(ddx_error, "`tmp_x_new` deallocation failed!")
411 end if
412 end if
413 if (allocated(workspace % tmp_y)) then
414 deallocate(workspace % tmp_y, stat=istat)
415 if (istat .ne. 0) then
416 call update_error(ddx_error, "`tmp_y` deallocation failed!")
417 end if
418 end if
419 if (allocated(workspace % tmp_x_diis)) then
420 deallocate(workspace % tmp_x_diis, stat=istat)
421 if (istat .ne. 0) then
422 call update_error(ddx_error, "`tmp_x_diis` deallocation failed!")
423 end if
424 end if
425 if (allocated(workspace % tmp_e_diis)) then
426 deallocate(workspace % tmp_e_diis, stat=istat)
427 if (istat .ne. 0) then
428 call update_error(ddx_error, "`tmp_e_diis` deallocation failed!")
429 end if
430 end if
431 if (allocated(workspace % tmp_bmat)) then
432 deallocate(workspace % tmp_bmat, stat=istat)
433 if (istat .ne. 0) then
434 call update_error(ddx_error, "`tmp_bmat` deallocation failed!")
435 end if
436 end if
437 if (allocated(workspace % tmp_bessel)) then
438 deallocate(workspace % tmp_bessel, stat=istat)
439 if (istat .ne. 0) then
440 call update_error(ddx_error, "`tmp_bessel` deallocation failed!")
441 end if
442 end if
443 if (allocated(workspace % ddcosmo_guess)) then
444 deallocate(workspace % ddcosmo_guess, stat=istat)
445 if (istat .ne. 0) then
446 call update_error(ddx_error, "`ddcosmo_guess` deallocation failed!")
447 end if
448 end if
449 if (allocated(workspace % hsp_guess)) then
450 deallocate(workspace % hsp_guess, stat=istat)
451 if (istat .ne. 0) then
452 call update_error(ddx_error, "`hsp_guess` deallocation failed!")
453 end if
454 end if
455 if (allocated(workspace % tmp_rhs)) then
456 deallocate(workspace % tmp_rhs, stat=istat)
457 if (istat .ne. 0) then
458 call update_error(ddx_error, "`tmp_rhs` deallocation failed!")
459 end if
460 end if
461end subroutine workspace_free
462
463end module
464
ddx_constants
Run-time constants.
Definition: ddx_constants.f90:17
ddx_parameters
Module to treat properly user input parameters.
Definition: ddx_parameters.f90:15
ddx_workspace
Workspace for temporary buffers.
Definition: ddx_workspace.f90:15
ddx_workspace::workspace_init
subroutine workspace_init(params, constants, workspace, ddx_error)
Initialize and allocate the temporary workspaces.
Definition: ddx_workspace.f90:114
ddx_workspace::workspace_free
subroutine workspace_free(workspace, ddx_error)
Deallocate the temporary workspaces.
Definition: ddx_workspace.f90:286
ddx_constants::ddx_constants_type
Container for precomputed constants.
Definition: ddx_constants.f90:28
ddx_parameters::ddx_params_type
Type to check and store user input parameters.
Definition: ddx_parameters.f90:25
ddx_workspace::ddx_workspace_type
Container for temporary arrays.
Definition: ddx_workspace.f90:25