Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 periodic cell (if periodic) or COM of helium
125 :
126 : INTEGER :: sampling_method = helium_sampling_ceperley
127 : ! worm sampling parameters
128 : REAL(KIND=dp) :: worm_centroid_drmax = 0.0_dp
129 : INTEGER :: worm_nstat = 0
130 : INTEGER :: worm_staging_l = 0
131 : INTEGER :: worm_repeat_crawl = 0
132 : INTEGER :: worm_all_limit = 0
133 : INTEGER :: worm_centroid_min = 0, worm_centroid_max = 0
134 : INTEGER :: worm_staging_min = 0, worm_staging_max = 0
135 : INTEGER :: worm_fcrawl_min = 0, worm_fcrawl_max = 0
136 : INTEGER :: worm_bcrawl_min = 0, worm_bcrawl_max = 0
137 : INTEGER :: worm_head_min = 0, worm_head_max = 0
138 : INTEGER :: worm_tail_min = 0, worm_tail_max = 0
139 : INTEGER :: worm_swap_min = 0, worm_swap_max = 0
140 : INTEGER :: worm_open_close_min = 0, worm_open_close_max = 0
141 : INTEGER :: worm_max_open_cycles = 0
142 : REAL(KIND=dp) :: worm_open_close_scale = 0.0_dp
143 : REAL(KIND=dp) :: worm_ln_openclose_scale = 0.0_dp
144 : LOGICAL :: worm_allow_open = .FALSE., worm_show_statistics = .FALSE.
145 :
146 : ! worm specific variables
147 : REAL(KIND=dp), DIMENSION(3) :: worm_xtra_bead = 0.0_dp, worm_xtra_bead_work = 0.0_dp
148 : INTEGER :: worm_atom_idx = 0, worm_bead_idx = 0
149 : INTEGER :: worm_atom_idx_work = 0, worm_bead_idx_work = 0
150 : INTEGER :: iw = 0, it = 0
151 : LOGICAL :: worm_is_closed = .FALSE.!before isector=1 -> open; isector=0 -> closed
152 :
153 : INTEGER :: iter_norot = 0!< number of iterations to try for a given imaginary time slice rotation (num inner MC loop iters)
154 : INTEGER :: iter_rot = 0!< number of rotations to try (total number of iterations is iter_norot*iter_rot) (num outer MC loop iters)
155 : !
156 : INTEGER :: maxcycle = 0!< maximum cyclic permutation change to attempt
157 : INTEGER :: m_dist_type = 0!< distribution from which the cycle length m is sampled
158 : INTEGER :: m_value = 0!< cycle length sampled with different probability than other lengths
159 : REAL(KIND=dp) :: m_ratio = 0.0_dp!< probability ratio betw m_value and other possible values of m
160 : !
161 : INTEGER :: relrot = 0!< relative rotation in imaginary time wrt normal system/starting configuration
162 : INTEGER :: bisection = 0 !< power of 2 number for bisection algorithm
163 : INTEGER :: bisctlog2 = 0!< log2(bisection)
164 :
165 : REAL(KIND=dp) :: e_corr = 0.0_dp !< potential correction energy due to finite box
166 : INTEGER :: pdx = 0!< pair density expansion max exponent
167 :
168 : ! MC step counters
169 : !
170 : INTEGER :: num_steps = 0!< number of iterations in the current run
171 : INTEGER :: first_step = 0!< first step, restarted from MOTION%PINT%ITERATION (default value: 0)
172 : INTEGER :: last_step = 0
173 : INTEGER :: current_step = 0 !< first_step + number of steps performed so far
174 :
175 : ! helium variables
176 : !
177 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: pos => NULL()!< position of the helium atoms DIM(3,atoms,beads)
178 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: savepos => NULL()!< saved position of the helium atoms DIM(3,atoms,beads)
179 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: work => NULL()!< same dimensions as pos
180 : !
181 : INTEGER, DIMENSION(:), POINTER :: permutation => NULL()!< current permutation state DIM(atoms)
182 : INTEGER, DIMENSION(:), POINTER :: savepermutation => NULL()!< saved permutation state DIM(atoms)
183 : INTEGER, DIMENSION(:), POINTER :: iperm => NULL()!< inverse of the current permutation state DIM(atoms)
184 : INTEGER, DIMENSION(:), POINTER :: saveiperm => NULL()!< saved inverse of the current permutation state DIM(atoms)
185 : INTEGER, DIMENSION(:), POINTER :: ptable => NULL()!< proposed cyclic permutation, DIM(max_cycle)
186 : INTEGER(KIND=int_8) :: accepts = 0_int_8!< number of accepted new configurations
187 : !
188 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: tmatrix => NULL()!< ? permutation probability related
189 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: pmatrix => NULL()!< ? permutation probability related [use might change/new ones added/etc]
190 : REAL(KIND=dp) :: pweight = 0.0_dp!< ? permutation probability related
191 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: ipmatrix => NULL()
192 : INTEGER, DIMENSION(:, :), POINTER :: nmatrix => NULL()
193 :
194 : TYPE(spline_data_type), POINTER :: vij => NULL()!< physical pair potential energy
195 : TYPE(spline_data_type), POINTER :: u0 => NULL()!< pair density matrix coefficient (action) endpoint approx
196 : TYPE(spline_data_type), POINTER :: e0 => NULL()!< pair density matrix coefficient (energy) endpoint approx
197 : !< raw spline data for pair density matrix off diagonal expansion beyond endpoint approx:
198 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :, :), POINTER :: uoffdiag => NULL()!< (action)
199 : REAL(KIND=dp), CONTIGUOUS, DIMENSION(:, :, :), POINTER :: eoffdiag => NULL()!< (energy)
200 :
201 : ! calculated properties
202 : !
203 : REAL(KIND=dp), DIMENSION(e_num_ids) :: energy_inst = 0.0_dp!< energy contributions (instantaneous)
204 : REAL(KIND=dp), DIMENSION(e_num_ids) :: energy_avrg = 0.0_dp!< energy contributions (averaged)
205 : TYPE(helium_vector_type) :: wnumber = helium_vector_type()!< winding number
206 : TYPE(helium_vector_type) :: wnmber2 = helium_vector_type()!< winding number squared
207 : TYPE(helium_vector_type) :: proarea = helium_vector_type()!< projected area
208 : TYPE(helium_vector_type) :: prarea2 = helium_vector_type()!< projected area squared
209 : TYPE(helium_vector_type) :: mominer = helium_vector_type()!< moment of inertia
210 : INTEGER :: averages_iweight = 0!< weight for restarted averages
211 : LOGICAL :: averages_restarted = .FALSE.!< flag indicating whether the averages have been restarted
212 :
213 : REAL(KIND=dp) :: link_action = 0.0_dp, inter_action = 0.0_dp, pair_action = 0.0_dp
214 :
215 : !
216 : INTEGER :: rdf_nbin = 0!< number of bins for RDF
217 : INTEGER :: rdf_iweight = 0 !< weight for restarted RDF
218 : INTEGER :: rho_iweight = 0!< weight for restarted RHO
219 : INTEGER :: rdf_num = 0!< number of X-He-RDFs
220 : INTEGER :: rdf_num_ctr = 0 !< number of centers for RDF calc
221 : REAL(KIND=dp) :: rdf_delr = 0.0_dp!< delta r for RDF
222 : REAL(KIND=dp) :: rdf_maxr = 0.0_dp!< maximum r for RDF
223 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_centers => NULL() !< positions of RDF solute centers
224 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_inst => NULL()!< RDF (instantaneous/tmp array)
225 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_rstr => NULL()!< RDF (restarted)
226 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rdf_accu => NULL()!< RDF (accumulated for one run)
227 : LOGICAL :: rdf_present = .FALSE.
228 : LOGICAL :: rdf_sol_he = .FALSE.
229 : LOGICAL :: rdf_he_he = .FALSE.
230 : !
231 : INTEGER :: rho_nbin = 0
232 : INTEGER :: rho_num_act = 0!< actual number of density estimators
233 : INTEGER :: rho_num_min_len_wdg = 0!< number of optional estimators based on winding cycles
234 : INTEGER :: rho_num_min_len_non = 0!< number of optional estimators based on non-winding cycles
235 : INTEGER :: rho_num_min_len_all = 0!< number of optional estimators based on all cycles
236 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_wdg_vals => NULL()!< minimum lengths of winding cycles
237 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_non_vals => NULL()!< minimum lengths of non-winding cycles
238 : INTEGER, DIMENSION(:), POINTER :: rho_min_len_all_vals => NULL()!< minimum lengths of all cycles
239 : REAL(KIND=dp) :: rho_delr = 0.0_dp, rho_maxr = 0.0_dp
240 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_inst => NULL()
241 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_rstr => NULL()
242 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: rho_accu => NULL()
243 : LOGICAL :: rho_present = .FALSE.
244 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: rho_incr => NULL()!< increment for density bining
245 :
246 : TYPE(density_properties_type), DIMENSION(:), POINTER :: rho_property => NULL()
247 :
248 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: num_accepted => NULL()!< average number of accepted permutations of a given length
249 : !! on a given Levy level, plus one additional level which
250 : !! counts # of trials, REAL(BISCTLOG2+2, MAX_PERM_CYCLE)
251 : !! num_accepted(1,l) - # of trials for perm length l
252 : !! num_accepted(2,l) - # of selected perms of length l
253 : !! num_accepted(3,l) - # of perms of length l accepted at level 1
254 : !! average over He environments/processors
255 : REAL(KIND=dp), DIMENSION(:), POINTER :: plength_avrg => NULL()!< permutation length probability distribution DIM(atoms)
256 : REAL(KIND=dp), DIMENSION(:), POINTER :: plength_inst => NULL()!< instantaneous permutation length probability DIM(atoms)
257 : INTEGER, DIMENSION(:), POINTER :: atom_plength => NULL()!< length of the permutation cycle the atom belongs to DIM(atoms)
258 :
259 : TYPE(rng_stream_type), POINTER :: rng_stream_uniform => NULL()!< random number stream with uniform distribution
260 : TYPE(rng_stream_type), POINTER :: rng_stream_gaussian => NULL()!< random number stream with gaussian distribution
261 :
262 : ! variables related to solvated molecular system
263 : !
264 : LOGICAL :: solute_present = .FALSE.!< switch the interactions with the solute on or off
265 : INTEGER :: solute_atoms = 0!< number of solute atoms (pint_env%ndim/3)
266 : INTEGER :: solute_beads = 0!< number of solute beads (pint_env%p)
267 : INTEGER :: get_helium_forces = 0!< parameter to determine whether the average or last MC force should be taken to MD
268 : CHARACTER(LEN=2), DIMENSION(:), POINTER :: solute_element => NULL()!< element names of solute atoms (pint_env%ndim/3)
269 : TYPE(cell_type), POINTER :: solute_cell => NULL()!< dimensions of the solvated system cell (a,b,c) (should be removed at some point)
270 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_avrg => NULL()!< averaged forces exerted by He solvent on the solute DIM(p,ndim)
271 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_inst => NULL()!< instantaneous forces exerted by He on the solute (p,ndim)
272 : CHARACTER(LEN=2), DIMENSION(:), POINTER :: ename => NULL()
273 : INTEGER :: enum = 0
274 : INTEGER :: solute_interaction = 0
275 :
276 : LOGICAL :: interaction_pot_scan = .FALSE.!< whether to perform solute-helium interaction scan
277 :
278 : TYPE(nnp_type), POINTER :: nnp => NULL() !< neural network potential
279 : REAL(KIND=dp), DIMENSION(:), POINTER :: nnp_sr_cut => NULL() !< hard core cutoff in addition to the nnp
280 :
281 : ! temporary arrays for optimization
282 : !
283 : INTEGER, DIMENSION(:), POINTER :: itmp_atoms_1d => NULL()!< DIM(atoms) - same as permutation
284 : INTEGER, DIMENSION(:), POINTER :: itmp_atoms_np_1d => NULL()!< DIM(atoms*num_env)
285 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_np_1d => NULL()!< DIM(3*num_env)
286 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_p_ndim_1d => NULL()!< DIM(p*ndim)
287 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_p_ndim_np_1d => NULL()!< DIM(p*ndim*num_env)
288 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_atoms_beads_1d => NULL()!< DIM(3*atoms*beads)
289 : REAL(KIND=dp), DIMENSION(:), POINTER :: rtmp_3_atoms_beads_np_1d => NULL()
290 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rtmp_p_ndim_2d => NULL()!< DIM(p,ndim)
291 : LOGICAL, DIMENSION(:, :, :), POINTER :: ltmp_3_atoms_beads_3d => NULL()!< DIM(3,atoms,beads) - same as pos
292 : LOGICAL, DIMENSION(:), POINTER :: ltmp_atoms_1d => NULL()!< DIM(atoms) - for unpacking the permutation
293 :
294 : END TYPE helium_solvent_type
295 :
296 : ! ***************************************************************************
297 : !> \brief data structure for array of solvent helium environments
298 : !> \author cschran
299 : ! ***************************************************************************
300 : TYPE helium_solvent_p_type
301 : TYPE(helium_solvent_type), POINTER :: helium => NULL()
302 : TYPE(mp_para_env_type), POINTER :: comm => NULL()
303 : INTEGER, DIMENSION(:), POINTER :: env_all => NULL()
304 : END TYPE helium_solvent_p_type
305 :
306 : ! ***************************************************************************
307 : !> \brief Container type for properties of a helium density function
308 : !> \author Lukasz Walewski
309 : !> \date 2014-09-09
310 : ! ***************************************************************************
311 : TYPE density_properties_type
312 :
313 : !> name of this density function
314 : CHARACTER(len=default_string_length) :: name = ""
315 :
316 : !> flag indicating whether this function should be calculated
317 : LOGICAL :: is_calculated = .FALSE.
318 :
319 : !> number of components that this function is composed of
320 : INTEGER :: num_components = 0
321 :
322 : !> suffixes for the filenames storing components of this function
323 : CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: filename_suffix => NULL()
324 :
325 : !> component names
326 : CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: component_name => NULL()
327 :
328 : !> indices locating the components of this function in the global density arrays
329 : INTEGER, DIMENSION(:), POINTER :: component_index => NULL()
330 :
331 : END TYPE density_properties_type
332 :
333 : ! ***************************************************************************
334 : !> \brief A pointer to an integer array, data type to be used in arrays of
335 : !> pointers.
336 : !> \author Lukasz Walewski
337 : !> \date 2013-12-11
338 : ! ***************************************************************************
339 : TYPE int_arr_ptr
340 : INTEGER, DIMENSION(:), POINTER :: iap => NULL()
341 : END TYPE int_arr_ptr
342 :
343 : ! ***************************************************************************
344 : !> \brief A pointer to a real array, data type to be used in arrays of
345 : !> pointers.
346 : !> \author Lukasz Walewski
347 : !> \date 2013-12-11
348 : ! ***************************************************************************
349 : TYPE real_arr_ptr
350 : REAL(KIND=dp), DIMENSION(:), POINTER :: rap => NULL()
351 : END TYPE real_arr_ptr
352 :
353 : CONTAINS
354 :
355 : ! ***************************************************************************
356 : !> \brief Deallocate all arrays pointed to by the pointers stored in the
357 : !> integer pointer array
358 : !> \param int_arr_p ...
359 : !> \date 2013-12-12
360 : !> \author Lukasz Walewski
361 : ! **************************************************************************************************
362 0 : SUBROUTINE helium_destroy_int_arr_ptr(int_arr_p)
363 :
364 : TYPE(int_arr_ptr), DIMENSION(:), POINTER :: int_arr_p
365 :
366 : INTEGER :: ip
367 :
368 : ! deallocate memory used by each component of the pointer array
369 :
370 0 : DO ip = 1, SIZE(int_arr_p)
371 0 : IF (ASSOCIATED(int_arr_p(ip)%iap)) THEN
372 0 : DEALLOCATE (int_arr_p(ip)%iap)
373 : END IF
374 : END DO
375 :
376 : ! deallocate the memory used for pointer array
377 0 : IF (ASSOCIATED(int_arr_p)) THEN
378 0 : DEALLOCATE (int_arr_p)
379 : END IF
380 :
381 0 : RETURN
382 : END SUBROUTINE helium_destroy_int_arr_ptr
383 :
384 : ! ***************************************************************************
385 : !> \brief Deallocate all arrays pointed to by the pointers stored in the
386 : !> real pointer array
387 : !> \param real_arr_p ...
388 : !> \date 2013-12-12
389 : !> \author Lukasz Walewski
390 : ! **************************************************************************************************
391 0 : SUBROUTINE helium_destroy_real_arr_ptr(real_arr_p)
392 :
393 : TYPE(real_arr_ptr), DIMENSION(:), POINTER :: real_arr_p
394 :
395 : INTEGER :: ip
396 :
397 : ! do not attempt deallocation on null pointer
398 :
399 0 : IF (.NOT. ASSOCIATED(real_arr_p)) THEN
400 : RETURN
401 : END IF
402 :
403 : ! deallocate memory used by each component of the pointer array
404 0 : DO ip = 1, SIZE(real_arr_p)
405 0 : IF (ASSOCIATED(real_arr_p(ip)%rap)) THEN
406 0 : DEALLOCATE (real_arr_p(ip)%rap)
407 : END IF
408 : END DO
409 :
410 : ! deallocate the memory used for pointer array itself
411 0 : IF (ASSOCIATED(real_arr_p)) THEN
412 0 : DEALLOCATE (real_arr_p)
413 : END IF
414 :
415 : RETURN
416 : END SUBROUTINE helium_destroy_real_arr_ptr
417 :
418 0 : END MODULE helium_types
|
