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