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 unit conversion facility
10 : !>
11 : !> Units are complex, this module does not try to be very smart, for
12 : !> example SI prefixes are not supported automatically, and
13 : !> which kinds are really basic can change depending on the system of
14 : !> units chosen, and equivalences are not always catched.
15 : !>
16 : !> This is thought as a simple conversion facility for the input and output.
17 : !> If you need something more you are probably better off using the
18 : !> physcon module directly.
19 : !> \note
20 : !> One design choice was not to use dynamically allocated elements to
21 : !> reduce the possibility of leaks.
22 : !> Needs to be extended (for example charge, dipole,...)
23 : !> I just added the units and kinds that I needed.
24 : !> Used by the parser
25 : !> Should keep an unsorted/uncompressed version for nicer labels?
26 : !> \par History
27 : !> 01.2005 created [fawzi]
28 : !> \author fawzi
29 : ! **************************************************************************************************
30 : MODULE cp_units
31 :
32 : USE cp_log_handling, ONLY: cp_to_string
33 : USE kinds, ONLY: dp
34 : USE mathconstants, ONLY: radians,&
35 : twopi
36 : USE physcon, ONLY: &
37 : atm, bar, bohr, e_mass, evolt, femtoseconds, joule, kcalmol, kelvin, kjmol, massunit, &
38 : newton, pascal, picoseconds, seconds, wavenumbers
39 : USE string_utilities, ONLY: compress,&
40 : s2a,&
41 : uppercase
42 : #include "../base/base_uses.f90"
43 :
44 : IMPLICIT NONE
45 : PRIVATE
46 :
47 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_units'
49 :
50 : INTEGER, PARAMETER, PUBLIC :: cp_ukind_none = 0, &
51 : cp_ukind_energy = 1, &
52 : cp_ukind_length = 2, &
53 : cp_ukind_temperature = 3, &
54 : cp_ukind_angle = 4, &
55 : cp_ukind_pressure = 5, &
56 : cp_ukind_time = 6, &
57 : cp_ukind_mass = 7, &
58 : cp_ukind_undef = 8, &
59 : cp_ukind_potential = 9, &
60 : cp_ukind_force = 10, &
61 : cp_ukind_max = 10
62 :
63 : ! General
64 : INTEGER, PARAMETER, PUBLIC :: cp_units_none = 100, &
65 : cp_units_au = 101
66 : ! Mass
67 : INTEGER, PARAMETER, PUBLIC :: cp_units_m_e = 110, &
68 : cp_units_amu = 111, &
69 : cp_units_kg = 112
70 : ! Energy
71 : INTEGER, PARAMETER, PUBLIC :: cp_units_hartree = 130, &
72 : cp_units_wavenum = 131, &
73 : cp_units_joule = 132, &
74 : cp_units_kcalmol = 133, &
75 : cp_units_Ry = 134, &
76 : cp_units_eV = 135, &
77 : cp_units_kjmol = 136, &
78 : cp_units_jmol = 137, &
79 : cp_units_keV = 138
80 :
81 : ! Length
82 : INTEGER, PARAMETER, PUBLIC :: cp_units_bohr = 140, &
83 : cp_units_angstrom = 141, &
84 : cp_units_m = 142, &
85 : cp_units_pm = 143, &
86 : cp_units_nm = 144
87 :
88 : ! Temperature
89 : INTEGER, PARAMETER, PUBLIC :: cp_units_k = 150
90 :
91 : ! Pressure
92 : INTEGER, PARAMETER, PUBLIC :: cp_units_bar = 161
93 : INTEGER, PARAMETER, PUBLIC :: cp_units_atm = 162
94 : INTEGER, PARAMETER, PUBLIC :: cp_units_kbar = 163
95 : INTEGER, PARAMETER, PUBLIC :: cp_units_Pa = 164
96 : INTEGER, PARAMETER, PUBLIC :: cp_units_MPa = 165
97 : INTEGER, PARAMETER, PUBLIC :: cp_units_GPa = 166
98 :
99 : ! Angles
100 : INTEGER, PARAMETER, PUBLIC :: cp_units_rad = 170, &
101 : cp_units_deg = 171
102 :
103 : ! Time
104 : INTEGER, PARAMETER, PUBLIC :: cp_units_fs = 180, &
105 : cp_units_s = 181, &
106 : cp_units_wn = 182, &
107 : cp_units_ps = 183
108 :
109 : ! Potential
110 : INTEGER, PARAMETER, PUBLIC :: cp_units_volt = 190
111 :
112 : ! Force
113 : INTEGER, PARAMETER, PUBLIC :: cp_units_Newton = 200, &
114 : cp_units_mNewton = 201
115 :
116 : INTEGER, PARAMETER, PUBLIC :: cp_unit_max_kinds = 8, cp_unit_basic_desc_length = 15, &
117 : cp_unit_desc_length = cp_unit_max_kinds*cp_unit_basic_desc_length
118 :
119 : PUBLIC :: cp_unit_type, cp_unit_set_type
120 : PUBLIC :: cp_unit_create, cp_unit_release, &
121 : cp_unit_to_cp2k, cp_unit_from_cp2k, cp_unit_desc, &
122 : cp_unit_set_create, cp_unit_set_release, &
123 : cp_unit_to_cp2k1, cp_unit_from_cp2k1, cp_unit_compatible, export_units_as_xml
124 :
125 : ! **************************************************************************************************
126 : !> \brief stores a unit
127 : !> \param kind the kind of unit (energy, length,...)
128 : !> \param unit the actual unit (Joule, eV,...)
129 : !> \author fawzi
130 : ! **************************************************************************************************
131 : TYPE cp_unit_type
132 : INTEGER :: n_kinds = -1
133 : INTEGER, DIMENSION(cp_unit_max_kinds):: kind_id = -1, unit_id = -1, power = -1
134 : END TYPE cp_unit_type
135 :
136 : ! **************************************************************************************************
137 : !> \brief represent a pointer to a unit (to build arrays of pointers)
138 : !> \param unit the pointer to the unit
139 : !> \author fawzi
140 : ! **************************************************************************************************
141 : TYPE cp_unit_p_type
142 : TYPE(cp_unit_type), POINTER :: unit => NULL()
143 : END TYPE cp_unit_p_type
144 :
145 : ! **************************************************************************************************
146 : !> \brief stores the default units to be used
147 : !> \author fawzi
148 : ! **************************************************************************************************
149 : TYPE cp_unit_set_type
150 : TYPE(cp_unit_p_type), DIMENSION(cp_ukind_max) :: units = cp_unit_p_type()
151 : END TYPE cp_unit_set_type
152 :
153 : CONTAINS
154 :
155 : ! **************************************************************************************************
156 : !> \brief creates a unit parsing a string
157 : !> \param unit the unit to initialize
158 : !> \param string the string containing the description of the unit
159 : !> \author fawzi
160 : ! **************************************************************************************************
161 493885450 : SUBROUTINE cp_unit_create(unit, string)
162 : TYPE(cp_unit_type), INTENT(OUT) :: unit
163 : CHARACTER(len=*), INTENT(in) :: string
164 :
165 : CHARACTER(LEN=40) :: formatstr
166 : CHARACTER(LEN=cp_unit_desc_length) :: desc
167 19755418 : CHARACTER(LEN=LEN(string)) :: unit_string
168 : INTEGER :: i_high, i_low, i_unit, len_string, &
169 : next_power
170 : INTEGER, DIMENSION(cp_unit_max_kinds) :: kind_id, power, unit_id
171 :
172 177798762 : unit_id = cp_units_none
173 19755418 : kind_id = cp_ukind_none
174 19755418 : power = 0
175 19755418 : i_low = 1
176 19755418 : i_high = 1
177 19755418 : len_string = LEN(string)
178 19755418 : i_unit = 0
179 19755418 : next_power = 1
180 19755418 : DO WHILE (i_low < len_string)
181 18880944 : IF (string(i_low:i_low) /= ' ') EXIT
182 18880944 : i_low = i_low + 1
183 : END DO
184 : i_high = i_low
185 130012517 : DO WHILE (i_high <= len_string)
186 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
187 112392368 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
188 110257168 : i_high = i_high + 1
189 : END DO
190 : DO
191 20691580 : IF (i_high <= i_low .OR. i_low > len_string) EXIT
192 20635855 : i_unit = i_unit + 1
193 20635855 : IF (i_unit > cp_unit_max_kinds) THEN
194 0 : CPABORT("Maximum number of combined units exceeded")
195 0 : EXIT
196 : END IF
197 : ! read unit
198 20635855 : unit_string = string(i_low:i_high - 1)
199 20635855 : CALL uppercase(unit_string)
200 21543663 : SELECT CASE (TRIM(unit_string))
201 : CASE ("INTERNAL_CP2K")
202 907808 : unit_id(i_unit) = cp_units_none
203 907808 : kind_id(i_unit) = cp_ukind_undef
204 : CASE ("HARTREE")
205 960909 : unit_id(i_unit) = cp_units_hartree
206 960909 : kind_id(i_unit) = cp_ukind_energy
207 : CASE ("AU_E")
208 108912 : unit_id(i_unit) = cp_units_au
209 108912 : kind_id(i_unit) = cp_ukind_energy
210 : CASE ("WAVENUMBER_E")
211 0 : unit_id(i_unit) = cp_units_wavenum
212 0 : kind_id(i_unit) = cp_ukind_energy
213 : CASE ("JOULE", "J")
214 0 : unit_id(i_unit) = cp_units_joule
215 0 : kind_id(i_unit) = cp_ukind_energy
216 : CASE ("KCALMOL")
217 369641 : unit_id(i_unit) = cp_units_kcalmol
218 369641 : kind_id(i_unit) = cp_ukind_energy
219 : CASE ("KJMOL")
220 2248 : unit_id(i_unit) = cp_units_kjmol
221 2248 : kind_id(i_unit) = cp_ukind_energy
222 : CASE ("JMOL")
223 0 : unit_id(i_unit) = cp_units_jmol
224 0 : kind_id(i_unit) = cp_ukind_energy
225 : CASE ("RY")
226 295560 : unit_id(i_unit) = cp_units_Ry
227 295560 : kind_id(i_unit) = cp_ukind_energy
228 : CASE ("EV")
229 2833964 : unit_id(i_unit) = cp_units_eV
230 2833964 : kind_id(i_unit) = cp_ukind_energy
231 : CASE ("KEV")
232 29624 : unit_id(i_unit) = cp_units_keV
233 29624 : kind_id(i_unit) = cp_ukind_energy
234 : CASE ("K_E")
235 312692 : unit_id(i_unit) = cp_units_k
236 312692 : kind_id(i_unit) = cp_ukind_energy
237 : CASE ("ENERGY")
238 0 : unit_id(i_unit) = cp_units_none
239 0 : kind_id(i_unit) = cp_ukind_energy
240 : CASE ("AU_L")
241 278 : unit_id(i_unit) = cp_units_au
242 278 : kind_id(i_unit) = cp_ukind_length
243 : CASE ("BOHR")
244 2405610 : unit_id(i_unit) = cp_units_bohr
245 2405610 : kind_id(i_unit) = cp_ukind_length
246 : CASE ("M")
247 48263 : unit_id(i_unit) = cp_units_m
248 48263 : kind_id(i_unit) = cp_ukind_length
249 : CASE ("PM")
250 2 : unit_id(i_unit) = cp_units_pm
251 2 : kind_id(i_unit) = cp_ukind_length
252 : CASE ("NM")
253 19340 : unit_id(i_unit) = cp_units_nm
254 19340 : kind_id(i_unit) = cp_ukind_length
255 : CASE ("ANGSTROM")
256 8445814 : unit_id(i_unit) = cp_units_angstrom
257 8445814 : kind_id(i_unit) = cp_ukind_length
258 : CASE ("LENGTH")
259 0 : unit_id(i_unit) = cp_units_none
260 0 : kind_id(i_unit) = cp_ukind_length
261 : CASE ("K", "K_TEMP")
262 854586 : unit_id(i_unit) = cp_units_k
263 854586 : kind_id(i_unit) = cp_ukind_temperature
264 : CASE ("AU_TEMP")
265 4 : unit_id(i_unit) = cp_units_au
266 4 : kind_id(i_unit) = cp_ukind_temperature
267 : CASE ("TEMPERATURE")
268 0 : unit_id(i_unit) = cp_units_none
269 0 : kind_id(i_unit) = cp_ukind_temperature
270 : CASE ("ATM")
271 0 : unit_id(i_unit) = cp_units_atm
272 0 : kind_id(i_unit) = cp_ukind_pressure
273 : CASE ("BAR")
274 150843 : unit_id(i_unit) = cp_units_bar
275 150843 : kind_id(i_unit) = cp_ukind_pressure
276 : CASE ("KBAR")
277 16 : unit_id(i_unit) = cp_units_kbar
278 16 : kind_id(i_unit) = cp_ukind_pressure
279 : CASE ("PA")
280 18568 : unit_id(i_unit) = cp_units_Pa
281 18568 : kind_id(i_unit) = cp_ukind_pressure
282 : CASE ("MPA")
283 0 : unit_id(i_unit) = cp_units_MPa
284 0 : kind_id(i_unit) = cp_ukind_pressure
285 : CASE ("GPA")
286 9579 : unit_id(i_unit) = cp_units_GPa
287 9579 : kind_id(i_unit) = cp_ukind_pressure
288 : CASE ("AU_P")
289 0 : unit_id(i_unit) = cp_units_au
290 0 : kind_id(i_unit) = cp_ukind_pressure
291 : CASE ("PRESSURE")
292 0 : unit_id(i_unit) = cp_units_none
293 0 : kind_id(i_unit) = cp_ukind_pressure
294 : CASE ("RAD")
295 229897 : unit_id(i_unit) = cp_units_rad
296 229897 : kind_id(i_unit) = cp_ukind_angle
297 : CASE ("DEG")
298 271438 : unit_id(i_unit) = cp_units_deg
299 271438 : kind_id(i_unit) = cp_ukind_angle
300 : CASE ("ANGLE")
301 0 : unit_id(i_unit) = cp_units_none
302 0 : kind_id(i_unit) = cp_ukind_angle
303 : CASE ("S")
304 141095 : unit_id(i_unit) = cp_units_s
305 141095 : kind_id(i_unit) = cp_ukind_time
306 : CASE ("FS")
307 1504469 : unit_id(i_unit) = cp_units_fs
308 1504469 : kind_id(i_unit) = cp_ukind_time
309 : CASE ("PS")
310 428870 : unit_id(i_unit) = cp_units_ps
311 428870 : kind_id(i_unit) = cp_ukind_time
312 : CASE ("WAVENUMBER_T")
313 34 : unit_id(i_unit) = cp_units_wn
314 34 : kind_id(i_unit) = cp_ukind_time
315 : CASE ("AU_T")
316 107331 : unit_id(i_unit) = cp_units_au
317 107331 : kind_id(i_unit) = cp_ukind_time
318 : CASE ("TIME")
319 0 : unit_id(i_unit) = cp_units_none
320 0 : kind_id(i_unit) = cp_ukind_time
321 : CASE ("KG")
322 0 : unit_id(i_unit) = cp_units_kg
323 0 : kind_id(i_unit) = cp_ukind_mass
324 : CASE ("AMU")
325 9434 : unit_id(i_unit) = cp_units_amu
326 9434 : kind_id(i_unit) = cp_ukind_mass
327 : CASE ("M_E")
328 0 : unit_id(i_unit) = cp_units_m_e
329 0 : kind_id(i_unit) = cp_ukind_mass
330 : CASE ("AU_M")
331 29620 : unit_id(i_unit) = cp_units_au
332 29620 : kind_id(i_unit) = cp_ukind_mass
333 : CASE ("MASS")
334 0 : unit_id(i_unit) = cp_units_none
335 0 : kind_id(i_unit) = cp_ukind_mass
336 : CASE ("VOLT")
337 120776 : unit_id(i_unit) = cp_units_volt
338 120776 : kind_id(i_unit) = cp_ukind_potential
339 : CASE ("AU_POT")
340 0 : unit_id(i_unit) = cp_units_au
341 0 : kind_id(i_unit) = cp_ukind_potential
342 : CASE ("POTENTIAL")
343 0 : unit_id(i_unit) = cp_units_none
344 0 : kind_id(i_unit) = cp_ukind_potential
345 : CASE ("N", "NEWTON")
346 10 : unit_id(i_unit) = cp_units_Newton
347 10 : kind_id(i_unit) = cp_ukind_force
348 : CASE ("MN", "MNEWTON")
349 18620 : unit_id(i_unit) = cp_units_mNewton
350 18620 : kind_id(i_unit) = cp_ukind_force
351 : CASE ("AU_F")
352 0 : unit_id(i_unit) = cp_units_au
353 0 : kind_id(i_unit) = cp_ukind_force
354 : CASE ("FORCE")
355 0 : unit_id(i_unit) = cp_units_none
356 0 : kind_id(i_unit) = cp_ukind_force
357 : CASE ("AU")
358 : CALL cp_abort(__LOCATION__, &
359 : "au unit without specifying its kind not accepted, use "// &
360 0 : "(au_e, au_f, au_t, au_temp, au_l, au_m, au_p, au_pot)")
361 : CASE default
362 20635855 : CPABORT("Unknown unit: "//string(i_low:i_high - 1))
363 : END SELECT
364 20635855 : power(i_unit) = next_power
365 : ! parse op
366 20635855 : i_low = i_high
367 20671079 : DO WHILE (i_low <= len_string)
368 2963420 : IF (string(i_low:i_low) /= ' ') EXIT
369 2963420 : i_low = i_low + 1
370 : END DO
371 : i_high = i_low
372 20635855 : DO WHILE (i_high <= len_string)
373 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
374 2928196 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
375 0 : i_high = i_high + 1
376 : END DO
377 20635855 : IF (i_high < i_low .OR. i_low > len_string) EXIT
378 :
379 2928196 : IF (i_high <= len_string) THEN
380 2928196 : IF (string(i_low:i_high) == '^') THEN
381 2029411 : i_low = i_high + 1
382 2029411 : DO WHILE (i_low <= len_string)
383 2029411 : IF (string(i_low:i_low) /= ' ') EXIT
384 2029411 : i_low = i_low + 1
385 : END DO
386 : i_high = i_low
387 5924309 : DO WHILE (i_high <= len_string)
388 1992034 : SELECT CASE (string(i_high:i_high))
389 : CASE ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')
390 3894898 : i_high = i_high + 1
391 : CASE default
392 3932275 : EXIT
393 : END SELECT
394 : END DO
395 2029411 : IF (i_high <= i_low .OR. i_low > len_string) THEN
396 0 : CPABORT("an integer number is expected after a '^'")
397 0 : EXIT
398 : END IF
399 2029411 : formatstr = "(i"//cp_to_string(i_high - i_low + 1)//")"
400 : READ (string(i_low:i_high - 1), formatstr) &
401 2029411 : next_power
402 2029411 : power(i_unit) = power(i_unit)*next_power
403 : ! next op
404 2029411 : i_low = i_high
405 2038367 : DO WHILE (i_low < len_string)
406 46312 : IF (string(i_low:i_low) /= ' ') EXIT
407 46312 : i_low = i_low + 1
408 : END DO
409 : i_high = i_low
410 2030605 : DO WHILE (i_high <= len_string)
411 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
412 38369 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
413 1215 : i_high = i_high + 1
414 : END DO
415 : END IF
416 : END IF
417 2928196 : IF (i_low > len_string) EXIT
418 936162 : next_power = 1
419 20691580 : IF (i_high <= len_string) THEN
420 935960 : IF (string(i_low:i_high) == "*" .OR. string(i_low:i_high) == '/') THEN
421 935939 : IF (string(i_low:i_high) == '/') next_power = -1
422 935939 : i_low = i_high + 1
423 935939 : DO WHILE (i_low <= len_string)
424 935939 : IF (string(i_low:i_low) /= ' ') EXIT
425 935939 : i_low = i_low + 1
426 : END DO
427 : i_high = i_low
428 4963701 : DO WHILE (i_high <= len_string)
429 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
430 4820758 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
431 4170726 : i_high = i_high + 1
432 : END DO
433 : END IF
434 : END IF
435 : END DO
436 : CALL cp_unit_create2(unit, kind_id=kind_id, unit_id=unit_id, &
437 19755418 : power=power)
438 19755418 : desc = cp_unit_desc(unit)
439 19755418 : END SUBROUTINE cp_unit_create
440 :
441 : ! **************************************************************************************************
442 : !> \brief creates and initializes the given unit of mesure (performs some error
443 : !> check)
444 : !> \param unit the unit descriptor to be initialized
445 : !> \param kind_id the kind of unit (length,energy,...), use the constants
446 : !> cp_ukind_*
447 : !> \param unit_id the actual unit (use constants cp_units_*)
448 : !> \param power ...
449 : !> \author fawzi
450 : ! **************************************************************************************************
451 556001824 : SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power)
452 : TYPE(cp_unit_type), INTENT(OUT) :: unit
453 : INTEGER, DIMENSION(:), INTENT(in) :: kind_id, unit_id
454 : INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: power
455 :
456 : INTEGER :: i, j, max_kind, max_pos
457 : LOGICAL :: repeat
458 :
459 19857208 : CPASSERT(SIZE(kind_id) <= cp_unit_max_kinds)
460 19857208 : CPASSERT(SIZE(unit_id) <= cp_unit_max_kinds)
461 178002342 : unit%kind_id(1:SIZE(kind_id)) = kind_id
462 20569738 : unit%kind_id(SIZE(kind_id) + 1:) = cp_ukind_none
463 178002342 : unit%unit_id(1:SIZE(unit_id)) = unit_id
464 40426946 : unit%unit_id(SIZE(unit_id):) = cp_units_none
465 19857208 : IF (PRESENT(power)) THEN
466 178002342 : unit%power(1:SIZE(power)) = power
467 20569738 : unit%power(SIZE(power) + 1:) = 0
468 178714872 : DO i = 1, SIZE(unit%power)
469 178714872 : IF (unit%power(i) == 0) THEN
470 138120019 : unit%kind_id(i) = cp_ukind_none
471 138120019 : unit%unit_id(i) = cp_units_none
472 : END IF
473 : END DO
474 : ELSE
475 0 : DO i = 1, SIZE(unit%power)
476 0 : IF (unit%unit_id(i) /= 0) THEN
477 0 : unit%power(i) = 1
478 : ELSE
479 0 : unit%power(i) = 0
480 : END IF
481 : END DO
482 : END IF
483 :
484 : ! remove unnecessary units
485 : ! reorder & compress
486 19857208 : unit%n_kinds = 0
487 178714872 : DO i = 1, SIZE(unit%kind_id)
488 : ! find max and compress in the rest
489 : DO
490 158857664 : max_kind = unit%kind_id(i)
491 158857664 : max_pos = i
492 158857664 : repeat = .FALSE.
493 714859488 : DO j = i + 1, SIZE(unit%kind_id)
494 714859488 : IF (unit%kind_id(j) >= max_kind) THEN
495 412691739 : IF (unit%kind_id(j) /= 0 .AND. unit%kind_id(j) == max_kind .AND. &
496 : unit%unit_id(j) == unit%unit_id(max_pos)) THEN
497 0 : unit%power(max_pos) = unit%power(max_pos) + unit%power(j)
498 0 : unit%kind_id(j) = cp_ukind_none
499 0 : unit%unit_id(j) = cp_units_none
500 0 : unit%power(j) = 0
501 0 : IF (unit%power(max_pos) == 0) THEN
502 0 : unit%kind_id(max_pos) = cp_ukind_none
503 0 : unit%unit_id(max_pos) = cp_units_none
504 0 : unit%power(max_pos) = 0
505 0 : repeat = .TRUE.
506 0 : EXIT
507 : END IF
508 412691739 : ELSE IF (unit%kind_id(j) > max_kind .OR. &
509 : (unit%kind_id(j) == max_kind .AND. &
510 : unit%unit_id(j) > unit%unit_id(max_pos))) THEN
511 898717 : max_kind = unit%kind_id(j)
512 898717 : max_pos = j
513 : END IF
514 : END IF
515 : END DO
516 158857664 : IF (.NOT. repeat) EXIT
517 : END DO
518 158857664 : IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1
519 : ! put the max at pos i
520 158857664 : IF (max_pos /= i) THEN
521 880145 : unit%kind_id(max_pos) = unit%kind_id(i)
522 880145 : unit%kind_id(i) = max_kind
523 880145 : max_kind = unit%unit_id(max_pos)
524 880145 : unit%unit_id(max_pos) = unit%unit_id(i)
525 880145 : unit%unit_id(i) = max_kind
526 880145 : max_kind = unit%power(max_pos)
527 880145 : unit%power(max_pos) = unit%power(i)
528 880145 : unit%power(i) = max_kind
529 : END IF
530 : ! check unit
531 : CALL cp_basic_unit_check(basic_kind=unit%kind_id(i), &
532 178714872 : basic_unit=unit%unit_id(i))
533 : END DO
534 19857208 : END SUBROUTINE cp_unit_create2
535 :
536 : ! **************************************************************************************************
537 : !> \brief releases the given unit
538 : !> \param unit the unit to release
539 : !> \author fawzi
540 : !> \note
541 : !> at the moment not needed, there for completeness
542 : ! **************************************************************************************************
543 19857208 : ELEMENTAL SUBROUTINE cp_unit_release(unit)
544 : TYPE(cp_unit_type), INTENT(IN) :: unit
545 :
546 : MARK_USED(unit)
547 :
548 19857208 : END SUBROUTINE cp_unit_release
549 :
550 : ! **************************************************************************************************
551 : !> \brief controls that the kind and contains meaningful information
552 : !> \param basic_kind the kind of the unit
553 : !> \param basic_unit the unit to check
554 : !> \author fawzi
555 : ! **************************************************************************************************
556 158857664 : SUBROUTINE cp_basic_unit_check(basic_kind, basic_unit)
557 : INTEGER, INTENT(in) :: basic_kind, basic_unit
558 :
559 159775651 : SELECT CASE (basic_kind)
560 : CASE (cp_ukind_undef)
561 5841716 : SELECT CASE (basic_unit)
562 : CASE (cp_units_none)
563 : CASE default
564 917987 : CPABORT("unknown undef unit:"//TRIM(cp_to_string(basic_unit)))
565 : END SELECT
566 : CASE (cp_ukind_energy)
567 15853215 : SELECT CASE (basic_unit)
568 : CASE (cp_units_hartree, cp_units_wavenum, cp_units_joule, cp_units_kcalmol, &
569 : cp_units_kjmol, cp_units_Ry, cp_units_eV, cp_units_keV, cp_units_au, cp_units_k, &
570 : cp_units_jmol, cp_units_none)
571 : CASE default
572 4923729 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
573 : END SELECT
574 : CASE (cp_ukind_length)
575 11794255 : SELECT CASE (basic_unit)
576 : CASE (cp_units_bohr, cp_units_angstrom, cp_units_au, cp_units_none, cp_units_m, &
577 : cp_units_pm, cp_units_nm)
578 : CASE default
579 10929486 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
580 : END SELECT
581 : CASE (cp_ukind_temperature)
582 1053954 : SELECT CASE (basic_unit)
583 : CASE (cp_units_k, cp_units_au, cp_units_none)
584 : CASE default
585 864769 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
586 : END SELECT
587 : CASE (cp_ukind_pressure)
588 700699 : SELECT CASE (basic_unit)
589 : CASE (cp_units_bar, cp_units_atm, cp_units_kbar, cp_units_Pa, cp_units_MPa, cp_units_GPa, cp_units_au, cp_units_none)
590 : CASE default
591 189185 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
592 : END SELECT
593 : CASE (cp_ukind_angle)
594 2703492 : SELECT CASE (basic_unit)
595 : CASE (cp_units_rad, cp_units_deg, cp_units_none)
596 : CASE default
597 511514 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
598 : END SELECT
599 : CASE (cp_ukind_time)
600 2241211 : SELECT CASE (basic_unit)
601 : CASE (cp_units_s, cp_units_fs, cp_units_ps, cp_units_au, cp_units_wn, cp_units_none)
602 : CASE default
603 2191978 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
604 : END SELECT
605 : CASE (cp_ukind_mass)
606 180188 : SELECT CASE (basic_unit)
607 : CASE (cp_units_kg, cp_units_amu, cp_units_m_e, cp_units_au, cp_units_none)
608 : CASE default
609 49233 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
610 : END SELECT
611 : CASE (cp_ukind_potential)
612 159764 : SELECT CASE (basic_unit)
613 : CASE (cp_units_volt, cp_units_au, cp_units_none)
614 : CASE default
615 130955 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
616 : END SELECT
617 : CASE (cp_ukind_force)
618 138148828 : SELECT CASE (basic_unit)
619 : CASE (cp_units_Newton, cp_units_mNewton, cp_units_au, cp_units_none)
620 : CASE default
621 28809 : CPABORT("unknown force unit:"//TRIM(cp_to_string(basic_unit)))
622 : END SELECT
623 : CASE (cp_ukind_none)
624 138120019 : IF (basic_unit /= cp_units_none) &
625 : CALL cp_abort(__LOCATION__, &
626 : "if the kind of the unit is none also unit must be undefined,not:" &
627 0 : //TRIM(cp_to_string(basic_unit)))
628 : CASE default
629 158857664 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
630 : END SELECT
631 158857664 : END SUBROUTINE cp_basic_unit_check
632 :
633 : ! **************************************************************************************************
634 : !> \brief converts a value to the internal cp2k units
635 : !> \param value the value to convert
636 : !> \param basic_kind the kind of the unit of the value
637 : !> \param basic_unit the unit of the value
638 : !> \param power the power of the unit (defaults to 1)
639 : !> \return ...
640 : !> \author fawzi
641 : ! **************************************************************************************************
642 7644349 : FUNCTION cp_basic_unit_to_cp2k(value, basic_kind, basic_unit, power) RESULT(res)
643 : REAL(kind=dp), INTENT(in) :: value
644 : INTEGER, INTENT(in) :: basic_kind, basic_unit
645 : INTEGER, INTENT(in), OPTIONAL :: power
646 : REAL(kind=dp) :: res
647 :
648 : INTEGER :: my_power
649 :
650 7644349 : my_power = 1
651 7644349 : IF (PRESENT(power)) my_power = power
652 7644349 : IF (basic_unit == cp_units_none .AND. basic_kind /= cp_ukind_undef) THEN
653 0 : IF (basic_kind /= cp_units_none) &
654 : CALL cp_abort(__LOCATION__, &
655 : "unit not yet fully specified, unit of kind "// &
656 0 : TRIM(cp_to_string(basic_unit)))
657 : END IF
658 7711080 : SELECT CASE (basic_kind)
659 : CASE (cp_ukind_undef)
660 1705577 : SELECT CASE (basic_unit)
661 : CASE (cp_units_none)
662 66731 : res = value
663 : CASE default
664 66731 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
665 : END SELECT
666 : CASE (cp_ukind_energy)
667 4495689 : SELECT CASE (basic_unit)
668 : CASE (cp_units_hartree, cp_units_au)
669 186367 : res = value
670 : CASE (cp_units_wavenum)
671 0 : res = wavenumbers**(-my_power)*value
672 : CASE (cp_units_joule)
673 0 : res = joule**(-my_power)*value
674 : CASE (cp_units_kcalmol)
675 230435 : res = kcalmol**(-my_power)*value
676 : CASE (cp_units_kjmol)
677 2248 : res = kjmol**(-my_power)*value
678 : CASE (cp_units_jmol)
679 0 : res = (kjmol*1.0E+3_dp)**(-my_power)*value
680 : CASE (cp_units_Ry)
681 43217 : res = 0.5_dp**my_power*value
682 : CASE (cp_units_eV)
683 1153160 : res = evolt**(-my_power)*value
684 : CASE (cp_units_keV)
685 8 : res = (1.0E-3_dp*evolt)**(-my_power)*value
686 : CASE (cp_units_k)
687 23411 : res = kelvin**(-my_power)*value
688 : CASE default
689 1638846 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
690 : END SELECT
691 : CASE (cp_ukind_length)
692 758318 : SELECT CASE (basic_unit)
693 : CASE (cp_units_bohr, cp_units_au)
694 442870 : res = value
695 : CASE (cp_units_m)
696 54 : res = value*(1.0E10_dp*bohr)**my_power
697 : CASE (cp_units_pm)
698 2 : res = value*(0.01_dp*bohr)**my_power
699 : CASE (cp_units_nm)
700 10066 : res = value*(10.0_dp*bohr)**my_power
701 : CASE (cp_units_angstrom)
702 3856330 : res = value*bohr**my_power
703 : CASE default
704 4309322 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
705 : END SELECT
706 : CASE (cp_ukind_temperature)
707 402266 : SELECT CASE (basic_unit)
708 : CASE (cp_units_k)
709 315444 : res = kelvin**(-my_power)*value
710 : CASE (cp_units_au)
711 4 : res = value
712 : CASE default
713 315448 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
714 : END SELECT
715 : CASE (cp_ukind_pressure)
716 379218 : SELECT CASE (basic_unit)
717 : CASE (cp_units_bar)
718 77242 : res = bar**(-my_power)*value
719 : CASE (cp_units_atm)
720 0 : res = atm**(-my_power)*value
721 : CASE (cp_units_kbar)
722 16 : res = (1.0E-3_dp*bar)**(-my_power)*value
723 : CASE (cp_units_Pa)
724 9284 : res = pascal**(-my_power)*value
725 : CASE (cp_units_MPa)
726 0 : res = (1.0E-6_dp*pascal)**(-my_power)*value
727 : CASE (cp_units_GPa)
728 280 : res = (1.0E-9_dp*pascal)**(-my_power)*value
729 : CASE (cp_units_au)
730 0 : res = value
731 : CASE default
732 86822 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
733 : END SELECT
734 : CASE (cp_ukind_angle)
735 994999 : SELECT CASE (basic_unit)
736 : CASE (cp_units_rad)
737 70095 : res = value
738 : CASE (cp_units_deg)
739 231881 : res = value*(radians)**my_power
740 : CASE default
741 301976 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
742 : END SELECT
743 : CASE (cp_ukind_time)
744 215 : SELECT CASE (basic_unit)
745 : CASE (cp_units_s)
746 24 : res = value*seconds**(-my_power)
747 : CASE (cp_units_fs)
748 545847 : res = value*femtoseconds**(-my_power)
749 : CASE (cp_units_ps)
750 330730 : res = value*picoseconds**(-my_power)
751 : CASE (cp_units_au)
752 48269 : res = value
753 : CASE (cp_units_wn)
754 34 : res = (twopi*wavenumbers)**(my_power)/value
755 : CASE default
756 924904 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
757 : END SELECT
758 : CASE (cp_ukind_mass)
759 77 : SELECT CASE (basic_unit)
760 : CASE (cp_units_kg)
761 0 : res = e_mass**my_power*value
762 : CASE (cp_units_amu)
763 182 : res = massunit**my_power*value
764 : CASE (cp_units_m_e, cp_units_au)
765 9 : res = value
766 : CASE default
767 191 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
768 : END SELECT
769 : CASE (cp_ukind_potential)
770 109 : SELECT CASE (basic_unit)
771 : CASE (cp_units_volt)
772 77 : res = evolt**(-my_power)*value
773 : CASE (cp_units_au)
774 0 : res = value
775 : CASE default
776 77 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
777 : END SELECT
778 : CASE (cp_ukind_force)
779 10 : SELECT CASE (basic_unit)
780 : CASE (cp_units_Newton)
781 10 : res = value*newton**(-my_power)
782 : CASE (cp_units_mNewton)
783 22 : res = value*(1.0E+3*newton)**(-my_power)
784 : CASE (cp_units_au)
785 0 : res = value
786 : CASE default
787 32 : CPABORT("unknown force unit:"//TRIM(cp_to_string(basic_unit)))
788 : END SELECT
789 : CASE (cp_ukind_none)
790 : CALL cp_abort(__LOCATION__, &
791 : "if the kind of the unit is none also unit must be undefined,not:" &
792 0 : //TRIM(cp_to_string(basic_unit)))
793 : CASE default
794 7644349 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
795 : END SELECT
796 7644349 : END FUNCTION cp_basic_unit_to_cp2k
797 :
798 : ! **************************************************************************************************
799 : !> \brief returns the label of the current basic unit
800 : !> \param basic_kind the kind of the unit of the value
801 : !> \param basic_unit the unit of the value
802 : !> \param power the power of the unit (defaults to 1)
803 : !> \param accept_undefined ...
804 : !> \return ...
805 : !> \author fawzi
806 : ! **************************************************************************************************
807 20635855 : FUNCTION cp_basic_unit_desc(basic_kind, basic_unit, power, accept_undefined) &
808 : RESULT(res)
809 : INTEGER, INTENT(in) :: basic_kind, basic_unit
810 : INTEGER, INTENT(in), OPTIONAL :: power
811 : LOGICAL, INTENT(in), OPTIONAL :: accept_undefined
812 : CHARACTER(len=cp_unit_basic_desc_length) :: res
813 :
814 : INTEGER :: a, my_power
815 : LOGICAL :: my_accept_undefined
816 :
817 20635855 : my_power = 1
818 20635855 : res = ""
819 20635855 : my_accept_undefined = .FALSE.
820 20635855 : IF (accept_undefined) my_accept_undefined = accept_undefined
821 20635855 : IF (PRESENT(power)) my_power = power
822 20635855 : IF (basic_unit == cp_units_none) THEN
823 907808 : IF (.NOT. my_accept_undefined .AND. basic_kind == cp_units_none) &
824 : CALL cp_abort(__LOCATION__, "unit not yet fully specified, unit of kind "// &
825 0 : TRIM(cp_to_string(basic_kind)))
826 : END IF
827 21543663 : SELECT CASE (basic_kind)
828 : CASE (cp_ukind_undef)
829 5821358 : SELECT CASE (basic_unit)
830 : CASE (cp_units_none)
831 907808 : res = "internal_cp2k"
832 : CASE DEFAULT
833 : CALL cp_abort(__LOCATION__, &
834 : "unit not yet fully specified, unit of kind "// &
835 907808 : TRIM(res))
836 : END SELECT
837 : CASE (cp_ukind_energy)
838 11989128 : SELECT CASE (basic_unit)
839 : CASE (cp_units_hartree, cp_units_au)
840 1069821 : res = "hartree"
841 : CASE (cp_units_wavenum)
842 0 : res = "wavenumber_e"
843 : CASE (cp_units_joule)
844 0 : res = "joule"
845 : CASE (cp_units_kcalmol)
846 369641 : res = "kcalmol"
847 : CASE (cp_units_kjmol)
848 2248 : res = "kjmol"
849 : CASE (cp_units_jmol)
850 0 : res = "jmol"
851 : CASE (cp_units_Ry)
852 295560 : res = "Ry"
853 : CASE (cp_units_eV)
854 2833964 : res = "eV"
855 : CASE (cp_units_keV)
856 29624 : res = "keV"
857 : CASE (cp_units_k)
858 312692 : res = "K_e"
859 : CASE (cp_units_none)
860 0 : res = "energy"
861 0 : IF (.NOT. my_accept_undefined) &
862 : CALL cp_abort(__LOCATION__, &
863 : "unit not yet fully specified, unit of kind "// &
864 0 : TRIM(res))
865 : CASE default
866 4913550 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
867 : END SELECT
868 : CASE (cp_ukind_length)
869 3260478 : SELECT CASE (basic_unit)
870 : CASE (cp_units_bohr, cp_units_au)
871 2405888 : res = "bohr"
872 : CASE (cp_units_m)
873 48263 : res = "m"
874 : CASE (cp_units_pm)
875 2 : res = "pm"
876 : CASE (cp_units_nm)
877 19340 : res = "nm"
878 : CASE (cp_units_angstrom)
879 8445814 : res = "angstrom"
880 : CASE default
881 0 : res = "length"
882 10919307 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
883 : END SELECT
884 : CASE (cp_ukind_temperature)
885 1033592 : SELECT CASE (basic_unit)
886 : CASE (cp_units_k)
887 854586 : res = "K"
888 : CASE (cp_units_au)
889 4 : res = "au_temp"
890 : CASE (cp_units_none)
891 0 : res = "temperature"
892 0 : IF (.NOT. my_accept_undefined) &
893 : CALL cp_abort(__LOCATION__, &
894 : "unit not yet fully specified, unit of kind "// &
895 0 : TRIM(res))
896 : CASE default
897 854590 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
898 : END SELECT
899 : CASE (cp_ukind_pressure)
900 652178 : SELECT CASE (basic_unit)
901 : CASE (cp_units_bar)
902 150843 : res = "bar"
903 : CASE (cp_units_atm)
904 0 : res = "atm"
905 : CASE (cp_units_kbar)
906 16 : res = "kbar"
907 : CASE (cp_units_Pa)
908 18568 : res = "Pa"
909 : CASE (cp_units_MPa)
910 0 : res = "MPa"
911 : CASE (cp_units_GPa)
912 9579 : res = "GPa"
913 : CASE (cp_units_au)
914 0 : res = "au_p"
915 : CASE (cp_units_none)
916 0 : res = "pressure"
917 0 : IF (.NOT. my_accept_undefined) &
918 : CALL cp_abort(__LOCATION__, &
919 : "unit not yet fully specified, unit of kind "// &
920 0 : TRIM(res))
921 : CASE default
922 179006 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
923 : END SELECT
924 : CASE (cp_ukind_angle)
925 2411696 : SELECT CASE (basic_unit)
926 : CASE (cp_units_rad)
927 229897 : res = "rad"
928 : CASE (cp_units_deg)
929 271438 : res = "deg"
930 : CASE (cp_units_none)
931 0 : res = "angle"
932 0 : IF (.NOT. my_accept_undefined) &
933 : CALL cp_abort(__LOCATION__, &
934 : "unit not yet fully specified, unit of kind "// &
935 0 : TRIM(res))
936 : CASE default
937 501335 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
938 : END SELECT
939 : CASE (cp_ukind_time)
940 180149 : SELECT CASE (basic_unit)
941 : CASE (cp_units_s)
942 141095 : res = "s"
943 : CASE (cp_units_fs)
944 1504469 : res = "fs"
945 : CASE (cp_units_ps)
946 428870 : res = "ps"
947 : CASE (cp_units_au)
948 107331 : res = "au_t"
949 : CASE (cp_units_wn)
950 34 : res = "wavenumber_t"
951 : CASE (cp_units_none)
952 0 : res = "time"
953 0 : IF (.NOT. my_accept_undefined) &
954 : CALL cp_abort(__LOCATION__, &
955 : "unit not yet fully specified, unit of kind "// &
956 0 : TRIM(res))
957 : CASE default
958 2181799 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
959 : END SELECT
960 : CASE (cp_ukind_mass)
961 120776 : SELECT CASE (basic_unit)
962 : CASE (cp_units_kg)
963 0 : res = "kg"
964 : CASE (cp_units_amu)
965 9434 : res = "amu"
966 : CASE (cp_units_m_e, cp_units_au)
967 29620 : res = "m_e"
968 : CASE (cp_units_none)
969 0 : res = "mass"
970 0 : IF (.NOT. my_accept_undefined) &
971 : CALL cp_abort(__LOCATION__, &
972 : "unit not yet fully specified, unit of kind "// &
973 0 : TRIM(res))
974 : CASE default
975 39054 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
976 : END SELECT
977 : CASE (cp_ukind_potential)
978 139406 : SELECT CASE (basic_unit)
979 : CASE (cp_units_volt)
980 120776 : res = "volt"
981 : CASE (cp_units_au)
982 0 : res = "au_pot"
983 : CASE (cp_units_none)
984 0 : res = "potential"
985 0 : IF (.NOT. my_accept_undefined) &
986 : CALL cp_abort(__LOCATION__, &
987 : "unit not yet fully specified, unit of kind "// &
988 0 : TRIM(res))
989 : CASE default
990 120776 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
991 : END SELECT
992 : CASE (cp_ukind_force)
993 10 : SELECT CASE (basic_unit)
994 : CASE (cp_units_Newton)
995 10 : res = "N"
996 : CASE (cp_units_mNewton)
997 18620 : res = "mN"
998 : CASE (cp_units_au)
999 0 : res = "au_f"
1000 : CASE (cp_units_none)
1001 0 : res = "force"
1002 0 : IF (.NOT. my_accept_undefined) &
1003 : CALL cp_abort(__LOCATION__, &
1004 : "unit not yet fully specified, unit of kind "// &
1005 0 : TRIM(res))
1006 : CASE default
1007 18630 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
1008 : END SELECT
1009 : CASE (cp_ukind_none)
1010 : CALL cp_abort(__LOCATION__, &
1011 : "if the kind of the unit is none also unit must be undefined,not:" &
1012 0 : //TRIM(cp_to_string(basic_unit)))
1013 : CASE default
1014 20635855 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
1015 : END SELECT
1016 20635855 : IF (my_power /= 1) THEN
1017 2153772 : a = LEN_TRIM(res)
1018 2153772 : CPASSERT(LEN(res) - a >= 3)
1019 2153772 : WRITE (res(a + 1:), "('^',i3)") my_power
1020 2153772 : CALL compress(res, .TRUE.)
1021 : END IF
1022 20635855 : END FUNCTION cp_basic_unit_desc
1023 :
1024 : ! **************************************************************************************************
1025 : !> \brief returns the "name" of the given unit
1026 : !> \param unit the unit to describe
1027 : !> \param defaults defaults for the undefined units, optional
1028 : !> \param accept_undefined if defaults is not present or is not associated
1029 : !> whether undefined units should be accepted (defaults to false)
1030 : !> \return ...
1031 : !> \author fawzi
1032 : ! **************************************************************************************************
1033 19755418 : FUNCTION cp_unit_desc(unit, defaults, accept_undefined) &
1034 : RESULT(res)
1035 : TYPE(cp_unit_type), INTENT(IN) :: unit
1036 : TYPE(cp_unit_set_type), INTENT(IN), OPTIONAL :: defaults
1037 : LOGICAL, INTENT(in), OPTIONAL :: accept_undefined
1038 : CHARACTER(len=cp_unit_desc_length) :: res
1039 :
1040 : INTEGER :: i, my_unit, pos
1041 : LOGICAL :: check, has_defaults, my_accept_undefined
1042 :
1043 19755418 : res = ""
1044 19755418 : pos = 1
1045 19755418 : my_accept_undefined = .FALSE.
1046 19755418 : IF (PRESENT(accept_undefined)) my_accept_undefined = accept_undefined
1047 40391273 : DO i = 1, unit%n_kinds
1048 20635855 : CPASSERT(unit%kind_id(i) /= 0)
1049 20635855 : CPASSERT(pos < LEN(res))
1050 20635855 : my_unit = unit%unit_id(i)
1051 20635855 : has_defaults = .FALSE.
1052 20635855 : IF (PRESENT(defaults)) has_defaults = ASSOCIATED(defaults%units(1)%unit)
1053 20635855 : IF (my_unit == 0) THEN
1054 0 : IF (has_defaults) THEN
1055 0 : my_unit = defaults%units(unit%kind_id(i))%unit%unit_id(1)
1056 : ELSE
1057 0 : check = my_accept_undefined .OR. unit%kind_id(i) /= 0
1058 0 : CPASSERT(check)
1059 : END IF
1060 : END IF
1061 20635855 : IF (i > 1) THEN
1062 936141 : res(pos:pos) = "*"
1063 936141 : pos = pos + 1
1064 : END IF
1065 : res(pos:) = TRIM(cp_basic_unit_desc(basic_kind=unit%kind_id(i), &
1066 : basic_unit=my_unit, accept_undefined=my_accept_undefined, &
1067 20635855 : power=unit%power(i)))
1068 40391273 : pos = LEN_TRIM(res) + 1
1069 : END DO
1070 :
1071 19755418 : END FUNCTION cp_unit_desc
1072 :
1073 : ! **************************************************************************************************
1074 : !> \brief transform a value to the internal cp2k units
1075 : !> \param value the value to convert
1076 : !> \param unit the unit of the result
1077 : !> \param defaults the defaults unit for those that are left free
1078 : !> (cp_units_none)
1079 : !> \param power the power of the unit (defaults to 1)
1080 : !> \return ...
1081 : !> \author fawzi
1082 : ! **************************************************************************************************
1083 7096019 : FUNCTION cp_unit_to_cp2k1(value, unit, defaults, power) RESULT(res)
1084 : REAL(kind=dp), INTENT(in) :: value
1085 : TYPE(cp_unit_type), INTENT(IN) :: unit
1086 : TYPE(cp_unit_set_type), INTENT(IN), OPTIONAL :: defaults
1087 : INTEGER, INTENT(in), OPTIONAL :: power
1088 : REAL(kind=dp) :: res
1089 :
1090 : INTEGER :: i_unit, my_basic_unit, my_power
1091 :
1092 7096019 : my_power = 1
1093 7096019 : IF (PRESENT(power)) my_power = power
1094 7096019 : res = value
1095 14740368 : DO i_unit = 1, unit%n_kinds
1096 7644349 : CPASSERT(unit%kind_id(i_unit) > 0)
1097 7644349 : my_basic_unit = unit%unit_id(i_unit)
1098 7644349 : IF (my_basic_unit == 0 .AND. unit%kind_id(i_unit) /= cp_ukind_undef) THEN
1099 0 : CPASSERT(PRESENT(defaults))
1100 0 : CPASSERT(ASSOCIATED(defaults%units(unit%kind_id(i_unit))%unit))
1101 0 : my_basic_unit = defaults%units(unit%kind_id(i_unit))%unit%unit_id(1)
1102 : END IF
1103 : res = cp_basic_unit_to_cp2k(value=res, basic_unit=my_basic_unit, &
1104 : basic_kind=unit%kind_id(i_unit), &
1105 14740368 : power=my_power*unit%power(i_unit))
1106 : END DO
1107 7096019 : END FUNCTION cp_unit_to_cp2k1
1108 :
1109 : ! **************************************************************************************************
1110 : !> \brief converts from the internal cp2k units to the given unit
1111 : !> \param value the value to convert
1112 : !> \param unit the unit of the result
1113 : !> \param defaults the defaults unit for those that are left free
1114 : !> (cp_units_none)
1115 : !> \param power the power of the unit (defaults to 1)
1116 : !> \return ...
1117 : !> \author fawzi
1118 : ! **************************************************************************************************
1119 769087 : FUNCTION cp_unit_from_cp2k1(value, unit, defaults, power) RESULT(res)
1120 : REAL(kind=dp), INTENT(in) :: value
1121 : TYPE(cp_unit_type), INTENT(IN) :: unit
1122 : TYPE(cp_unit_set_type), INTENT(IN), OPTIONAL :: defaults
1123 : INTEGER, INTENT(in), OPTIONAL :: power
1124 : REAL(kind=dp) :: res
1125 :
1126 : INTEGER :: my_power
1127 :
1128 769087 : my_power = 1
1129 769087 : IF (PRESENT(power)) my_power = power
1130 769087 : IF (PRESENT(defaults)) THEN
1131 : res = cp_unit_to_cp2k1(value=value, unit=unit, defaults=defaults, &
1132 0 : power=-my_power)
1133 : ELSE
1134 769087 : res = cp_unit_to_cp2k1(value=value, unit=unit, power=-my_power)
1135 : END IF
1136 769087 : END FUNCTION cp_unit_from_cp2k1
1137 :
1138 : ! **************************************************************************************************
1139 : !> \brief converts to the internal cp2k units to the given unit
1140 : !> \param value the value to convert
1141 : !> \param unit_str the unit of the result as string
1142 : !> \param defaults the defaults unit for those that are left free
1143 : !> (cp_units_none)
1144 : !> \param power the power of the unit (defaults to 1)
1145 : !> \return ...
1146 : !> \author fawzi
1147 : ! **************************************************************************************************
1148 6220293 : FUNCTION cp_unit_to_cp2k(value, unit_str, defaults, power) RESULT(res)
1149 : REAL(kind=dp), INTENT(in) :: value
1150 : CHARACTER(len=*), INTENT(in) :: unit_str
1151 : TYPE(cp_unit_set_type), INTENT(IN), OPTIONAL :: defaults
1152 : INTEGER, INTENT(in), OPTIONAL :: power
1153 : REAL(kind=dp) :: res
1154 :
1155 : TYPE(cp_unit_type) :: my_unit
1156 :
1157 6220293 : CALL cp_unit_create(my_unit, unit_str)
1158 6220293 : IF (PRESENT(defaults)) THEN
1159 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1160 0 : power=power)
1161 : ELSE
1162 6220293 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, power=power)
1163 : END IF
1164 6220293 : CALL cp_unit_release(my_unit)
1165 167947911 : END FUNCTION cp_unit_to_cp2k
1166 :
1167 : ! **************************************************************************************************
1168 : !> \brief converts from the internal cp2k units to the given unit
1169 : !> \param value the value to convert
1170 : !> \param unit_str the unit of the result as string
1171 : !> \param defaults the defaults unit for those that are left free
1172 : !> (cp_units_none)
1173 : !> \param power the power of the unit (defaults to 1)
1174 : !> \return ...
1175 : !> \author fawzi
1176 : ! **************************************************************************************************
1177 565327 : FUNCTION cp_unit_from_cp2k(value, unit_str, defaults, power) RESULT(res)
1178 : REAL(kind=dp), INTENT(in) :: value
1179 : CHARACTER(len=*), INTENT(in) :: unit_str
1180 : TYPE(cp_unit_set_type), INTENT(IN), OPTIONAL :: defaults
1181 : INTEGER, INTENT(in), OPTIONAL :: power
1182 : REAL(kind=dp) :: res
1183 :
1184 : TYPE(cp_unit_type) :: my_unit
1185 :
1186 565327 : CALL cp_unit_create(my_unit, unit_str)
1187 565327 : IF (PRESENT(defaults)) THEN
1188 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1189 0 : power=power)
1190 : ELSE
1191 565327 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, power=power)
1192 : END IF
1193 565327 : CALL cp_unit_release(my_unit)
1194 15263829 : END FUNCTION cp_unit_from_cp2k
1195 :
1196 : ! **************************************************************************************************
1197 : !> \brief returs true if the two units are compatible
1198 : !> \param ref_unit ...
1199 : !> \param unit ...
1200 : !> \return ...
1201 : !> \author Teodoro Laino [tlaino] - 11.2007 - University of Zurich
1202 : ! **************************************************************************************************
1203 106639 : FUNCTION cp_unit_compatible(ref_unit, unit) RESULT(res)
1204 : TYPE(cp_unit_type), INTENT(IN) :: ref_unit, unit
1205 : LOGICAL :: res
1206 :
1207 : INTEGER :: i
1208 :
1209 106639 : res = .TRUE.
1210 959751 : DO i = 1, SIZE(ref_unit%kind_id)
1211 853112 : IF (ref_unit%kind_id(i) == unit%kind_id(i)) CYCLE
1212 5200 : IF ((ref_unit%kind_id(1) == cp_ukind_undef) .AND. (ALL(ref_unit%kind_id(2:) == cp_ukind_none))) CYCLE
1213 : res = .FALSE.
1214 959751 : EXIT
1215 : END DO
1216 :
1217 106639 : END FUNCTION cp_unit_compatible
1218 :
1219 : ! **************************************************************************************************
1220 : !> \brief initializes the given unit set
1221 : !> \param unit_set the set to initialize
1222 : !> \param name the name of the set, used for the dafault initialization of
1223 : !> the various units
1224 : !> \author fawzi
1225 : ! **************************************************************************************************
1226 111969 : SUBROUTINE cp_unit_set_create(unit_set, name)
1227 : TYPE(cp_unit_set_type), INTENT(OUT) :: unit_set
1228 : CHARACTER(len=*), INTENT(in) :: name
1229 :
1230 : CHARACTER(len=cp_unit_desc_length) :: my_name
1231 : INTEGER :: i
1232 :
1233 10179 : my_name = name
1234 10179 : CALL uppercase(my_name)
1235 :
1236 111969 : DO i = 1, cp_ukind_max
1237 101790 : NULLIFY (unit_set%units(i)%unit)
1238 2554929 : ALLOCATE (unit_set%units(i)%unit)
1239 : END DO
1240 111969 : DO i = 1, cp_ukind_max
1241 10179 : SELECT CASE (name)
1242 : CASE ('ATOM', 'ATOMIC', 'INTERNAL', 'CP2K')
1243 0 : IF (i == cp_ukind_angle) THEN
1244 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], &
1245 0 : unit_id=[cp_units_rad], power=[1])
1246 : ELSE
1247 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], &
1248 0 : unit_id=[cp_units_au], power=[1])
1249 : END IF
1250 : CASE ('OUTPUT')
1251 10179 : SELECT CASE (i)
1252 : CASE (cp_ukind_undef)
1253 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_none], &
1254 20358 : power=[1])
1255 : CASE (cp_ukind_energy)
1256 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_hartree], &
1257 20358 : power=[1])
1258 : CASE (cp_ukind_length)
1259 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_angstrom], &
1260 20358 : power=[1])
1261 : CASE (cp_ukind_temperature)
1262 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_k], &
1263 20358 : power=[1])
1264 : CASE (cp_ukind_angle)
1265 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_deg], &
1266 20358 : power=[1])
1267 : CASE (cp_ukind_pressure)
1268 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_bar], &
1269 20358 : power=[1])
1270 : CASE (cp_ukind_time)
1271 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_fs], &
1272 20358 : power=[1])
1273 : CASE (cp_ukind_mass)
1274 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_amu], &
1275 20358 : power=[1])
1276 : CASE (cp_ukind_potential)
1277 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_volt], &
1278 20358 : power=[1])
1279 : CASE (cp_ukind_force)
1280 : CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=[i], unit_id=[cp_units_newton], &
1281 20358 : power=[1])
1282 : CASE default
1283 0 : CPABORT("unhandled unit type "//TRIM(cp_to_string(i)))
1284 101790 : EXIT
1285 : END SELECT
1286 : CASE default
1287 101790 : CPABORT('unknown parameter set name '//TRIM(name))
1288 : END SELECT
1289 : END DO
1290 10179 : END SUBROUTINE cp_unit_set_create
1291 :
1292 : ! **************************************************************************************************
1293 : !> \brief releases the given unit set
1294 : !> \param unit_set the unit set to release
1295 : !> \author fawzi
1296 : ! **************************************************************************************************
1297 10179 : SUBROUTINE cp_unit_set_release(unit_set)
1298 : TYPE(cp_unit_set_type), INTENT(INOUT) :: unit_set
1299 :
1300 : INTEGER :: i
1301 :
1302 111969 : DO i = 1, SIZE(unit_set%units)
1303 101790 : CALL cp_unit_release(unit_set%units(i)%unit)
1304 111969 : DEALLOCATE (unit_set%units(i)%unit)
1305 : END DO
1306 :
1307 10179 : END SUBROUTINE cp_unit_set_release
1308 :
1309 : ! **************************************************************************************************
1310 : !> \brief Exports all available units as XML.
1311 : !> \param iw ...
1312 : !> \author Ole Schuett
1313 : ! **************************************************************************************************
1314 0 : SUBROUTINE export_units_as_xml(iw)
1315 : INTEGER, INTENT(IN) :: iw
1316 :
1317 : CALL format_units_as_xml("energy", s2a("hartree", "wavenumber_e", "joule", "kcalmol", &
1318 0 : "kjmol", "Ry", "eV", "keV", "K_e"), iw)
1319 0 : CALL format_units_as_xml("length", s2a("bohr", "m", "pm", "nm", "angstrom"), iw)
1320 0 : CALL format_units_as_xml("temperature", s2a("K", "au_temp"), iw)
1321 0 : CALL format_units_as_xml("pressure", s2a("bar", "atm", "kbar", "Pa", "MPa", "GPa", "au_p"), iw)
1322 0 : CALL format_units_as_xml("angle", s2a("rad", "deg"), iw)
1323 0 : CALL format_units_as_xml("time", s2a("s", "fs", "ps", "au_t", "wavenumber_t"), iw)
1324 0 : CALL format_units_as_xml("mass", s2a("kg", "amu", "m_e"), iw)
1325 0 : CALL format_units_as_xml("potential", s2a("volt", "au_pot"), iw)
1326 0 : CALL format_units_as_xml("force", s2a("N", "Newton", "mN", "mNewton", "au_f"), iw)
1327 :
1328 0 : END SUBROUTINE export_units_as_xml
1329 :
1330 : ! **************************************************************************************************
1331 : !> \brief Format units as xml.
1332 : !> \param unit_kind ...
1333 : !> \param units_set ...
1334 : !> \param iw ...
1335 : !> \author Ole Schuett
1336 : ! **************************************************************************************************
1337 0 : SUBROUTINE format_units_as_xml(unit_kind, units_set, iw)
1338 : CHARACTER(LEN=*), INTENT(IN) :: unit_kind
1339 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: units_set
1340 : INTEGER, INTENT(IN) :: iw
1341 :
1342 : INTEGER :: i
1343 :
1344 0 : WRITE (iw, FMT='(T2,A)') '<UNIT_KIND name="'//TRIM(unit_kind)//'">'
1345 0 : DO i = 1, SIZE(units_set)
1346 0 : WRITE (iw, FMT='(T3,A)') '<UNIT>'//TRIM(units_set(i))//'</UNIT>'
1347 : END DO
1348 0 : WRITE (iw, FMT='(T3,A)') '<UNIT>'//TRIM(unit_kind)//'</UNIT>' ! internal unit
1349 0 : WRITE (iw, FMT='(T2,A)') '</UNIT_KIND>'
1350 0 : END SUBROUTINE format_units_as_xml
1351 :
1352 0 : END MODULE cp_units
|
