Line data Source code
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 :
8 : ! **************************************************************************************************
9 : !> \brief Work with symmetry
10 : !> \par History
11 : !> \author jgh
12 : ! **************************************************************************************************
13 : MODULE cp_symmetry
14 : USE atomic_kind_types, ONLY: get_atomic_kind
15 : USE cell_types, ONLY: cell_type,&
16 : real_to_scaled
17 : USE cp_log_handling, ONLY: cp_get_default_logger,&
18 : cp_logger_type
19 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
20 : cp_print_key_unit_nr
21 : USE cryssym, ONLY: crys_sym_gen,&
22 : csym_type,&
23 : print_crys_symmetry,&
24 : release_csym_type
25 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
26 : section_vals_type,&
27 : section_vals_val_get
28 : USE kinds, ONLY: dp
29 : USE molsym, ONLY: molecular_symmetry,&
30 : molsym_type,&
31 : print_symmetry,&
32 : release_molsym
33 : USE particle_types, ONLY: particle_type
34 : USE physcon, ONLY: massunit
35 : USE string_utilities, ONLY: uppercase
36 : #include "./base/base_uses.f90"
37 :
38 : IMPLICIT NONE
39 :
40 : PRIVATE
41 :
42 : ! Global parameters (in this module)
43 :
44 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_symmetry'
45 :
46 : PUBLIC :: write_symmetry
47 :
48 : ! **************************************************************************************************
49 :
50 : CONTAINS
51 :
52 : ! **************************************************************************************************
53 : !> \brief Write symmetry information to output
54 : !> \param particle_set Atom coordinates and types
55 : !> \param cell Cell information
56 : !> \param input_section Input
57 : !> \par History
58 : !> \author jgh
59 : ! **************************************************************************************************
60 9983 : SUBROUTINE write_symmetry(particle_set, cell, input_section)
61 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
62 : TYPE(cell_type), POINTER :: cell
63 : TYPE(section_vals_type), POINTER :: input_section
64 :
65 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_symmetry'
66 :
67 9983 : CHARACTER(LEN=2), ALLOCATABLE, DIMENSION(:) :: element
68 : CHARACTER(LEN=8) :: csymm, esymm
69 : INTEGER :: handle, i, iw, natom, plevel
70 19966 : INTEGER, ALLOCATABLE, DIMENSION(:) :: atype, z
71 : LOGICAL :: check, molecular, pall, pcoor, pinertia, &
72 : prmat, psymmele
73 : REAL(KIND=dp) :: eps_geo
74 9983 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: weight
75 9983 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: coord, scoord
76 : TYPE(cp_logger_type), POINTER :: logger
77 8814989 : TYPE(csym_type) :: crys_sym
78 : TYPE(molsym_type), POINTER :: mol_sym
79 : TYPE(section_vals_type), POINTER :: section
80 :
81 9983 : CALL timeset(routineN, handle)
82 :
83 9983 : NULLIFY (logger)
84 9983 : NULLIFY (section)
85 :
86 9983 : logger => cp_get_default_logger()
87 : iw = cp_print_key_unit_nr(logger=logger, &
88 : basis_section=input_section, &
89 : print_key_path="PRINT%SYMMETRY", &
90 9983 : extension=".symLog")
91 :
92 9983 : IF (iw > 0) THEN
93 : section => section_vals_get_subs_vals(section_vals=input_section, &
94 351 : subsection_name="PRINT%SYMMETRY")
95 : CALL section_vals_val_get(section_vals=section, &
96 351 : keyword_name="MOLECULE", l_val=molecular)
97 : CALL section_vals_val_get(section_vals=section, &
98 351 : keyword_name="EPS_GEO", r_val=eps_geo)
99 351 : IF (molecular) THEN
100 :
101 58 : NULLIFY (mol_sym)
102 :
103 58 : natom = SIZE(particle_set)
104 522 : ALLOCATE (coord(3, natom), z(natom), weight(natom), atype(natom), element(natom))
105 :
106 633 : DO i = 1, natom
107 575 : CALL get_atomic_kind(particle_set(i)%atomic_kind, z=z(i))
108 : CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, &
109 575 : kind_number=atype(i), element_symbol=element(i), mass=weight(i))
110 2358 : coord(1:3, i) = particle_set(i)%r(1:3)
111 : END DO
112 633 : weight(:) = weight(:)/massunit
113 :
114 58 : CALL molecular_symmetry(mol_sym, eps_geo, coord, atype, weight)
115 :
116 : CALL section_vals_val_get(section_vals=section, &
117 58 : keyword_name="STANDARD_ORIENTATION", l_val=pcoor)
118 : CALL section_vals_val_get(section_vals=section, &
119 58 : keyword_name="INERTIA", l_val=pinertia)
120 : CALL section_vals_val_get(section_vals=section, &
121 58 : keyword_name="SYMMETRY_ELEMENTS", l_val=psymmele)
122 : CALL section_vals_val_get(section_vals=section, &
123 58 : keyword_name="ALL", l_val=pall)
124 58 : plevel = 0
125 58 : IF (pcoor) plevel = plevel + 1
126 58 : IF (pinertia) plevel = plevel + 10
127 58 : IF (psymmele) plevel = plevel + 100
128 58 : IF (pall) plevel = 1111111111
129 :
130 58 : CALL print_symmetry(mol_sym, coord, atype, element, z, weight, iw, plevel)
131 :
132 : CALL section_vals_val_get(section_vals=section, &
133 58 : keyword_name="CHECK_SYMMETRY", c_val=esymm)
134 58 : CALL uppercase(esymm)
135 58 : IF (TRIM(esymm) /= "NONE") THEN
136 58 : csymm = mol_sym%point_group_symbol
137 58 : CALL uppercase(csymm)
138 58 : check = TRIM(ADJUSTL(csymm)) == TRIM(ADJUSTL(esymm))
139 58 : IF (.NOT. check) THEN
140 : CALL cp_warn(__LOCATION__, "Symmetry check failed: "// &
141 : "Expected symmetry:"//TRIM(ADJUSTL(esymm))// &
142 0 : "Calculated symmetry:"//TRIM(ADJUSTL(csymm)))
143 : END IF
144 0 : CPASSERT(check)
145 : END IF
146 :
147 58 : DEALLOCATE (coord, z, weight, atype, element)
148 :
149 116 : CALL release_molsym(mol_sym)
150 :
151 : ELSE
152 : ! Crystal symmetry
153 :
154 293 : natom = SIZE(particle_set)
155 1465 : ALLOCATE (scoord(3, natom), atype(natom))
156 :
157 4366 : DO i = 1, natom
158 4073 : CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, kind_number=atype(i))
159 4366 : CALL real_to_scaled(scoord(1:3, i), particle_set(i)%r(1:3), cell)
160 : END DO
161 :
162 293 : CALL crys_sym_gen(crys_sym, scoord, atype, cell%hmat, delta=eps_geo, iounit=iw)
163 :
164 : CALL section_vals_val_get(section_vals=section, &
165 293 : keyword_name="ROTATION_MATRICES", l_val=prmat)
166 : CALL section_vals_val_get(section_vals=section, &
167 293 : keyword_name="ALL", l_val=pall)
168 293 : plevel = 0
169 293 : IF (prmat) plevel = plevel + 1
170 293 : IF (pall) plevel = 1111111111
171 293 : crys_sym%plevel = plevel
172 :
173 293 : CALL print_crys_symmetry(crys_sym)
174 :
175 293 : DEALLOCATE (scoord, atype)
176 :
177 586 : CALL release_csym_type(crys_sym)
178 :
179 : END IF
180 :
181 : END IF
182 9983 : CALL cp_print_key_finished_output(iw, logger, input_section, "PRINT%SYMMETRY")
183 :
184 9983 : CALL timestop(handle)
185 :
186 9983 : END SUBROUTINE write_symmetry
187 :
188 : ! **************************************************************************************************
189 :
190 : END MODULE cp_symmetry
|
