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