37 atm,
bar,
bohr,
e_mass,
evolt,
femtoseconds,
joule,
kcalmol,
kelvin,
kjmol,
massunit, &
42#include "../base/base_uses.f90"
47 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
48 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'cp_units'
132 INTEGER :: n_kinds = -1
133 INTEGER,
DIMENSION(cp_unit_max_kinds):: kind_id = -1, unit_id = -1, power = -1
143 END TYPE cp_unit_p_type
150 TYPE(cp_unit_p_type),
DIMENSION(cp_ukind_max) :: units = cp_unit_p_type()
163 CHARACTER(len=*),
INTENT(in) :: string
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, &
170 INTEGER,
DIMENSION(cp_unit_max_kinds) :: kind_id, power, unit_id
177 len_string = len(string)
180 DO WHILE (i_low < len_string)
181 IF (string(i_low:i_low) /=
' ')
EXIT
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
191 IF (i_high <= i_low .OR. i_low > len_string)
EXIT
194 cpabort(
"Maximum number of combined units exceeded")
198 unit_string = string(i_low:i_high - 1)
200 SELECT CASE (trim(unit_string))
201 CASE (
"INTERNAL_CP2K")
210 CASE (
"WAVENUMBER_E")
312 CASE (
"WAVENUMBER_T")
348 CASE (
"MN",
"MNEWTON")
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)")
362 cpabort(
"Unknown unit: "//string(i_low:i_high - 1))
364 power(i_unit) = next_power
367 DO WHILE (i_low <= len_string)
368 IF (string(i_low:i_low) /=
' ')
EXIT
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
377 IF (i_high < i_low .OR. i_low > len_string)
EXIT
379 IF (i_high <= len_string)
THEN
380 IF (string(i_low:i_high) ==
'^')
THEN
382 DO WHILE (i_low <= len_string)
383 IF (string(i_low:i_low) /=
' ')
EXIT
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')
395 IF (i_high <= i_low .OR. i_low > len_string)
THEN
396 cpabort(
"an integer number is expected after a '^'")
400 READ (string(i_low:i_high - 1), formatstr) &
402 power(i_unit) = power(i_unit)*next_power
405 DO WHILE (i_low < len_string)
406 IF (string(i_low:i_low) /=
' ')
EXIT
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
417 IF (i_low > len_string)
EXIT
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
423 DO WHILE (i_low <= len_string)
424 IF (string(i_low:i_low) /=
' ')
EXIT
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
436 CALL cp_unit_create2(unit, kind_id=kind_id, unit_id=unit_id, &
451 SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power)
453 INTEGER,
DIMENSION(:),
INTENT(in) :: kind_id, unit_id
454 INTEGER,
DIMENSION(:),
INTENT(in),
OPTIONAL :: power
456 INTEGER :: i, j, max_kind, max_pos
461 unit%kind_id(1:
SIZE(kind_id)) = kind_id
463 unit%unit_id(1:
SIZE(unit_id)) = unit_id
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
475 DO i = 1,
SIZE(unit%power)
476 IF (unit%unit_id(i) /= 0)
THEN
487 DO i = 1,
SIZE(unit%kind_id)
490 max_kind = unit%kind_id(i)
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)
501 IF (unit%power(max_pos) == 0)
THEN
504 unit%power(max_pos) = 0
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)
516 IF (.NOT. repeat)
EXIT
518 IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1
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
531 CALL cp_basic_unit_check(basic_kind=unit%kind_id(i), &
532 basic_unit=unit%unit_id(i))
534 END SUBROUTINE cp_unit_create2
556 SUBROUTINE cp_basic_unit_check(basic_kind, basic_unit)
557 INTEGER,
INTENT(in) :: basic_kind, basic_unit
559 SELECT CASE (basic_kind)
561 SELECT CASE (basic_unit)
564 cpabort(
"unknown undef unit:"//trim(
cp_to_string(basic_unit)))
567 SELECT CASE (basic_unit)
572 cpabort(
"unknown energy unit:"//trim(
cp_to_string(basic_unit)))
575 SELECT CASE (basic_unit)
579 cpabort(
"unknown length unit:"//trim(
cp_to_string(basic_unit)))
582 SELECT CASE (basic_unit)
585 cpabort(
"unknown temperature unit:"//trim(
cp_to_string(basic_unit)))
588 SELECT CASE (basic_unit)
591 cpabort(
"unknown pressure unit:"//trim(
cp_to_string(basic_unit)))
594 SELECT CASE (basic_unit)
597 cpabort(
"unknown angle unit:"//trim(
cp_to_string(basic_unit)))
600 SELECT CASE (basic_unit)
603 cpabort(
"unknown time unit:"//trim(
cp_to_string(basic_unit)))
606 SELECT CASE (basic_unit)
609 cpabort(
"unknown mass unit:"//trim(
cp_to_string(basic_unit)))
612 SELECT CASE (basic_unit)
615 cpabort(
"unknown potential unit:"//trim(
cp_to_string(basic_unit)))
618 SELECT CASE (basic_unit)
621 cpabort(
"unknown force unit:"//trim(
cp_to_string(basic_unit)))
625 CALL cp_abort(__location__, &
626 "if the kind of the unit is none also unit must be undefined,not:" &
629 cpabort(
"unknown kind of unit:"//trim(
cp_to_string(basic_kind)))
631 END SUBROUTINE cp_basic_unit_check
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
651 IF (
PRESENT(power)) my_power = power
654 CALL cp_abort(__location__, &
655 "unit not yet fully specified, unit of kind "// &
658 SELECT CASE (basic_kind)
660 SELECT CASE (basic_unit)
664 cpabort(
"unknown energy unit:"//trim(
cp_to_string(basic_unit)))
667 SELECT CASE (basic_unit)
673 res =
joule**(-my_power)*
value
675 res =
kcalmol**(-my_power)*
value
677 res =
kjmol**(-my_power)*
value
679 res = (
kjmol*1.0e+3_dp)**(-my_power)*
value
681 res = 0.5_dp**my_power*
value
683 res =
evolt**(-my_power)*
value
685 res = (1.0e-3_dp*
evolt)**(-my_power)*
value
687 res =
kelvin**(-my_power)*
value
689 cpabort(
"unknown energy unit:"//trim(
cp_to_string(basic_unit)))
692 SELECT CASE (basic_unit)
696 res =
value*(1.0e10_dp*
bohr)**my_power
698 res =
value*(0.01_dp*
bohr)**my_power
700 res =
value*(10.0_dp*
bohr)**my_power
702 res =
value*
bohr**my_power
704 cpabort(
"unknown length unit:"//trim(
cp_to_string(basic_unit)))
707 SELECT CASE (basic_unit)
709 res =
kelvin**(-my_power)*
value
713 cpabort(
"unknown temperature unit:"//trim(
cp_to_string(basic_unit)))
716 SELECT CASE (basic_unit)
718 res =
bar**(-my_power)*
value
720 res =
atm**(-my_power)*
value
722 res = (1.0e-3_dp*
bar)**(-my_power)*
value
724 res =
pascal**(-my_power)*
value
726 res = (1.0e-6_dp*
pascal)**(-my_power)*
value
728 res = (1.0e-9_dp*
pascal)**(-my_power)*
value
732 cpabort(
"unknown pressure unit:"//trim(
cp_to_string(basic_unit)))
735 SELECT CASE (basic_unit)
739 res =
value*(
radians)**my_power
741 cpabort(
"unknown angle unit:"//trim(
cp_to_string(basic_unit)))
744 SELECT CASE (basic_unit)
746 res =
value*
seconds**(-my_power)
756 cpabort(
"unknown time unit:"//trim(
cp_to_string(basic_unit)))
759 SELECT CASE (basic_unit)
761 res =
e_mass**my_power*
value
767 cpabort(
"unknown mass unit:"//trim(
cp_to_string(basic_unit)))
770 SELECT CASE (basic_unit)
772 res =
evolt**(-my_power)*
value
776 cpabort(
"unknown potential unit:"//trim(
cp_to_string(basic_unit)))
779 SELECT CASE (basic_unit)
781 res =
value*
newton**(-my_power)
783 res =
value*(1.0e+3*
newton)**(-my_power)
787 cpabort(
"unknown force unit:"//trim(
cp_to_string(basic_unit)))
790 CALL cp_abort(__location__, &
791 "if the kind of the unit is none also unit must be undefined,not:" &
794 cpabort(
"unknown kind of unit:"//trim(
cp_to_string(basic_kind)))
796 END FUNCTION cp_basic_unit_to_cp2k
807 FUNCTION cp_basic_unit_desc(basic_kind, basic_unit, power, accept_undefined) &
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
814 INTEGER :: a, my_power
815 LOGICAL :: my_accept_undefined
819 my_accept_undefined = .false.
820 IF (accept_undefined) my_accept_undefined = accept_undefined
821 IF (
PRESENT(power)) my_power = power
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 "// &
827 SELECT CASE (basic_kind)
829 SELECT CASE (basic_unit)
831 res =
"internal_cp2k"
833 CALL cp_abort(__location__, &
834 "unit not yet fully specified, unit of kind "// &
838 SELECT CASE (basic_unit)
861 IF (.NOT. my_accept_undefined) &
862 CALL cp_abort(__location__, &
863 "unit not yet fully specified, unit of kind "// &
866 cpabort(
"unknown energy unit:"//trim(
cp_to_string(basic_unit)))
869 SELECT CASE (basic_unit)
882 cpabort(
"unknown length unit:"//trim(
cp_to_string(basic_unit)))
885 SELECT CASE (basic_unit)
892 IF (.NOT. my_accept_undefined) &
893 CALL cp_abort(__location__, &
894 "unit not yet fully specified, unit of kind "// &
897 cpabort(
"unknown temperature unit:"//trim(
cp_to_string(basic_unit)))
900 SELECT CASE (basic_unit)
917 IF (.NOT. my_accept_undefined) &
918 CALL cp_abort(__location__, &
919 "unit not yet fully specified, unit of kind "// &
922 cpabort(
"unknown pressure unit:"//trim(
cp_to_string(basic_unit)))
925 SELECT CASE (basic_unit)
932 IF (.NOT. my_accept_undefined) &
933 CALL cp_abort(__location__, &
934 "unit not yet fully specified, unit of kind "// &
937 cpabort(
"unknown angle unit:"//trim(
cp_to_string(basic_unit)))
940 SELECT CASE (basic_unit)
953 IF (.NOT. my_accept_undefined) &
954 CALL cp_abort(__location__, &
955 "unit not yet fully specified, unit of kind "// &
958 cpabort(
"unknown time unit:"//trim(
cp_to_string(basic_unit)))
961 SELECT CASE (basic_unit)
970 IF (.NOT. my_accept_undefined) &
971 CALL cp_abort(__location__, &
972 "unit not yet fully specified, unit of kind "// &
975 cpabort(
"unknown mass unit:"//trim(
cp_to_string(basic_unit)))
978 SELECT CASE (basic_unit)
985 IF (.NOT. my_accept_undefined) &
986 CALL cp_abort(__location__, &
987 "unit not yet fully specified, unit of kind "// &
990 cpabort(
"unknown potential unit:"//trim(
cp_to_string(basic_unit)))
993 SELECT CASE (basic_unit)
1002 IF (.NOT. my_accept_undefined) &
1003 CALL cp_abort(__location__, &
1004 "unit not yet fully specified, unit of kind "// &
1007 cpabort(
"unknown potential unit:"//trim(
cp_to_string(basic_unit)))
1010 CALL cp_abort(__location__, &
1011 "if the kind of the unit is none also unit must be undefined,not:" &
1014 cpabort(
"unknown kind of unit:"//trim(
cp_to_string(basic_kind)))
1016 IF (my_power /= 1)
THEN
1018 cpassert(len(res) - a >= 3)
1019 WRITE (res(a + 1:),
"('^',i3)") my_power
1022 END FUNCTION cp_basic_unit_desc
1037 LOGICAL,
INTENT(in),
OPTIONAL :: accept_undefined
1038 CHARACTER(len=cp_unit_desc_length) :: res
1040 INTEGER :: i, my_unit, pos
1041 LOGICAL :: check, has_defaults, my_accept_undefined
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)
1057 check = my_accept_undefined .OR. unit%kind_id(i) /= 0
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
1084 REAL(kind=
dp),
INTENT(in) ::
value
1087 INTEGER,
INTENT(in),
OPTIONAL :: power
1088 REAL(kind=
dp) :: res
1090 INTEGER :: i_unit, my_basic_unit, my_power
1093 IF (
PRESENT(power)) my_power = power
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)
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))
1120 REAL(kind=
dp),
INTENT(in) ::
value
1123 INTEGER,
INTENT(in),
OPTIONAL :: power
1124 REAL(kind=
dp) :: res
1129 IF (
PRESENT(power)) my_power = power
1130 IF (
PRESENT(defaults))
THEN
1149 REAL(kind=
dp),
INTENT(in) ::
value
1150 CHARACTER(len=*),
INTENT(in) :: unit_str
1152 INTEGER,
INTENT(in),
OPTIONAL :: power
1153 REAL(kind=
dp) :: res
1158 IF (
PRESENT(defaults))
THEN
1178 REAL(kind=
dp),
INTENT(in) ::
value
1179 CHARACTER(len=*),
INTENT(in) :: unit_str
1181 INTEGER,
INTENT(in),
OPTIONAL :: power
1182 REAL(kind=
dp) :: res
1187 IF (
PRESENT(defaults))
THEN
1210 DO i = 1,
SIZE(ref_unit%kind_id)
1211 IF (ref_unit%kind_id(i) == unit%kind_id(i)) cycle
1228 CHARACTER(len=*),
INTENT(in) :: name
1230 CHARACTER(len=cp_unit_desc_length) :: my_name
1237 NULLIFY (unit_set%units(i)%unit)
1238 ALLOCATE (unit_set%units(i)%unit)
1242 CASE (
'ATOM',
'ATOMIC',
'INTERNAL',
'CP2K')
1244 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), &
1247 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), &
1253 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_none/), &
1256 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_hartree/), &
1259 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_angstrom/), &
1262 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_k/), &
1265 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_deg/), &
1268 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_bar/), &
1271 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_fs/), &
1274 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_amu/), &
1277 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_volt/), &
1280 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/
cp_units_newton/), &
1287 cpabort(
'unknown parameter set name '//trim(name))
1302 DO i = 1,
SIZE(unit_set%units)
1304 DEALLOCATE (unit_set%units(i)%unit)
1315 INTEGER,
INTENT(IN) :: iw
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)
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
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>'
1348 WRITE (iw, fmt=
'(T3,A)')
'<UNIT>'//trim(unit_kind)//
'</UNIT>'
1349 WRITE (iw, fmt=
'(T2,A)')
'</UNIT_KIND>'
1350 END SUBROUTINE format_units_as_xml
various routines to log and control the output. The idea is that decisions about where to log should ...
integer, parameter, public cp_units_wavenum
integer, parameter, public cp_ukind_none
integer, parameter, public cp_units_fs
integer, parameter, public cp_units_kev
integer, parameter, public cp_units_m
integer, parameter, public cp_units_k
integer, parameter, public cp_ukind_potential
integer, parameter, public cp_units_mpa
integer, parameter, public cp_ukind_undef
integer, parameter, public cp_units_none
integer, parameter, public cp_units_angstrom
integer, parameter, public cp_units_volt
character(len=cp_unit_desc_length) function, public cp_unit_desc(unit, defaults, accept_undefined)
returns the "name" of the given unit
real(kind=dp) function, public cp_unit_to_cp2k1(value, unit, defaults, power)
transform a value to the internal cp2k units
integer, parameter, public cp_units_au
integer, parameter, public cp_ukind_length
integer, parameter, public cp_ukind_temperature
real(kind=dp) function, public cp_unit_from_cp2k1(value, unit, defaults, power)
converts from the internal cp2k units to the given unit
integer, parameter, public cp_units_hartree
integer, parameter, public cp_units_nm
integer, parameter, public cp_units_bar
integer, parameter, public cp_units_amu
integer, parameter, public cp_ukind_time
integer, parameter, public cp_ukind_energy
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
subroutine, public cp_unit_create(unit, string)
creates a unit parsing a string
integer, parameter, public cp_ukind_force
integer, parameter, public cp_unit_desc_length
integer, parameter, public cp_units_kbar
integer, parameter, public cp_units_newton
integer, parameter, public cp_units_ps
integer, parameter, public cp_units_ev
integer, parameter, public cp_ukind_max
integer, parameter, public cp_units_mnewton
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
integer, parameter, public cp_units_atm
integer, parameter, public cp_units_deg
subroutine, public cp_unit_set_release(unit_set)
releases the given unit set
integer, parameter, public cp_units_ry
integer, parameter, public cp_units_kcalmol
integer, parameter, public cp_units_rad
integer, parameter, public cp_units_pa
integer, parameter, public cp_units_jmol
integer, parameter, public cp_units_joule
integer, parameter, public cp_unit_basic_desc_length
subroutine, public cp_unit_set_create(unit_set, name)
initializes the given unit set
integer, parameter, public cp_units_gpa
integer, parameter, public cp_units_bohr
subroutine, public export_units_as_xml(iw)
Exports all available units as XML.
integer, parameter, public cp_units_kjmol
integer, parameter, public cp_units_wn
integer, parameter, public cp_units_m_e
integer, parameter, public cp_units_pm
integer, parameter, public cp_units_kg
integer, parameter, public cp_ukind_mass
logical function, public cp_unit_compatible(ref_unit, unit)
returs true if the two units are compatible
elemental subroutine, public cp_unit_release(unit)
releases the given unit
integer, parameter, public cp_ukind_angle
integer, parameter, public cp_units_s
integer, parameter, public cp_unit_max_kinds
integer, parameter, public cp_ukind_pressure
Defines the basic variable types.
integer, parameter, public dp
Definition of mathematical constants and functions.
real(kind=dp), parameter, public radians
real(kind=dp), parameter, public twopi
Definition of physical constants:
real(kind=dp), parameter, public kcalmol
real(kind=dp), parameter, public femtoseconds
real(kind=dp), parameter, public atm
real(kind=dp), parameter, public joule
real(kind=dp), parameter, public kelvin
real(kind=dp), parameter, public newton
real(kind=dp), parameter, public seconds
real(kind=dp), parameter, public evolt
real(kind=dp), parameter, public e_mass
real(kind=dp), parameter, public picoseconds
real(kind=dp), parameter, public wavenumbers
real(kind=dp), parameter, public bar
real(kind=dp), parameter, public massunit
real(kind=dp), parameter, public kjmol
real(kind=dp), parameter, public pascal
real(kind=dp), parameter, public bohr
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