(git:58e3e09)
input_cp2k_restarts_util.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
11  cp_sll_val_type
13  section_type,&
15  section_vals_type
16  USE input_val_types, ONLY: val_create,&
17  val_release,&
18  val_type
19  USE kinds, ONLY: dp
20  USE particle_list_types, ONLY: particle_list_type
21 #include "./base/base_uses.f90"
22 
23  IMPLICIT NONE
24 
25  PRIVATE
26 
27  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_restarts_util'
28 
29  PUBLIC :: section_velocity_val_set
30 
31 CONTAINS
32 
33 ! **************************************************************************************************
34 !> \brief routine to dump velocities.. fast implementation
35 !> \param velocity_section ...
36 !> \param particles ...
37 !> \param velocity ...
38 !> \param conv_factor ...
39 !> \par History
40 !> 02.2006 created [teo]
41 !> \author Teodoro Laino
42 ! **************************************************************************************************
43  SUBROUTINE section_velocity_val_set(velocity_section, particles, velocity, conv_factor)
44 
45  TYPE(section_vals_type), POINTER :: velocity_section
46  TYPE(particle_list_type), OPTIONAL, POINTER :: particles
47  REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: velocity
48  REAL(kind=dp) :: conv_factor
49 
50  CHARACTER(LEN=*), PARAMETER :: routinen = 'section_velocity_val_set'
51 
52  INTEGER :: handle, ik, irk, nlist, nloop
53  LOGICAL :: check
54  REAL(kind=dp), DIMENSION(:), POINTER :: vel
55  TYPE(cp_sll_val_type), POINTER :: new_pos, vals
56  TYPE(section_type), POINTER :: section
57  TYPE(val_type), POINTER :: my_val, old_val
58 
59  CALL timeset(routinen, handle)
60  NULLIFY (my_val, old_val, section, vals)
61  cpassert(ASSOCIATED(velocity_section))
62  cpassert(velocity_section%ref_count > 0)
63  section => velocity_section%section
64  ik = section_get_keyword_index(section, "_DEFAULT_KEYWORD_")
65  IF (ik == -2) &
66  CALL cp_abort(__location__, &
67  "section "//trim(section%name)//" does not contain keyword "// &
68  "_DEFAULT_KEYWORD_")
69 
70  ! At least one of the two arguments must be present..
71  check = PRESENT(particles) .NEQV. PRESENT(velocity)
72  cpassert(check)
73  IF (PRESENT(particles)) nloop = particles%n_els
74  IF (PRESENT(velocity)) nloop = SIZE(velocity, 2)
75 
76  DO
77  IF (SIZE(velocity_section%values, 2) == 1) EXIT
78  CALL section_vals_add_values(velocity_section)
79  END DO
80  vals => velocity_section%values(ik, 1)%list
81  nlist = 0
82  IF (ASSOCIATED(vals)) THEN
83  nlist = cp_sll_val_get_length(vals)
84  END IF
85  DO irk = 1, nloop
86  ALLOCATE (vel(3))
87  ! Always stored in A.U.
88  IF (PRESENT(particles)) vel = particles%els(irk)%v(1:3)*conv_factor
89  IF (PRESENT(velocity)) vel = velocity(1:3, irk)*conv_factor
90 
91  CALL val_create(my_val, r_vals_ptr=vel)
92 
93  IF (nlist /= 0) THEN
94  IF (irk == 1) THEN
95  new_pos => vals
96  ELSE
97  new_pos => new_pos%rest
98  END IF
99  old_val => new_pos%first_el
100  CALL val_release(old_val)
101  new_pos%first_el => my_val
102  ELSE
103  IF (irk == 1) THEN
104  NULLIFY (new_pos)
105  CALL cp_sll_val_create(new_pos, first_el=my_val)
106  vals => new_pos
107  ELSE
108  NULLIFY (new_pos%rest)
109  CALL cp_sll_val_create(new_pos%rest, first_el=my_val)
110  new_pos => new_pos%rest
111  END IF
112  END IF
113  NULLIFY (my_val)
114  END DO
115 
116  velocity_section%values(ik, 1)%list => vals
117 
118  CALL timestop(handle)
119 
120  END SUBROUTINE section_velocity_val_set
121 
122 END MODULE input_cp2k_restarts_util
integer function, public cp_sll_val_get_length(sll)
returns the length of the list
subroutine, public cp_sll_val_create(sll, first_el, rest)
allocates and initializes a single linked list
subroutine, public section_velocity_val_set(velocity_section, particles, velocity, conv_factor)
routine to dump velocities.. fast implementation
objects that represent the structure of input sections and the data contained in an input section
integer function, public section_get_keyword_index(section, keyword_name)
returns the index of the requested keyword (or -2 if not found)
subroutine, public section_vals_add_values(section_vals)
adds the place to store the values of a repetition of the section
a wrapper for basic fortran types.
subroutine, public val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, r_val, r_vals, r_vals_ptr, c_val, c_vals, c_vals_ptr, lc_val, lc_vals, lc_vals_ptr, enum)
creates a keyword value
subroutine, public val_release(val)
releases the given val
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
represent a simple array based list of the given type