1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright (C) 2000 - 2018 CP2K developers group !
!--------------------------------------------------------------------------------------------------!
MODULE input_cp2k_restarts_util
USE cp_linked_list_input, ONLY: cp_sll_val_create,&
cp_sll_val_get_length,&
cp_sll_val_type
USE input_section_types, ONLY: section_get_keyword_index,&
section_type,&
section_vals_add_values,&
section_vals_type
USE input_val_types, ONLY: val_create,&
val_release,&
val_type
USE kinds, ONLY: dp
USE particle_list_types, ONLY: particle_list_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_restarts_util'
PUBLIC :: section_velocity_val_set
CONTAINS
! **************************************************************************************************
!> \brief routine to dump velocities.. fast implementation
!> \param velocity_section ...
!> \param particles ...
!> \param velocity ...
!> \param conv_factor ...
!> \par History
!> 02.2006 created [teo]
!> \author Teodoro Laino
! **************************************************************************************************
SUBROUTINE section_velocity_val_set(velocity_section, particles, velocity, conv_factor)
TYPE(section_vals_type), POINTER :: velocity_section
TYPE(particle_list_type), OPTIONAL, POINTER :: particles
REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: velocity
REAL(KIND=dp) :: conv_factor
CHARACTER(LEN=*), PARAMETER :: routineN = 'section_velocity_val_set', &
routineP = moduleN//':'//routineN
INTEGER :: handle, ik, irk, Nlist, nloop
LOGICAL :: check
REAL(KIND=dp), DIMENSION(:), POINTER :: vel
TYPE(cp_sll_val_type), POINTER :: new_pos, vals
TYPE(section_type), POINTER :: section
TYPE(val_type), POINTER :: my_val, old_val
CALL timeset(routineN, handle)
NULLIFY (my_val, old_val, section, vals)
CPASSERT(ASSOCIATED(velocity_section))
CPASSERT(velocity_section%ref_count > 0)
section => velocity_section%section
ik = section_get_keyword_index(section, "_DEFAULT_KEYWORD_")
IF (ik == -2) &
CALL cp_abort(__LOCATION__, &
"section "//TRIM(section%name)//" does not contain keyword "// &
"_DEFAULT_KEYWORD_")
! At least one of the two arguments must be present..
check = PRESENT(particles) .NEQV. PRESENT(velocity)
CPASSERT(check)
IF (PRESENT(particles)) nloop = particles%n_els
IF (PRESENT(velocity)) nloop = SIZE(velocity, 2)
DO
IF (SIZE(velocity_section%values, 2) == 1) EXIT
CALL section_vals_add_values(velocity_section)
END DO
vals => velocity_section%values(ik, 1)%list
Nlist = 0
IF (ASSOCIATED(vals)) THEN
Nlist = cp_sll_val_get_length(vals)
END IF
DO irk = 1, nloop
ALLOCATE (vel(3))
! Always stored in A.U.
IF (PRESENT(particles)) vel = particles%els(irk)%v(1:3)*conv_factor
IF (PRESENT(velocity)) vel = velocity(1:3, irk)*conv_factor
CALL val_create(my_val, r_vals_ptr=vel)
IF (Nlist /= 0) THEN
IF (irk == 1) THEN
new_pos => vals
ELSE
new_pos => new_pos%rest
END IF
old_val => new_pos%first_el
CALL val_release(old_val)
new_pos%first_el => my_val
ELSE
IF (irk == 1) THEN
NULLIFY (new_pos)
CALL cp_sll_val_create(new_pos, first_el=my_val)
vals => new_pos
ELSE
NULLIFY (new_pos%rest)
CALL cp_sll_val_create(new_pos%rest, first_el=my_val)
new_pos => new_pos%rest
END IF
END IF
NULLIFY (my_val)
END DO
velocity_section%values(ik, 1)%list => vals
CALL timestop(handle)
END SUBROUTINE section_velocity_val_set
END MODULE input_cp2k_restarts_util
|
