Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Data types representing superfluid helium
10 : !> \author hforbert
11 : !> \date 2009-01-01
12 : !> \par History
13 : !> extracted helium_solvent_type from pint_types.F [lwalewski]
14 : ! **************************************************************************************************
15 : MODULE helium_types
16 :
17 : USE cell_types, ONLY: cell_type
18 : USE cp_log_handling, ONLY: cp_logger_type
19 : USE input_constants, ONLY: helium_sampling_ceperley
20 : USE input_section_types, ONLY: section_vals_type
21 : USE kinds, ONLY: default_string_length,&
22 : dp,&
23 : int_8
24 : USE message_passing, ONLY: mp_para_env_type
25 : USE nnp_environment_types, ONLY: nnp_type
26 : USE parallel_rng_types, ONLY: rng_stream_type
27 : USE splines_types, ONLY: spline_data_type
28 : #include "../base/base_uses.f90"
29 :
30 : IMPLICIT NONE
31 :
32 : PRIVATE
33 :
34 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
35 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'helium_types'
36 :
37 : !> Energy contributions - symbolic names for indexing energy arrays
38 : INTEGER, PARAMETER, PUBLIC :: &
39 : e_id_total = 1, &
40 : e_id_potential = 2, &
41 : e_id_kinetic = 3, &
42 : e_id_interact = 4, &
43 : e_id_thermo = 5, &
44 : e_id_virial = 6
45 :
46 : !> Number of energy contributions for static array allocation
47 : INTEGER, PARAMETER, PUBLIC :: e_num_ids = 10
48 :
49 : !> number of density function identifiers
50 : INTEGER, PARAMETER, PUBLIC :: rho_num = 5
51 :
52 : !> density function identifier names
53 : INTEGER, PARAMETER, PUBLIC :: &
54 : rho_atom_number = 1, &
55 : rho_projected_area = 2, &
56 : rho_winding_number = 3, &
57 : rho_winding_cycle = 4, &
58 : rho_moment_of_inertia = 5
59 :
60 : !> derived data types
61 : PUBLIC :: helium_solvent_type
62 : PUBLIC :: helium_solvent_p_type
63 : PUBLIC :: int_arr_ptr
64 :
65 : !> functions
66 : PUBLIC :: helium_destroy_int_arr_ptr
67 :
68 : ! ***************************************************************************
69 : !> \brief Vector type useful for averaging
70 : !> \author Lukasz Walewski
71 : !> \date 2014-09-09
72 : ! ***************************************************************************
73 : TYPE helium_vector_type
74 :
75 : !> instantaneous value
76 : REAL(KIND=dp), DIMENSION(3) :: inst = 0.0_dp
77 :
78 : !> accumulated value
79 : REAL(KIND=dp), DIMENSION(3) :: accu = 0.0_dp
80 :
81 : !> running average
82 : REAL(KIND=dp), DIMENSION(3) :: ravr = 0.0_dp
83 :
84 : !> restarted value
85 : REAL(KIND=dp), DIMENSION(3) :: rstr = 0.0_dp
86 :
87 : END TYPE helium_vector_type
88 :
89 : ! ***************************************************************************
90 : !> \brief data structure for solvent helium
91 : !> \author hforbert
92 : ! ***************************************************************************
93 : TYPE helium_solvent_type
94 :
95 : TYPE(section_vals_type), POINTER :: input => NULL()!< input data structure (the whole tree)
96 : TYPE(cp_logger_type), POINTER :: logger => NULL()
97 :
98 : INTEGER :: num_env = 0!< number of He environments in runtime
99 :
100 : INTEGER :: atoms = 0!< number of atoms
101 : INTEGER :: beads = 0!< number of beads per atom (needs to be an integer multiple of the solute's number of beads)
102 : INTEGER :: bead_ratio = 0!< ratio of helium beads to system beads
103 : REAL(KIND=dp) :: density = 0.0_dp !< helium density for free bulk in box
104 :
105 : ! some useful constants
106 : !
107 : REAL(KIND=dp) :: he_mass_au = 0.0_dp! mass of helium 4 in electron masses
108 : REAL(KIND=dp) :: hb2m = 0.0_dp!< hbar squared over m for 4He in CP2k units
109 : REAL(KIND=dp) :: tau = 0.0_dp!< 1/(k_B T p) with T - He temperature, p - number of beads
110 : REAL(KIND=dp) :: wpref = 0.0_dp!< prefactor for calculating superfluid fraction from <(M*W)^2>
111 : REAL(KIND=dp) :: apref = 0.0_dp!< prefactor for calculating superfluid fraction from <A^2/I_c>
112 :
113 : ! PBC related
114 : !
115 : LOGICAL :: periodic = .FALSE.!< true if bulk liquid helium in periodic box
116 : INTEGER :: cell_shape = 0!< unit cell shape for PBC calculations
117 : REAL(KIND=dp) :: cell_size = 0.0_dp!< size of the periodic box (helium only)
118 : REAL(KIND=dp) :: cell_size_inv = 0.0_dp!< 1/cell_size (inverse)
119 : REAL(KIND=dp), DIMENSION(3, 3) :: cell_m = 0.0_dp!< the unit cell vectors' matrix
120 : REAL(KIND=dp), DIMENSION(3, 3) :: cell_m_inv = 0.0_dp!< invrse of the unit cell vectors' matrix
121 : REAL(KIND=dp), DIMENSION(3) :: origin = 0.0_dp!< origin of the cell (first voxel position)
122 : REAL(KIND=dp) :: droplet_radius = 0.0_dp !< radius of the droplet
123 :
124 : REAL(KIND=dp), DIMENSION(3) :: center = 0.0_dp!< COM of solute (if present) or center of
125 : ! periodic cell (if periodic) or COM of helium
126 :
127 : INTEGER :: sampling_method = helium_sampling_ceperley
128 : ! worm sampling parameters
129 : REAL(KIND=dp) :: worm_centroid_drmax = 0.0_dp
130 : INTEGER :: worm_nstat = 0
131 : INTEGER :: worm_staging_l = 0
132 : INTEGER :: worm_repeat_crawl = 0
133 : INTEGER :: worm_all_limit = 0
134 : INTEGER :: worm_centroid_min = 0, worm_centroid_max = 0
135 : INTEGER :: worm_staging_min = 0, worm_staging_max = 0
136 : INTEGER :: worm_fcrawl_min = 0, worm_fcrawl_max = 0
137 : INTEGER :: worm_bcrawl_min = 0, worm_bcrawl_max = 0
138 : INTEGER :: worm_head_min = 0, worm_head_max = 0
139 : INTEGER :: worm_tail_min = 0, worm_tail_max = 0
140 : INTEGER :: worm_swap_min = 0, worm_swap_max = 0
141 : INTEGER :: worm_open_close_min = 0, worm_open_close_max = 0
142 : INTEGER :: worm_max_open_cycles = 0
143 : REAL(KIND=dp) :: worm_open_close_scale = 0.0_dp
144 : REAL(KIND=dp) :: worm_ln_openclose_scale = 0.0_dp
145 : LOGICAL :: worm_allow_open = .FALSE., worm_show_statistics = .FALSE.
146 :
147 : ! worm specific variables
148 : REAL(KIND=dp), DIMENSION(3) :: worm_xtra_bead = 0.0_dp, worm_xtra_bead_work = 0.0_dp
149 : INTEGER :: worm_atom_idx = 0, worm_bead_idx = 0
150 : INTEGER :: worm_atom_idx_work = 0, worm_bead_idx_work = 0
151 : INTEGER :: iw = 0, it = 0
152 : LOGICAL :: worm_is_closed = .FALSE.!before isector=1 -> open; isector=0 -> closed
153 :
154 : INTEGER :: iter_norot = 0!< number of iterations to try for a given imaginary time slice rotation (num inner MC loop iters)
155 : INTEGER :: iter_rot = 0!< number of rotations to try (total number of iterations is iter_norot*iter_rot)
156 : ! (num outer MC loop iters)
157 : !
158 : INTEGER :: maxcycle = 0!< maximum cyclic permutation change to attempt
159 : INTEGER :: m_dist_type = 0!< distribution from which the cycle length m is sampled
160 : INTEGER :: m_value = 0!< cycle length sampled with different probability than other lengths
161 : REAL(KIND=dp) :: m_ratio = 0.0_dp!< probability ratio betw m_value and other possible values of m
162 : !
163 : INTEGER :: relrot = 0!< relative rotation in imaginary time wrt normal system/starting configuration
164 : INTEGER :: bisection = 0 !< power of 2 number for bisection algorithm
165 : INTEGER :: bisctlog2 = 0!< log2(bisection)
166 :
167 : REAL(KIND=dp) :: e_corr = 0.0_dp !< potential correction energy due to finite box
168 : INTEGER :: pdx = 0!< pair density expansion max exponent
169 :
170 : ! MC step counters
171 : !
172 : INTEGER :: num_steps = 0!< number of iterations in the current run
173 : INTEGER :: first_step = 0!< first step, restarted from MOTION%PINT%ITERATION (default value: 0)
174 : INTEGER :: last_step = 0
175 : INTEGER :: current_step = 0 !< first_step + number of steps performed so far
176 :
177 : ! helium variables
178 : !
179 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: pos => NULL()!< position of the helium atoms DIM(3,atoms,beads)
180 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: savepos => NULL()!< saved position of the helium atoms DIM(3,atoms,beads)
181 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: work => NULL()!< same dimensions as pos
182 : !
183 : INTEGER, DIMENSION(:), POINTER :: permutation => NULL()!< current permutation state DIM(atoms)
184 : INTEGER, DIMENSION(:), POINTER :: savepermutation => NULL()!< saved permutation state DIM(atoms)
185 : INTEGER, DIMENSION(:), POINTER :: iperm => NULL()!< inverse of the current permutation state DIM(atoms)
186 : INTEGER, DIMENSION(:), POINTER :: saveiperm => NULL()!< saved inverse of the current permutation state DIM(atoms)
187 : INTEGER, DIMENSION(:), POINTER :: ptable => NULL()!< proposed cyclic permutation, DIM(max_cycle)
188 : INTEGER(KIND=int_8) :: accepts = 0_int_8!< number of accepted new configurations
189 : !
190 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: tmatrix => NULL()!< ? permutation probability related
191 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: pmatrix => NULL()!< ? permutation probability related
192 : ! [use might change/new ones added/etc]
193 : REAL(KIND=dp) :: pweight = 0.0_dp!< ? permutation probability related
194 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: ipmatrix => NULL()
195 : INTEGER, DIMENSION(:, :), POINTER :: nmatrix => NULL()
196 :
197 : TYPE(spline_data_type), POINTER :: vij => NULL()!< physical pair potential energy
198 : TYPE(spline_data_type), POINTER :: u0 => NULL()!< pair density matrix coefficient (action) endpoint approx
199 : TYPE(spline_data_type), POINTER :: e0 => NULL()!< pair density matrix coefficient (energy) endpoint approx
200 : !< raw spline data for pair density matrix off diagonal expansion beyond endpoint approx:
201 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :, :), POINTER :: uoffdiag => NULL()!< (action)
202 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :, :), POINTER :: eoffdiag => NULL()!< (energy)
203 :
204 : ! calculated properties
205 : !
206 : REAL(KIND=dp), DIMENSION(e_num_ids) :: energy_inst = 0.0_dp!< energy contributions (instantaneous)
207 : REAL(KIND=dp), DIMENSION(e_num_ids) :: energy_avrg = 0.0_dp!< energy contributions (averaged)
208 : TYPE(helium_vector_type) :: wnumber = helium_vector_type()!< winding number
209 : TYPE(helium_vector_type) :: wnmber2 = helium_vector_type()!< winding number squared
210 : TYPE(helium_vector_type) :: proarea = helium_vector_type()!< projected area
211 : TYPE(helium_vector_type) :: prarea2 = helium_vector_type()!< projected area squared
212 : TYPE(helium_vector_type) :: mominer = helium_vector_type()!< moment of inertia
213 : INTEGER :: averages_iweight = 0!< weight for restarted averages
214 : LOGICAL :: averages_restarted = .FALSE.!< flag indicating whether the averages
215 : ! have been restarted
216 :
217 : REAL(KIND=dp) :: link_action = 0.0_dp, inter_action = 0.0_dp, pair_action = 0.0_dp
218 :
219 : !
220 : INTEGER :: rdf_nbin = 0!< number of bins for RDF
221 : INTEGER :: rdf_iweight = 0 !< weight for restarted RDF
222 : INTEGER :: rho_iweight = 0!< weight for restarted RHO
223 : INTEGER :: rdf_num = 0!< number of X-He-RDFs
224 : INTEGER :: rdf_num_ctr = 0 !< number of centers for RDF calc
225 : REAL(KIND=dp) :: rdf_delr = 0.0_dp!< delta r for RDF
226 : REAL(KIND=dp) :: rdf_maxr = 0.0_dp!< maximum r for RDF
227 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_centers => NULL() !< positions of RDF solute centers
228 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_inst => NULL()!< RDF (instantaneous/tmp array)
229 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_rstr => NULL()!< RDF (restarted)
230 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_accu => NULL()!< RDF (accumulated for one run)
231 : LOGICAL :: rdf_present = .FALSE.
232 : LOGICAL :: rdf_sol_he = .FALSE.
233 : LOGICAL :: rdf_he_he = .FALSE.
234 : !
235 : INTEGER :: rho_nbin = 0
236 : INTEGER :: rho_num_act = 0!< actual number of density estimators
237 : INTEGER :: rho_num_min_len_wdg = 0!< number of optional estimators based on winding cycles
238 : INTEGER :: rho_num_min_len_non = 0!< number of optional estimators based on non-winding cycles
239 : INTEGER :: rho_num_min_len_all = 0!< number of optional estimators based on all cycles
240 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_wdg_vals => NULL()!< minimum lengths of winding cycles
241 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_non_vals => NULL()!< minimum lengths of non-winding cycles
242 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_all_vals => NULL()!< minimum lengths of all cycles
243 : REAL(KIND=dp) :: rho_delr = 0.0_dp, rho_maxr = 0.0_dp
244 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_inst => NULL()
245 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_rstr => NULL()
246 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_accu => NULL()
247 : LOGICAL :: rho_present = .FALSE.
248 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: rho_incr => NULL()!< increment for density bining
249 :
250 : TYPE(density_properties_type), DIMENSION(:), POINTER :: rho_property => NULL()
251 :
252 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: num_accepted => NULL()!< average number of accepted permutations of a given length
253 : !! on a given Levy level, plus one additional level which
254 : !! counts # of trials, REAL(BISCTLOG2+2, MAX_PERM_CYCLE)
255 : !! num_accepted(1,l) - # of trials for perm length l
256 : !! num_accepted(2,l) - # of selected perms of length l
257 : !! num_accepted(3,l) - # of perms of length l accepted at level 1
258 : !! average over He environments/processors
259 : REAL(KIND=dp), DIMENSION(:), POINTER :: plength_avrg => NULL()!< permutation length probability distribution DIM(atoms)
260 : REAL(KIND=dp), DIMENSION(:), POINTER :: plength_inst => NULL()!< instantaneous permutation length probability DIM(atoms)
261 : INTEGER, DIMENSION(:), POINTER :: atom_plength => NULL()!< length of the permutation cycle the atom belongs to DIM(atoms)
262 :
263 : TYPE(rng_stream_type), POINTER :: rng_stream_uniform => NULL()!< random number stream with uniform distribution
264 : TYPE(rng_stream_type), POINTER :: rng_stream_gaussian => NULL()!< random number stream with gaussian distribution
265 :
266 : ! variables related to solvated molecular system
267 : !
268 : LOGICAL :: solute_present = .FALSE.!< switch the interactions with the solute on or off
269 : INTEGER :: solute_atoms = 0!< number of solute atoms (pint_env%ndim/3)
270 : INTEGER :: solute_beads = 0!< number of solute beads (pint_env%p)
271 : INTEGER :: get_helium_forces = 0!< parameter to determine whether the average or last MC force should be taken to MD
272 : CHARACTER(LEN=2), DIMENSION(:), POINTER :: solute_element => NULL()!< element names of solute atoms (pint_env%ndim/3)
273 : TYPE(cell_type), POINTER :: solute_cell => NULL()!< dimensions of the solvated system cell (a,b,c)
274 : ! (should be removed at some point)
275 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_avrg => NULL()!< averaged forces exerted by He solvent
276 : ! on the solute DIM(p,ndim)
277 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_inst => NULL()!< instantaneous forces exerted by He on the solute (p,ndim)
278 : CHARACTER(LEN=2), DIMENSION(:), POINTER :: ename => NULL()
279 : INTEGER :: enum = 0
280 : INTEGER :: solute_interaction = 0
281 :
282 : LOGICAL :: interaction_pot_scan = .FALSE.!< whether to perform solute-helium interaction scan
283 :
284 : TYPE(nnp_type), POINTER :: nnp => NULL() !< neural network potential
285 : REAL(KIND=dp), DIMENSION(:), POINTER :: nnp_sr_cut => NULL() !< hard core cutoff in addition to the nnp
286 :
287 : ! temporary arrays for optimization
288 : !
289 : INTEGER, DIMENSION(:), POINTER :: itmp_atoms_1d => NULL()!< DIM(atoms) - same as permutation
290 : INTEGER, DIMENSION(:), POINTER :: itmp_atoms_np_1d => NULL()!< DIM(atoms*num_env)
291 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_np_1d => NULL()!< DIM(3*num_env)
292 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_p_ndim_1d => NULL()!< DIM(p*ndim)
293 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_p_ndim_np_1d => NULL()!< DIM(p*ndim*num_env)
294 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_atoms_beads_1d => NULL()!< DIM(3*atoms*beads)
295 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_atoms_beads_np_1d => NULL()
296 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rtmp_p_ndim_2d => NULL()!< DIM(p,ndim)
297 : LOGICAL, DIMENSION(:, :, :), POINTER :: ltmp_3_atoms_beads_3d => NULL()!< DIM(3,atoms,beads) - same as pos
298 : LOGICAL, DIMENSION(:), POINTER :: ltmp_atoms_1d => NULL()!< DIM(atoms) - for unpacking the permutation
299 :
300 : END TYPE helium_solvent_type
301 :
302 : ! ***************************************************************************
303 : !> \brief data structure for array of solvent helium environments
304 : !> \author cschran
305 : ! ***************************************************************************
306 : TYPE helium_solvent_p_type
307 : TYPE(helium_solvent_type), POINTER :: helium => NULL()
308 : TYPE(mp_para_env_type), POINTER :: comm => NULL()
309 : INTEGER, DIMENSION(:), POINTER :: env_all => NULL()
310 : END TYPE helium_solvent_p_type
311 :
312 : ! ***************************************************************************
313 : !> \brief Container type for properties of a helium density function
314 : !> \author Lukasz Walewski
315 : !> \date 2014-09-09
316 : ! ***************************************************************************
317 : TYPE density_properties_type
318 :
319 : !> name of this density function
320 : CHARACTER(len=default_string_length) :: name = ""
321 :
322 : !> flag indicating whether this function should be calculated
323 : LOGICAL :: is_calculated = .FALSE.
324 :
325 : !> number of components that this function is composed of
326 : INTEGER :: num_components = 0
327 :
328 : !> suffixes for the filenames storing components of this function
329 : CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: filename_suffix => NULL()
330 :
331 : !> component names
332 : CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: component_name => NULL()
333 :
334 : !> indices locating the components of this function in the global density arrays
335 : INTEGER, DIMENSION(:), POINTER :: component_index => NULL()
336 :
337 : END TYPE density_properties_type
338 :
339 : ! ***************************************************************************
340 : !> \brief A pointer to an integer array, data type to be used in arrays of
341 : !> pointers.
342 : !> \author Lukasz Walewski
343 : !> \date 2013-12-11
344 : ! ***************************************************************************
345 : TYPE int_arr_ptr
346 : INTEGER, DIMENSION(:), POINTER :: iap => NULL()
347 : END TYPE int_arr_ptr
348 :
349 : ! ***************************************************************************
350 : !> \brief A pointer to a real array, data type to be used in arrays of
351 : !> pointers.
352 : !> \author Lukasz Walewski
353 : !> \date 2013-12-11
354 : ! ***************************************************************************
355 : TYPE real_arr_ptr
356 : REAL(KIND=dp), DIMENSION(:), POINTER :: rap => NULL()
357 : END TYPE real_arr_ptr
358 :
359 : CONTAINS
360 :
361 : ! ***************************************************************************
362 : !> \brief Deallocate all arrays pointed to by the pointers stored in the
363 : !> integer pointer array
364 : !> \param int_arr_p ...
365 : !> \date 2013-12-12
366 : !> \author Lukasz Walewski
367 : ! **************************************************************************************************
368 0 : SUBROUTINE helium_destroy_int_arr_ptr(int_arr_p)
369 :
370 : TYPE(int_arr_ptr), DIMENSION(:), POINTER :: int_arr_p
371 :
372 : INTEGER :: ip
373 :
374 : ! deallocate memory used by each component of the pointer array
375 :
376 0 : DO ip = 1, SIZE(int_arr_p)
377 0 : IF (ASSOCIATED(int_arr_p(ip)%iap)) THEN
378 0 : DEALLOCATE (int_arr_p(ip)%iap)
379 : END IF
380 : END DO
381 :
382 : ! deallocate the memory used for pointer array
383 0 : IF (ASSOCIATED(int_arr_p)) THEN
384 0 : DEALLOCATE (int_arr_p)
385 : END IF
386 :
387 0 : RETURN
388 : END SUBROUTINE helium_destroy_int_arr_ptr
389 :
390 : ! ***************************************************************************
391 : !> \brief Deallocate all arrays pointed to by the pointers stored in the
392 : !> real pointer array
393 : !> \param real_arr_p ...
394 : !> \date 2013-12-12
395 : !> \author Lukasz Walewski
396 : ! **************************************************************************************************
397 0 : SUBROUTINE helium_destroy_real_arr_ptr(real_arr_p)
398 :
399 : TYPE(real_arr_ptr), DIMENSION(:), POINTER :: real_arr_p
400 :
401 : INTEGER :: ip
402 :
403 : ! do not attempt deallocation on null pointer
404 :
405 0 : IF (.NOT. ASSOCIATED(real_arr_p)) THEN
406 : RETURN
407 : END IF
408 :
409 : ! deallocate memory used by each component of the pointer array
410 0 : DO ip = 1, SIZE(real_arr_p)
411 0 : IF (ASSOCIATED(real_arr_p(ip)%rap)) THEN
412 0 : DEALLOCATE (real_arr_p(ip)%rap)
413 : END IF
414 : END DO
415 :
416 : ! deallocate the memory used for pointer array itself
417 0 : IF (ASSOCIATED(real_arr_p)) THEN
418 0 : DEALLOCATE (real_arr_p)
419 : END IF
420 :
421 : RETURN
422 : END SUBROUTINE helium_destroy_real_arr_ptr
423 :
424 0 : END MODULE helium_types
|
