Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief 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 445446700 : 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 17817868 : 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 160360812 : unit_id = cp_units_none
174 17817868 : kind_id = cp_ukind_none
175 17817868 : power = 0
176 17817868 : i_low = 1
177 17817868 : i_high = 1
178 17817868 : len_string = LEN(string)
179 17817868 : i_unit = 0
180 17817868 : next_power = 1
181 17817868 : DO WHILE (i_low < len_string)
182 17007149 : IF (string(i_low:i_low) /= ' ') EXIT
183 17007149 : i_low = i_low + 1
184 : END DO
185 : i_high = i_low
186 118569198 : DO WHILE (i_high <= len_string)
187 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
188 102794865 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
189 100751447 : i_high = i_high + 1
190 : END DO
191 : DO
192 18727100 : IF (i_high <= i_low .OR. i_low > len_string) EXIT
193 18675887 : i_unit = i_unit + 1
194 18675887 : 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 18675887 : unit_string = string(i_low:i_high - 1)
200 18675887 : CALL uppercase(unit_string)
201 19523102 : SELECT CASE (TRIM(unit_string))
202 : CASE ("INTERNAL_CP2K")
203 847215 : unit_id(i_unit) = cp_units_none
204 847215 : kind_id(i_unit) = cp_ukind_undef
205 : CASE ("HARTREE")
206 880418 : unit_id(i_unit) = cp_units_hartree
207 880418 : kind_id(i_unit) = cp_ukind_energy
208 : CASE ("AU_E")
209 99856 : unit_id(i_unit) = cp_units_au
210 99856 : 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 356817 : unit_id(i_unit) = cp_units_kcalmol
219 356817 : 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 228778 : unit_id(i_unit) = cp_units_Ry
228 228778 : kind_id(i_unit) = cp_ukind_energy
229 : CASE ("EV")
230 2224062 : unit_id(i_unit) = cp_units_eV
231 2224062 : kind_id(i_unit) = cp_ukind_energy
232 : CASE ("KEV")
233 28673 : unit_id(i_unit) = cp_units_keV
234 28673 : kind_id(i_unit) = cp_ukind_energy
235 : CASE ("K_E")
236 291743 : unit_id(i_unit) = cp_units_k
237 291743 : 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 2200673 : unit_id(i_unit) = cp_units_bohr
246 2200673 : kind_id(i_unit) = cp_ukind_length
247 : CASE ("M")
248 45804 : unit_id(i_unit) = cp_units_m
249 45804 : 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 18586 : unit_id(i_unit) = cp_units_nm
255 18586 : kind_id(i_unit) = cp_ukind_length
256 : CASE ("ANGSTROM")
257 7753518 : unit_id(i_unit) = cp_units_angstrom
258 7753518 : 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 795355 : unit_id(i_unit) = cp_units_k
264 795355 : 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 144188 : unit_id(i_unit) = cp_units_bar
276 144188 : 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 17060 : unit_id(i_unit) = cp_units_Pa
282 17060 : 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 8813 : unit_id(i_unit) = cp_units_GPa
288 8813 : 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 216311 : unit_id(i_unit) = cp_units_rad
297 216311 : kind_id(i_unit) = cp_ukind_angle
298 : CASE ("DEG")
299 258532 : unit_id(i_unit) = cp_units_deg
300 258532 : 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 131096 : unit_id(i_unit) = cp_units_s
306 131096 : kind_id(i_unit) = cp_ukind_time
307 : CASE ("FS")
308 1432321 : unit_id(i_unit) = cp_units_fs
309 1432321 : kind_id(i_unit) = cp_ukind_time
310 : CASE ("PS")
311 421656 : unit_id(i_unit) = cp_units_ps
312 421656 : 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 106387 : unit_id(i_unit) = cp_units_au
318 106387 : 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 8678 : unit_id(i_unit) = cp_units_amu
327 8678 : 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 28669 : unit_id(i_unit) = cp_units_au
333 28669 : 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 110974 : unit_id(i_unit) = cp_units_volt
339 110974 : 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 17112 : unit_id(i_unit) = cp_units_mNewton
351 17112 : 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 18675887 : CPABORT("Unknown unit: "//string(i_low:i_high - 1))
364 : END SELECT
365 18675887 : power(i_unit) = next_power
366 : ! parse op
367 18675887 : i_low = i_high
368 18759951 : DO WHILE (i_low <= len_string)
369 2903537 : IF (string(i_low:i_low) /= ' ') EXIT
370 2903537 : i_low = i_low + 1
371 : END DO
372 : i_high = i_low
373 18675887 : DO WHILE (i_high <= len_string)
374 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
375 2819473 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
376 0 : i_high = i_high + 1
377 : END DO
378 18675887 : IF (i_high < i_low .OR. i_low > len_string) EXIT
379 :
380 2819473 : IF (i_high <= len_string) THEN
381 2819473 : IF (string(i_low:i_high) == '^') THEN
382 1944622 : i_low = i_high + 1
383 1944622 : DO WHILE (i_low <= len_string)
384 1944622 : IF (string(i_low:i_low) /= ' ') EXIT
385 1944622 : i_low = i_low + 1
386 : END DO
387 : i_high = i_low
388 5680891 : DO WHILE (i_high <= len_string)
389 1910241 : SELECT CASE (string(i_high:i_high))
390 : CASE ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')
391 3736269 : i_high = i_high + 1
392 : CASE default
393 3770650 : EXIT
394 : END SELECT
395 : END DO
396 1944622 : 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 1944622 : formatstr = "(i"//cp_to_string(i_high - i_low + 1)//")"
401 : READ (string(i_low:i_high - 1), formatstr) &
402 1944622 : next_power
403 1944622 : power(i_unit) = power(i_unit)*next_power
404 : ! next op
405 1944622 : i_low = i_high
406 1965686 : DO WHILE (i_low < len_string)
407 55412 : IF (string(i_low:i_low) /= ' ') EXIT
408 55412 : i_low = i_low + 1
409 : END DO
410 : i_high = i_low
411 1945830 : DO WHILE (i_high <= len_string)
412 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
413 35385 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
414 1241 : i_high = i_high + 1
415 : END DO
416 : END IF
417 : END IF
418 2819473 : IF (i_low > len_string) EXIT
419 909232 : next_power = 1
420 18727100 : IF (i_high <= len_string) THEN
421 909028 : IF (string(i_low:i_high) == "*" .OR. string(i_low:i_high) == '/') THEN
422 908995 : IF (string(i_low:i_high) == '/') next_power = -1
423 908995 : i_low = i_high + 1
424 908995 : DO WHILE (i_low <= len_string)
425 908995 : IF (string(i_low:i_low) /= ' ') EXIT
426 908995 : i_low = i_low + 1
427 : END DO
428 : i_high = i_low
429 4799442 : DO WHILE (i_high <= len_string)
430 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
431 4666502 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
432 4023420 : 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 17817868 : power=power)
439 17817868 : desc = cp_unit_desc(unit)
440 17817868 : 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 501539304 : 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 17912118 : CPASSERT(SIZE(kind_id) <= cp_unit_max_kinds)
461 17912118 : CPASSERT(SIZE(unit_id) <= cp_unit_max_kinds)
462 160549312 : unit%kind_id(1:SIZE(kind_id)) = kind_id
463 18571868 : unit%kind_id(SIZE(kind_id) + 1:) = cp_ukind_none
464 160549312 : unit%unit_id(1:SIZE(unit_id)) = unit_id
465 36483986 : unit%unit_id(SIZE(unit_id):) = cp_units_none
466 17912118 : IF (PRESENT(power)) THEN
467 160549312 : unit%power(1:SIZE(power)) = power
468 18571868 : unit%power(SIZE(power) + 1:) = 0
469 161209062 : DO i = 1, SIZE(unit%power)
470 161209062 : IF (unit%power(i) == 0) THEN
471 124526807 : unit%kind_id(i) = cp_ukind_none
472 124526807 : 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 17912118 : unit%n_kinds = 0
488 161209062 : DO i = 1, SIZE(unit%kind_id)
489 : ! find max and compress in the rest
490 : DO
491 143296944 : max_kind = unit%kind_id(i)
492 143296944 : max_pos = i
493 143296944 : repeat = .FALSE.
494 644836248 : DO j = i + 1, SIZE(unit%kind_id)
495 644836248 : IF (unit%kind_id(j) >= max_kind) THEN
496 371949391 : 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 371949391 : 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 874783 : max_kind = unit%kind_id(j)
513 874783 : max_pos = j
514 : END IF
515 : END IF
516 : END DO
517 143296944 : IF (.NOT. repeat) EXIT
518 : END DO
519 143296944 : IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1
520 : ! put the max at pos i
521 143296944 : IF (max_pos /= i) THEN
522 857719 : unit%kind_id(max_pos) = unit%kind_id(i)
523 857719 : unit%kind_id(i) = max_kind
524 857719 : max_kind = unit%unit_id(max_pos)
525 857719 : unit%unit_id(max_pos) = unit%unit_id(i)
526 857719 : unit%unit_id(i) = max_kind
527 857719 : max_kind = unit%power(max_pos)
528 857719 : unit%power(max_pos) = unit%power(i)
529 857719 : unit%power(i) = max_kind
530 : END IF
531 : ! check unit
532 : CALL cp_basic_unit_check(basic_kind=unit%kind_id(i), &
533 161209062 : basic_unit=unit%unit_id(i))
534 : END DO
535 17912118 : 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 17912118 : ELEMENTAL SUBROUTINE cp_unit_release(unit)
545 : TYPE(cp_unit_type), INTENT(IN) :: unit
546 :
547 : MARK_USED(unit)
548 :
549 17912118 : 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 143296944 : SUBROUTINE cp_basic_unit_check(basic_kind, basic_unit)
558 : INTEGER, INTENT(in) :: basic_kind, basic_unit
559 :
560 144153584 : SELECT CASE (basic_kind)
561 : CASE (cp_ukind_undef)
562 4978660 : SELECT CASE (basic_unit)
563 : CASE (cp_units_none)
564 : CASE default
565 856640 : CPABORT("unknown undef unit:"//TRIM(cp_to_string(basic_unit)))
566 : END SELECT
567 : CASE (cp_ukind_energy)
568 14150306 : 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 4122020 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
574 : END SELECT
575 : CASE (cp_ukind_length)
576 10833070 : 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 10028286 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
581 : END SELECT
582 : CASE (cp_ukind_temperature)
583 984286 : SELECT CASE (basic_unit)
584 : CASE (cp_units_k, cp_units_au, cp_units_none)
585 : CASE default
586 804784 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
587 : END SELECT
588 : CASE (cp_ukind_pressure)
589 663770 : 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 179502 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
593 : END SELECT
594 : CASE (cp_ukind_angle)
595 2585187 : SELECT CASE (basic_unit)
596 : CASE (cp_units_rad, cp_units_deg, cp_units_none)
597 : CASE default
598 484268 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
599 : END SELECT
600 : CASE (cp_ukind_time)
601 2147691 : 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 2100919 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
605 : END SELECT
606 : CASE (cp_ukind_mass)
607 167171 : 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 46772 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
611 : END SELECT
612 : CASE (cp_ukind_potential)
613 146946 : SELECT CASE (basic_unit)
614 : CASE (cp_units_volt, cp_units_au, cp_units_none)
615 : CASE default
616 120399 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
617 : END SELECT
618 : CASE (cp_ukind_force)
619 124553354 : SELECT CASE (basic_unit)
620 : CASE (cp_units_Newton, cp_units_mNewton, cp_units_au, cp_units_none)
621 : CASE default
622 26547 : CPABORT("unknown force unit:"//TRIM(cp_to_string(basic_unit)))
623 : END SELECT
624 : CASE (cp_ukind_none)
625 124526807 : 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 143296944 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
631 : END SELECT
632 143296944 : 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 7244143 : 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 7244143 : my_power = 1
652 7244143 : IF (PRESENT(power)) my_power = power
653 7244143 : 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 7307870 : SELECT CASE (basic_kind)
660 : CASE (cp_ukind_undef)
661 1504913 : SELECT CASE (basic_unit)
662 : CASE (cp_units_none)
663 63727 : res = value
664 : CASE default
665 63727 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
666 : END SELECT
667 : CASE (cp_ukind_energy)
668 4354000 : SELECT CASE (basic_unit)
669 : CASE (cp_units_hartree, cp_units_au)
670 185265 : 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 228921 : 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 31475 : res = 0.5_dp**my_power*value
683 : CASE (cp_units_eV)
684 969832 : 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 1441186 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
691 : END SELECT
692 : CASE (cp_ukind_length)
693 711673 : SELECT CASE (basic_unit)
694 : CASE (cp_units_bohr, cp_units_au)
695 420256 : 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 3738355 : res = value*bohr**my_power
704 : CASE default
705 4168735 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
706 : END SELECT
707 : CASE (cp_ukind_temperature)
708 374231 : SELECT CASE (basic_unit)
709 : CASE (cp_units_k)
710 291413 : res = kelvin**(-my_power)*value
711 : CASE (cp_units_au)
712 4 : res = value
713 : CASE default
714 291417 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
715 : END SELECT
716 : CASE (cp_ukind_pressure)
717 366116 : SELECT CASE (basic_unit)
718 : CASE (cp_units_bar)
719 74004 : 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 8530 : 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 82818 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
734 : END SELECT
735 : CASE (cp_ukind_angle)
736 973948 : SELECT CASE (basic_unit)
737 : CASE (cp_units_rad)
738 70096 : res = value
739 : CASE (cp_units_deg)
740 222016 : res = value*(radians)**my_power
741 : CASE default
742 292112 : 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 527444 : res = value*femtoseconds**(-my_power)
750 : CASE (cp_units_ps)
751 327123 : res = value*picoseconds**(-my_power)
752 : CASE (cp_units_au)
753 49227 : res = value
754 : CASE (cp_units_wn)
755 34 : res = (twopi*wavenumbers)**(my_power)/value
756 : CASE default
757 903852 : 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 7244143 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
796 : END SELECT
797 7244143 : 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 18675887 : 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 18675887 : my_power = 1
819 18675887 : res = ""
820 18675887 : my_accept_undefined = .FALSE.
821 18675887 : IF (accept_undefined) my_accept_undefined = accept_undefined
822 18675887 : IF (PRESENT(power)) my_power = power
823 18675887 : IF (basic_unit == cp_units_none) THEN
824 847215 : 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 19523102 : SELECT CASE (basic_kind)
829 : CASE (cp_ukind_undef)
830 4959810 : SELECT CASE (basic_unit)
831 : CASE (cp_units_none)
832 847215 : res = "internal_cp2k"
833 : CASE DEFAULT
834 : CALL cp_abort(__LOCATION__, &
835 : "unit not yet fully specified, unit of kind "// &
836 847215 : TRIM(res))
837 : END SELECT
838 : CASE (cp_ukind_energy)
839 10999135 : SELECT CASE (basic_unit)
840 : CASE (cp_units_hartree, cp_units_au)
841 980274 : 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 356817 : 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 228778 : res = "Ry"
854 : CASE (cp_units_eV)
855 2224062 : res = "eV"
856 : CASE (cp_units_keV)
857 28673 : res = "keV"
858 : CASE (cp_units_k)
859 291743 : 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 4112595 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
868 : END SELECT
869 : CASE (cp_ukind_length)
870 2996310 : SELECT CASE (basic_unit)
871 : CASE (cp_units_bohr, cp_units_au)
872 2200951 : res = "bohr"
873 : CASE (cp_units_m)
874 45804 : res = "m"
875 : CASE (cp_units_pm)
876 2 : res = "pm"
877 : CASE (cp_units_nm)
878 18586 : res = "nm"
879 : CASE (cp_units_angstrom)
880 7753518 : res = "angstrom"
881 : CASE default
882 0 : res = "length"
883 10018861 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
884 : END SELECT
885 : CASE (cp_ukind_temperature)
886 965432 : SELECT CASE (basic_unit)
887 : CASE (cp_units_k)
888 795355 : 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 795359 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
899 : END SELECT
900 : CASE (cp_ukind_pressure)
901 619031 : SELECT CASE (basic_unit)
902 : CASE (cp_units_bar)
903 144188 : 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 17060 : res = "Pa"
910 : CASE (cp_units_MPa)
911 0 : res = "MPa"
912 : CASE (cp_units_GPa)
913 8813 : 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 170077 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
924 : END SELECT
925 : CASE (cp_ukind_angle)
926 2307805 : SELECT CASE (basic_unit)
927 : CASE (cp_units_rad)
928 216311 : res = "rad"
929 : CASE (cp_units_deg)
930 258532 : 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 474843 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
939 : END SELECT
940 : CASE (cp_ukind_time)
941 168443 : SELECT CASE (basic_unit)
942 : CASE (cp_units_s)
943 131096 : res = "s"
944 : CASE (cp_units_fs)
945 1432321 : res = "fs"
946 : CASE (cp_units_ps)
947 421656 : res = "ps"
948 : CASE (cp_units_au)
949 106387 : 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 2091494 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
960 : END SELECT
961 : CASE (cp_ukind_mass)
962 110974 : SELECT CASE (basic_unit)
963 : CASE (cp_units_kg)
964 0 : res = "kg"
965 : CASE (cp_units_amu)
966 8678 : res = "amu"
967 : CASE (cp_units_m_e, cp_units_au)
968 28669 : 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 37347 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
977 : END SELECT
978 : CASE (cp_ukind_potential)
979 128096 : SELECT CASE (basic_unit)
980 : CASE (cp_units_volt)
981 110974 : 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 110974 : 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 17112 : 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 17122 : 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 18675887 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
1016 : END SELECT
1017 18675887 : IF (my_power /= 1) THEN
1018 2060482 : a = LEN_TRIM(res)
1019 2060482 : CPASSERT(LEN(res) - a >= 3)
1020 2060482 : WRITE (res(a + 1:), "('^',i3)") my_power
1021 2060482 : CALL compress(res, .TRUE.)
1022 : END IF
1023 18675887 : 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 17817868 : 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 17817868 : res = ""
1045 17817868 : pos = 1
1046 17817868 : my_accept_undefined = .FALSE.
1047 17817868 : IF (PRESENT(accept_undefined)) my_accept_undefined = accept_undefined
1048 36493755 : DO i = 1, unit%n_kinds
1049 18675887 : CPASSERT(unit%kind_id(i) /= 0)
1050 18675887 : CPASSERT(pos < LEN(res))
1051 18675887 : my_unit = unit%unit_id(i)
1052 18675887 : has_defaults = .FALSE.
1053 18675887 : IF (PRESENT(defaults)) has_defaults = ASSOCIATED(defaults%units(1)%unit)
1054 18675887 : 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 18675887 : IF (i > 1) THEN
1063 909199 : res(pos:pos) = "*"
1064 909199 : 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 18675887 : power=unit%power(i)))
1069 36493755 : pos = LEN_TRIM(res) + 1
1070 : END DO
1071 :
1072 17817868 : 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 6694239 : 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 6694239 : my_power = 1
1094 6694239 : IF (PRESENT(power)) my_power = power
1095 6694239 : res = value
1096 13938382 : DO i_unit = 1, unit%n_kinds
1097 7244143 : CPASSERT(unit%kind_id(i_unit) > 0)
1098 7244143 : my_basic_unit = unit%unit_id(i_unit)
1099 7244143 : 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 13938382 : power=my_power*unit%power(i_unit))
1107 : END DO
1108 6694239 : 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 755908 : 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 755908 : my_power = 1
1130 755908 : IF (PRESENT(power)) my_power = power
1131 755908 : IF (PRESENT(defaults)) THEN
1132 : res = cp_unit_to_cp2k1(value=value, unit=unit, defaults=defaults, &
1133 0 : power=-my_power)
1134 : ELSE
1135 755908 : res = cp_unit_to_cp2k1(value=value, unit=unit, power=-my_power)
1136 : END IF
1137 755908 : 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 5834898 : 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 5834898 : CALL cp_unit_create(my_unit, unit_str)
1159 5834898 : IF (PRESENT(defaults)) THEN
1160 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1161 0 : power=power)
1162 : ELSE
1163 5834898 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, power=power)
1164 : END IF
1165 5834898 : CALL cp_unit_release(my_unit)
1166 157542246 : 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 552312 : 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 552312 : CALL cp_unit_create(my_unit, unit_str)
1188 552312 : IF (PRESENT(defaults)) THEN
1189 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1190 0 : power=power)
1191 : ELSE
1192 552312 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, power=power)
1193 : END IF
1194 552312 : CALL cp_unit_release(my_unit)
1195 14912424 : 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 103433 : 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 103433 : res = .TRUE.
1211 930897 : DO i = 1, SIZE(ref_unit%kind_id)
1212 827464 : 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 930897 : EXIT
1216 : END DO
1217 :
1218 103433 : 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 103675 : 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 9425 : my_name = name
1235 9425 : CALL uppercase(my_name)
1236 :
1237 103675 : DO i = 1, cp_ukind_max
1238 94250 : NULLIFY (unit_set%units(i)%unit)
1239 2365675 : ALLOCATE (unit_set%units(i)%unit)
1240 : END DO
1241 103675 : DO i = 1, cp_ukind_max
1242 9425 : 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 9425 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : 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 18850 : power=(/1/))
1283 : CASE default
1284 0 : CPABORT("unhandled unit type "//TRIM(cp_to_string(i)))
1285 94250 : EXIT
1286 : END SELECT
1287 : CASE default
1288 94250 : CPABORT('unknown parameter set name '//TRIM(name))
1289 : END SELECT
1290 : END DO
1291 9425 : 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 9425 : SUBROUTINE cp_unit_set_release(unit_set)
1299 : TYPE(cp_unit_set_type), INTENT(INOUT) :: unit_set
1300 :
1301 : INTEGER :: i
1302 :
1303 103675 : DO i = 1, SIZE(unit_set%units)
1304 94250 : CALL cp_unit_release(unit_set%units(i)%unit)
1305 103675 : DEALLOCATE (unit_set%units(i)%unit)
1306 : END DO
1307 :
1308 9425 : 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
|
