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