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 470567175 : 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 18822687 : 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 169404183 : unit_id = cp_units_none
174 18822687 : kind_id = cp_ukind_none
175 18822687 : power = 0
176 18822687 : i_low = 1
177 18822687 : i_high = 1
178 18822687 : len_string = LEN(string)
179 18822687 : i_unit = 0
180 18822687 : next_power = 1
181 18822687 : DO WHILE (i_low < len_string)
182 17974681 : IF (string(i_low:i_low) /= ' ') EXIT
183 17974681 : i_low = i_low + 1
184 : END DO
185 : i_high = i_low
186 125254123 : DO WHILE (i_high <= len_string)
187 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
188 108554997 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
189 106431505 : i_high = i_high + 1
190 : END DO
191 : DO
192 19757473 : IF (i_high <= i_low .OR. i_low > len_string) EXIT
193 19702228 : i_unit = i_unit + 1
194 19702228 : 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 19702228 : unit_string = string(i_low:i_high - 1)
200 19702228 : CALL uppercase(unit_string)
201 20601961 : SELECT CASE (TRIM(unit_string))
202 : CASE ("INTERNAL_CP2K")
203 899733 : unit_id(i_unit) = cp_units_none
204 899733 : kind_id(i_unit) = cp_ukind_undef
205 : CASE ("HARTREE")
206 936281 : unit_id(i_unit) = cp_units_hartree
207 936281 : kind_id(i_unit) = cp_ukind_energy
208 : CASE ("AU_E")
209 107952 : unit_id(i_unit) = cp_units_au
210 107952 : 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 368275 : unit_id(i_unit) = cp_units_kcalmol
219 368275 : 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 246982 : unit_id(i_unit) = cp_units_Ry
228 246982 : kind_id(i_unit) = cp_ukind_energy
229 : CASE ("EV")
230 2379062 : unit_id(i_unit) = cp_units_eV
231 2379062 : kind_id(i_unit) = cp_ukind_energy
232 : CASE ("KEV")
233 29341 : unit_id(i_unit) = cp_units_keV
234 29341 : kind_id(i_unit) = cp_ukind_energy
235 : CASE ("K_E")
236 309923 : unit_id(i_unit) = cp_units_k
237 309923 : 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 2360384 : unit_id(i_unit) = cp_units_bohr
246 2360384 : kind_id(i_unit) = cp_ukind_length
247 : CASE ("M")
248 47820 : unit_id(i_unit) = cp_units_m
249 47820 : 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 19260 : unit_id(i_unit) = cp_units_nm
255 19260 : kind_id(i_unit) = cp_ukind_length
256 : CASE ("ANGSTROM")
257 8166857 : unit_id(i_unit) = cp_units_angstrom
258 8166857 : 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 828598 : unit_id(i_unit) = cp_units_k
264 828598 : 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 149568 : unit_id(i_unit) = cp_units_bar
276 149568 : 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 18408 : unit_id(i_unit) = cp_units_Pa
282 18408 : 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 9487 : unit_id(i_unit) = cp_units_GPa
288 9487 : 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 228443 : unit_id(i_unit) = cp_units_rad
297 228443 : kind_id(i_unit) = cp_ukind_angle
298 : CASE ("DEG")
299 269990 : unit_id(i_unit) = cp_units_deg
300 269990 : 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 139852 : unit_id(i_unit) = cp_units_s
306 139852 : kind_id(i_unit) = cp_ukind_time
307 : CASE ("FS")
308 1471808 : unit_id(i_unit) = cp_units_fs
309 1471808 : kind_id(i_unit) = cp_ukind_time
310 : CASE ("PS")
311 427012 : unit_id(i_unit) = cp_units_ps
312 427012 : 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 107715 : unit_id(i_unit) = cp_units_au
318 107715 : 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 9352 : unit_id(i_unit) = cp_units_amu
327 9352 : 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 29337 : unit_id(i_unit) = cp_units_au
333 29337 : 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 119736 : unit_id(i_unit) = cp_units_volt
339 119736 : 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 18460 : unit_id(i_unit) = cp_units_mNewton
351 18460 : 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 19702228 : CPABORT("Unknown unit: "//string(i_low:i_high - 1))
364 : END SELECT
365 19702228 : power(i_unit) = next_power
366 : ! parse op
367 19702228 : i_low = i_high
368 19737452 : DO WHILE (i_low <= len_string)
369 2951581 : IF (string(i_low:i_low) /= ' ') EXIT
370 2951581 : i_low = i_low + 1
371 : END DO
372 : i_high = i_low
373 19702228 : DO WHILE (i_high <= len_string)
374 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
375 2916357 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
376 0 : i_high = i_high + 1
377 : END DO
378 19702228 : IF (i_high < i_low .OR. i_low > len_string) EXIT
379 :
380 2916357 : IF (i_high <= len_string) THEN
381 2916357 : IF (string(i_low:i_high) == '^') THEN
382 2018636 : i_low = i_high + 1
383 2018636 : DO WHILE (i_low <= len_string)
384 2018636 : IF (string(i_low:i_low) /= ' ') EXIT
385 2018636 : i_low = i_low + 1
386 : END DO
387 : i_high = i_low
388 5893497 : DO WHILE (i_high <= len_string)
389 1981571 : SELECT CASE (string(i_high:i_high))
390 : CASE ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')
391 3874861 : i_high = i_high + 1
392 : CASE default
393 3911926 : EXIT
394 : END SELECT
395 : END DO
396 2018636 : 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 2018636 : formatstr = "(i"//cp_to_string(i_high - i_low + 1)//")"
401 : READ (string(i_low:i_high - 1), formatstr) &
402 2018636 : next_power
403 2018636 : power(i_unit) = power(i_unit)*next_power
404 : ! next op
405 2018636 : i_low = i_high
406 2027592 : DO WHILE (i_low < len_string)
407 46000 : IF (string(i_low:i_low) /= ' ') EXIT
408 46000 : i_low = i_low + 1
409 : END DO
410 : i_high = i_low
411 2019844 : DO WHILE (i_high <= len_string)
412 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
413 38069 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
414 1229 : i_high = i_high + 1
415 : END DO
416 : END IF
417 : END IF
418 2916357 : IF (i_low > len_string) EXIT
419 934786 : next_power = 1
420 19757473 : IF (i_high <= len_string) THEN
421 934582 : IF (string(i_low:i_high) == "*" .OR. string(i_low:i_high) == '/') THEN
422 934561 : IF (string(i_low:i_high) == '/') next_power = -1
423 934561 : i_low = i_high + 1
424 934561 : DO WHILE (i_low <= len_string)
425 934561 : IF (string(i_low:i_low) /= ' ') EXIT
426 934561 : i_low = i_low + 1
427 : END DO
428 : i_high = i_low
429 4954202 : DO WHILE (i_high <= len_string)
430 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
431 4812506 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
432 4161358 : 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 18822687 : power=power)
439 18822687 : desc = cp_unit_desc(unit)
440 18822687 : 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 529862956 : 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 18923677 : CPASSERT(SIZE(kind_id) <= cp_unit_max_kinds)
461 18923677 : CPASSERT(SIZE(unit_id) <= cp_unit_max_kinds)
462 169606163 : unit%kind_id(1:SIZE(kind_id)) = kind_id
463 19630607 : unit%kind_id(SIZE(kind_id) + 1:) = cp_ukind_none
464 169606163 : unit%unit_id(1:SIZE(unit_id)) = unit_id
465 38554284 : unit%unit_id(SIZE(unit_id):) = cp_units_none
466 18923677 : IF (PRESENT(power)) THEN
467 169606163 : unit%power(1:SIZE(power)) = power
468 19630607 : unit%power(SIZE(power) + 1:) = 0
469 170313093 : DO i = 1, SIZE(unit%power)
470 170313093 : IF (unit%power(i) == 0) THEN
471 131586198 : unit%kind_id(i) = cp_ukind_none
472 131586198 : 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 18923677 : unit%n_kinds = 0
488 170313093 : DO i = 1, SIZE(unit%kind_id)
489 : ! find max and compress in the rest
490 : DO
491 151389416 : max_kind = unit%kind_id(i)
492 151389416 : max_pos = i
493 151389416 : repeat = .FALSE.
494 681252372 : DO j = i + 1, SIZE(unit%kind_id)
495 681252372 : IF (unit%kind_id(j) >= max_kind) THEN
496 393091260 : 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 393091260 : 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 897653 : max_kind = unit%kind_id(j)
513 897653 : max_pos = j
514 : END IF
515 : END IF
516 : END DO
517 151389416 : IF (.NOT. repeat) EXIT
518 : END DO
519 151389416 : IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1
520 : ! put the max at pos i
521 151389416 : IF (max_pos /= i) THEN
522 879241 : unit%kind_id(max_pos) = unit%kind_id(i)
523 879241 : unit%kind_id(i) = max_kind
524 879241 : max_kind = unit%unit_id(max_pos)
525 879241 : unit%unit_id(max_pos) = unit%unit_id(i)
526 879241 : unit%unit_id(i) = max_kind
527 879241 : max_kind = unit%power(max_pos)
528 879241 : unit%power(max_pos) = unit%power(i)
529 879241 : unit%power(i) = max_kind
530 : END IF
531 : ! check unit
532 : CALL cp_basic_unit_check(basic_kind=unit%kind_id(i), &
533 170313093 : basic_unit=unit%unit_id(i))
534 : END DO
535 18923677 : 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 18923677 : ELEMENTAL SUBROUTINE cp_unit_release(unit)
545 : TYPE(cp_unit_type), INTENT(IN) :: unit
546 :
547 : MARK_USED(unit)
548 :
549 18923677 : 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 151389416 : SUBROUTINE cp_basic_unit_check(basic_kind, basic_unit)
558 : INTEGER, INTENT(in) :: basic_kind, basic_unit
559 :
560 152299248 : SELECT CASE (basic_kind)
561 : CASE (cp_ukind_undef)
562 5299995 : SELECT CASE (basic_unit)
563 : CASE (cp_units_none)
564 : CASE default
565 909832 : CPABORT("unknown undef unit:"//TRIM(cp_to_string(basic_unit)))
566 : END SELECT
567 : CASE (cp_ukind_energy)
568 14994863 : 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 4390163 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
574 : END SELECT
575 : CASE (cp_ukind_length)
576 11443401 : 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 10604700 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
581 : END SELECT
582 : CASE (cp_ukind_temperature)
583 1026279 : SELECT CASE (basic_unit)
584 : CASE (cp_units_k, cp_units_au, cp_units_none)
585 : CASE default
586 838701 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
587 : END SELECT
588 : CASE (cp_ukind_pressure)
589 696110 : 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 187578 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
593 : END SELECT
594 : CASE (cp_ukind_angle)
595 2665052 : SELECT CASE (basic_unit)
596 : CASE (cp_units_rad, cp_units_deg, cp_units_none)
597 : CASE default
598 508532 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
599 : END SELECT
600 : CASE (cp_ukind_time)
601 2205308 : 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 2156520 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
605 : END SELECT
606 : CASE (cp_ukind_mass)
607 178623 : 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 48788 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
611 : END SELECT
612 : CASE (cp_ukind_potential)
613 158404 : SELECT CASE (basic_unit)
614 : CASE (cp_units_volt, cp_units_au, cp_units_none)
615 : CASE default
616 129835 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
617 : END SELECT
618 : CASE (cp_ukind_force)
619 131614767 : SELECT CASE (basic_unit)
620 : CASE (cp_units_Newton, cp_units_mNewton, cp_units_au, cp_units_none)
621 : CASE default
622 28569 : CPABORT("unknown force unit:"//TRIM(cp_to_string(basic_unit)))
623 : END SELECT
624 : CASE (cp_ukind_none)
625 131586198 : 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 151389416 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
631 : END SELECT
632 151389416 : 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 7462026 : 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 7462026 : my_power = 1
652 7462026 : IF (PRESENT(power)) my_power = power
653 7462026 : 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 7528449 : SELECT CASE (basic_kind)
660 : CASE (cp_ukind_undef)
661 1568898 : SELECT CASE (basic_unit)
662 : CASE (cp_units_none)
663 66423 : res = value
664 : CASE default
665 66423 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
666 : END SELECT
667 : CASE (cp_ukind_energy)
668 4469292 : SELECT CASE (basic_unit)
669 : CASE (cp_units_hartree, cp_units_au)
670 187189 : 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 230269 : 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 33550 : res = 0.5_dp**my_power*value
683 : CASE (cp_units_eV)
684 1025774 : 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 23437 : res = kelvin**(-my_power)*value
689 : CASE default
690 1502475 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
691 : END SELECT
692 : CASE (cp_ukind_length)
693 746254 : SELECT CASE (basic_unit)
694 : CASE (cp_units_bohr, cp_units_au)
695 442482 : 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 10068 : res = value*(10.0_dp*bohr)**my_power
702 : CASE (cp_units_angstrom)
703 3829497 : res = value*bohr**my_power
704 : CASE default
705 4282103 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
706 : END SELECT
707 : CASE (cp_ukind_temperature)
708 389956 : SELECT CASE (basic_unit)
709 : CASE (cp_units_k)
710 303768 : res = kelvin**(-my_power)*value
711 : CASE (cp_units_au)
712 4 : res = value
713 : CASE default
714 303772 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
715 : END SELECT
716 : CASE (cp_ukind_pressure)
717 377574 : SELECT CASE (basic_unit)
718 : CASE (cp_units_bar)
719 76700 : 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 9204 : 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 268 : res = (1.0E-9_dp*pascal)**(-my_power)*value
730 : CASE (cp_units_au)
731 0 : res = value
732 : CASE default
733 86188 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
734 : END SELECT
735 : CASE (cp_ukind_angle)
736 989991 : SELECT CASE (basic_unit)
737 : CASE (cp_units_rad)
738 70096 : res = value
739 : CASE (cp_units_deg)
740 230778 : res = value*(radians)**my_power
741 : CASE default
742 300874 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
743 : END SELECT
744 : CASE (cp_ukind_time)
745 211 : SELECT CASE (basic_unit)
746 : CASE (cp_units_s)
747 24 : res = value*seconds**(-my_power)
748 : CASE (cp_units_fs)
749 540817 : res = value*femtoseconds**(-my_power)
750 : CASE (cp_units_ps)
751 329801 : res = value*picoseconds**(-my_power)
752 : CASE (cp_units_au)
753 49219 : res = value
754 : CASE (cp_units_wn)
755 34 : res = (twopi*wavenumbers)**(my_power)/value
756 : CASE default
757 919895 : 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 178 : res = massunit**my_power*value
765 : CASE (cp_units_m_e, cp_units_au)
766 9 : res = value
767 : CASE default
768 187 : 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 7462026 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
796 : END SELECT
797 7462026 : 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 19702228 : 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 19702228 : my_power = 1
819 19702228 : res = ""
820 19702228 : my_accept_undefined = .FALSE.
821 19702228 : IF (accept_undefined) my_accept_undefined = accept_undefined
822 19702228 : IF (PRESENT(power)) my_power = power
823 19702228 : IF (basic_unit == cp_units_none) THEN
824 899733 : 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 20601961 : SELECT CASE (basic_kind)
829 : CASE (cp_ukind_undef)
830 5279797 : SELECT CASE (basic_unit)
831 : CASE (cp_units_none)
832 899733 : res = "internal_cp2k"
833 : CASE DEFAULT
834 : CALL cp_abort(__LOCATION__, &
835 : "unit not yet fully specified, unit of kind "// &
836 899733 : TRIM(res))
837 : END SELECT
838 : CASE (cp_ukind_energy)
839 11638834 : SELECT CASE (basic_unit)
840 : CASE (cp_units_hartree, cp_units_au)
841 1044233 : 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 368275 : 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 246982 : res = "Ry"
854 : CASE (cp_units_eV)
855 2379062 : res = "eV"
856 : CASE (cp_units_keV)
857 29341 : res = "keV"
858 : CASE (cp_units_k)
859 309923 : 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 4380064 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
868 : END SELECT
869 : CASE (cp_ukind_length)
870 3189264 : SELECT CASE (basic_unit)
871 : CASE (cp_units_bohr, cp_units_au)
872 2360662 : res = "bohr"
873 : CASE (cp_units_m)
874 47820 : res = "m"
875 : CASE (cp_units_pm)
876 2 : res = "pm"
877 : CASE (cp_units_nm)
878 19260 : res = "nm"
879 : CASE (cp_units_angstrom)
880 8166857 : res = "angstrom"
881 : CASE default
882 0 : res = "length"
883 10594601 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
884 : END SELECT
885 : CASE (cp_ukind_temperature)
886 1006077 : SELECT CASE (basic_unit)
887 : CASE (cp_units_k)
888 828598 : 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 828602 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
899 : END SELECT
900 : CASE (cp_ukind_pressure)
901 648001 : SELECT CASE (basic_unit)
902 : CASE (cp_units_bar)
903 149568 : 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 18408 : res = "Pa"
910 : CASE (cp_units_MPa)
911 0 : res = "MPa"
912 : CASE (cp_units_GPa)
913 9487 : 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 177479 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
924 : END SELECT
925 : CASE (cp_ukind_angle)
926 2374864 : SELECT CASE (basic_unit)
927 : CASE (cp_units_rad)
928 228443 : res = "rad"
929 : CASE (cp_units_deg)
930 269990 : 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 498433 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
939 : END SELECT
940 : CASE (cp_ukind_time)
941 178541 : SELECT CASE (basic_unit)
942 : CASE (cp_units_s)
943 139852 : res = "s"
944 : CASE (cp_units_fs)
945 1471808 : res = "fs"
946 : CASE (cp_units_ps)
947 427012 : res = "ps"
948 : CASE (cp_units_au)
949 107715 : 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 2146421 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
960 : END SELECT
961 : CASE (cp_ukind_mass)
962 119736 : SELECT CASE (basic_unit)
963 : CASE (cp_units_kg)
964 0 : res = "kg"
965 : CASE (cp_units_amu)
966 9352 : res = "amu"
967 : CASE (cp_units_m_e, cp_units_au)
968 29337 : 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 38689 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
977 : END SELECT
978 : CASE (cp_ukind_potential)
979 138206 : SELECT CASE (basic_unit)
980 : CASE (cp_units_volt)
981 119736 : 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 119736 : 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 18460 : 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 18470 : 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 19702228 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
1016 : END SELECT
1017 19702228 : IF (my_power /= 1) THEN
1018 2141904 : a = LEN_TRIM(res)
1019 2141904 : CPASSERT(LEN(res) - a >= 3)
1020 2141904 : WRITE (res(a + 1:), "('^',i3)") my_power
1021 2141904 : CALL compress(res, .TRUE.)
1022 : END IF
1023 19702228 : 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 18822687 : 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 18822687 : res = ""
1045 18822687 : pos = 1
1046 18822687 : my_accept_undefined = .FALSE.
1047 18822687 : IF (PRESENT(accept_undefined)) my_accept_undefined = accept_undefined
1048 38524915 : DO i = 1, unit%n_kinds
1049 19702228 : CPASSERT(unit%kind_id(i) /= 0)
1050 19702228 : CPASSERT(pos < LEN(res))
1051 19702228 : my_unit = unit%unit_id(i)
1052 19702228 : has_defaults = .FALSE.
1053 19702228 : IF (PRESENT(defaults)) has_defaults = ASSOCIATED(defaults%units(1)%unit)
1054 19702228 : 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 19702228 : IF (i > 1) THEN
1063 934765 : res(pos:pos) = "*"
1064 934765 : 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 19702228 : power=unit%power(i)))
1069 38524915 : pos = LEN_TRIM(res) + 1
1070 : END DO
1071 :
1072 18822687 : 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 6911476 : 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 6911476 : my_power = 1
1094 6911476 : IF (PRESENT(power)) my_power = power
1095 6911476 : res = value
1096 14373502 : DO i_unit = 1, unit%n_kinds
1097 7462026 : CPASSERT(unit%kind_id(i_unit) > 0)
1098 7462026 : my_basic_unit = unit%unit_id(i_unit)
1099 7462026 : 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 14373502 : power=my_power*unit%power(i_unit))
1107 : END DO
1108 6911476 : 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 764448 : 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 764448 : my_power = 1
1130 764448 : IF (PRESENT(power)) my_power = power
1131 764448 : IF (PRESENT(defaults)) THEN
1132 : res = cp_unit_to_cp2k1(value=value, unit=unit, defaults=defaults, &
1133 0 : power=-my_power)
1134 : ELSE
1135 764448 : res = cp_unit_to_cp2k1(value=value, unit=unit, power=-my_power)
1136 : END IF
1137 764448 : 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 6040917 : 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 6040917 : CALL cp_unit_create(my_unit, unit_str)
1159 6040917 : IF (PRESENT(defaults)) THEN
1160 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1161 0 : power=power)
1162 : ELSE
1163 6040917 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, power=power)
1164 : END IF
1165 6040917 : CALL cp_unit_release(my_unit)
1166 163104759 : 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 560872 : 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 560872 : CALL cp_unit_create(my_unit, unit_str)
1188 560872 : IF (PRESENT(defaults)) THEN
1189 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1190 0 : power=power)
1191 : ELSE
1192 560872 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, power=power)
1193 : END IF
1194 560872 : CALL cp_unit_release(my_unit)
1195 15143544 : 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 106111 : 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 106111 : res = .TRUE.
1211 954999 : DO i = 1, SIZE(ref_unit%kind_id)
1212 848888 : IF (ref_unit%kind_id(i) == unit%kind_id(i)) CYCLE
1213 5232 : IF ((ref_unit%kind_id(1) == cp_ukind_undef) .AND. (ALL(ref_unit%kind_id(2:) == cp_ukind_none))) CYCLE
1214 : res = .FALSE.
1215 954999 : EXIT
1216 : END DO
1217 :
1218 106111 : 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 111089 : 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 10099 : my_name = name
1235 10099 : CALL uppercase(my_name)
1236 :
1237 111089 : DO i = 1, cp_ukind_max
1238 100990 : NULLIFY (unit_set%units(i)%unit)
1239 2534849 : ALLOCATE (unit_set%units(i)%unit)
1240 : END DO
1241 111089 : DO i = 1, cp_ukind_max
1242 10099 : 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 10099 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : 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 20198 : power=(/1/))
1283 : CASE default
1284 0 : CPABORT("unhandled unit type "//TRIM(cp_to_string(i)))
1285 100990 : EXIT
1286 : END SELECT
1287 : CASE default
1288 100990 : CPABORT('unknown parameter set name '//TRIM(name))
1289 : END SELECT
1290 : END DO
1291 10099 : 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 10099 : SUBROUTINE cp_unit_set_release(unit_set)
1299 : TYPE(cp_unit_set_type), INTENT(INOUT) :: unit_set
1300 :
1301 : INTEGER :: i
1302 :
1303 111089 : DO i = 1, SIZE(unit_set%units)
1304 100990 : CALL cp_unit_release(unit_set%units(i)%unit)
1305 111089 : DEALLOCATE (unit_set%units(i)%unit)
1306 : END DO
1307 :
1308 10099 : 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
|
