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, print_all_units
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 419632475 : 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 16785299 : 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 151067691 : unit_id = cp_units_none
174 16785299 : kind_id = cp_ukind_none
175 16785299 : power = 0
176 16785299 : i_low = 1
177 16785299 : i_high = 1
178 16785299 : len_string = LEN(string)
179 16785299 : i_unit = 0
180 16785299 : next_power = 1
181 16785299 : DO WHILE (i_low < len_string)
182 15990495 : IF (string(i_low:i_low) /= ' ') EXIT
183 15990495 : i_low = i_low + 1
184 : END DO
185 : i_high = i_low
186 113400710 : DO WHILE (i_high <= len_string)
187 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
188 98644168 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
189 98644168 : i_high = i_high + 1
190 : END DO
191 : DO
192 17690946 : IF (i_high <= i_low .OR. i_low > len_string) EXIT
193 17640555 : i_unit = i_unit + 1
194 17640555 : 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 17640555 : unit_string = string(i_low:i_high - 1)
200 17640555 : CALL uppercase(unit_string)
201 18477042 : SELECT CASE (TRIM(unit_string))
202 : CASE ("INTERNAL_CP2K")
203 836487 : unit_id(i_unit) = cp_units_none
204 836487 : kind_id(i_unit) = cp_ukind_undef
205 : CASE ("HARTREE")
206 803545 : unit_id(i_unit) = cp_units_hartree
207 803545 : kind_id(i_unit) = cp_ukind_energy
208 : CASE ("AU_E")
209 98212 : unit_id(i_unit) = cp_units_au
210 98212 : 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 354471 : unit_id(i_unit) = cp_units_kcalmol
219 354471 : 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 126016 : unit_id(i_unit) = cp_units_Ry
228 126016 : kind_id(i_unit) = cp_ukind_energy
229 : CASE ("EV")
230 1780648 : unit_id(i_unit) = cp_units_eV
231 1780648 : kind_id(i_unit) = cp_ukind_energy
232 : CASE ("KEV")
233 28539 : unit_id(i_unit) = cp_units_keV
234 28539 : kind_id(i_unit) = cp_ukind_energy
235 : CASE ("K_E")
236 288029 : unit_id(i_unit) = cp_units_k
237 288029 : 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 2060320 : unit_id(i_unit) = cp_units_bohr
246 2060320 : kind_id(i_unit) = cp_ukind_length
247 : CASE ("M")
248 45394 : unit_id(i_unit) = cp_units_m
249 45394 : 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 18448 : unit_id(i_unit) = cp_units_nm
255 18448 : kind_id(i_unit) = cp_ukind_length
256 : CASE ("ANGSTROM")
257 7538818 : unit_id(i_unit) = cp_units_angstrom
258 7538818 : 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 780268 : unit_id(i_unit) = cp_units_k
264 780268 : 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 138577 : unit_id(i_unit) = cp_units_bar
276 138577 : kind_id(i_unit) = cp_ukind_pressure
277 : CASE ("KBAR")
278 12 : unit_id(i_unit) = cp_units_kbar
279 12 : kind_id(i_unit) = cp_ukind_pressure
280 : CASE ("PA")
281 16784 : unit_id(i_unit) = cp_units_Pa
282 16784 : 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 8415 : unit_id(i_unit) = cp_units_GPa
288 8415 : 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 213827 : unit_id(i_unit) = cp_units_rad
297 213827 : kind_id(i_unit) = cp_ukind_angle
298 : CASE ("DEG")
299 256202 : unit_id(i_unit) = cp_units_deg
300 256202 : 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 129306 : unit_id(i_unit) = cp_units_s
306 129306 : kind_id(i_unit) = cp_ukind_time
307 : CASE ("FS")
308 1424337 : unit_id(i_unit) = cp_units_fs
309 1424337 : kind_id(i_unit) = cp_ukind_time
310 : CASE ("PS")
311 420576 : unit_id(i_unit) = cp_units_ps
312 420576 : 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 107657 : unit_id(i_unit) = cp_units_au
318 107657 : 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 8540 : unit_id(i_unit) = cp_units_amu
327 8540 : 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 28535 : unit_id(i_unit) = cp_units_au
333 28535 : 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 109180 : unit_id(i_unit) = cp_units_volt
339 109180 : 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 16836 : unit_id(i_unit) = cp_units_mNewton
351 16836 : 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 17640555 : CPABORT("Unknown unit: "//string(i_low:i_high - 1))
364 : END SELECT
365 17640555 : power(i_unit) = next_power
366 : ! parse op
367 17640555 : i_low = i_high
368 17748979 : DO WHILE (i_low <= len_string)
369 2913123 : IF (string(i_low:i_low) /= ' ') EXIT
370 2913123 : i_low = i_low + 1
371 : END DO
372 : i_high = i_low
373 17640555 : DO WHILE (i_high <= len_string)
374 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
375 2804699 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
376 2804699 : i_high = i_high + 1
377 : END DO
378 17640555 : IF (i_high < i_low .OR. i_low > len_string) EXIT
379 :
380 2804699 : IF (i_high <= len_string) THEN
381 2804699 : IF (string(i_low:i_high) == '^') THEN
382 1932887 : i_low = i_high + 1
383 1932887 : DO WHILE (i_low <= len_string)
384 1932887 : IF (string(i_low:i_low) /= ' ') EXIT
385 1932887 : i_low = i_low + 1
386 : END DO
387 : i_high = i_low
388 5647720 : DO WHILE (i_high <= len_string)
389 1899052 : SELECT CASE (string(i_high:i_high))
390 : CASE ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')
391 3714833 : i_high = i_high + 1
392 : CASE default
393 3748668 : EXIT
394 : END SELECT
395 : END DO
396 1932887 : 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 1932887 : formatstr = "(i"//cp_to_string(i_high - i_low + 1)//")"
401 : READ (string(i_low:i_high - 1), formatstr) &
402 1932887 : next_power
403 1932887 : power(i_unit) = power(i_unit)*next_power
404 : ! next op
405 1932887 : i_low = i_high
406 1960005 : DO WHILE (i_low < len_string)
407 60914 : IF (string(i_low:i_low) /= ' ') EXIT
408 60914 : i_low = i_low + 1
409 : END DO
410 : i_high = i_low
411 1934095 : DO WHILE (i_high <= len_string)
412 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
413 34839 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
414 34839 : i_high = i_high + 1
415 : END DO
416 : END IF
417 : END IF
418 2804699 : IF (i_low > len_string) EXIT
419 905647 : next_power = 1
420 17690946 : IF (i_high <= len_string) THEN
421 905443 : IF (string(i_low:i_high) == "*" .OR. string(i_low:i_high) == '/') THEN
422 905404 : IF (string(i_low:i_high) == '/') next_power = -1
423 905404 : i_low = i_high + 1
424 905404 : DO WHILE (i_low <= len_string)
425 905404 : IF (string(i_low:i_low) /= ' ') EXIT
426 905404 : i_low = i_low + 1
427 : END DO
428 : i_high = i_low
429 4775963 : DO WHILE (i_high <= len_string)
430 : IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. &
431 4646642 : string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT
432 4776002 : 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 16785299 : power=power)
439 16785299 : desc = cp_unit_desc(unit)
440 16785299 : 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 472588732 : 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 16878169 : CPASSERT(SIZE(kind_id) <= cp_unit_max_kinds)
461 16878169 : CPASSERT(SIZE(unit_id) <= cp_unit_max_kinds)
462 151253431 : unit%kind_id(1:SIZE(kind_id)) = kind_id
463 17528259 : unit%kind_id(SIZE(kind_id) + 1:) = cp_ukind_none
464 151253431 : unit%unit_id(1:SIZE(unit_id)) = unit_id
465 34406428 : unit%unit_id(SIZE(unit_id):) = cp_units_none
466 16878169 : IF (PRESENT(power)) THEN
467 151253431 : unit%power(1:SIZE(power)) = power
468 17528259 : unit%power(SIZE(power) + 1:) = 0
469 151903521 : DO i = 1, SIZE(unit%power)
470 151903521 : IF (unit%power(i) == 0) THEN
471 117291927 : unit%kind_id(i) = cp_ukind_none
472 117291927 : 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 16878169 : unit%n_kinds = 0
488 151903521 : DO i = 1, SIZE(unit%kind_id)
489 : ! find max and compress in the rest
490 : DO
491 135025352 : max_kind = unit%kind_id(i)
492 135025352 : max_pos = i
493 135025352 : repeat = .FALSE.
494 607614084 : DO j = i + 1, SIZE(unit%kind_id)
495 607614084 : IF (unit%kind_id(j) >= max_kind) THEN
496 350248897 : 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 : repeat = .TRUE.
507 : EXIT
508 : END IF
509 350248897 : 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 871744 : max_kind = unit%kind_id(j)
513 871744 : max_pos = j
514 : END IF
515 : END IF
516 : END DO
517 : IF (.NOT. repeat) EXIT
518 : END DO
519 135025352 : IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1
520 : ! put the max at pos i
521 135025352 : IF (max_pos /= i) THEN
522 854956 : unit%kind_id(max_pos) = unit%kind_id(i)
523 854956 : unit%kind_id(i) = max_kind
524 854956 : max_kind = unit%unit_id(max_pos)
525 854956 : unit%unit_id(max_pos) = unit%unit_id(i)
526 854956 : unit%unit_id(i) = max_kind
527 854956 : max_kind = unit%power(max_pos)
528 854956 : unit%power(max_pos) = unit%power(i)
529 854956 : unit%power(i) = max_kind
530 : END IF
531 : ! check unit
532 : CALL cp_basic_unit_check(basic_kind=unit%kind_id(i), &
533 151903521 : basic_unit=unit%unit_id(i))
534 : END DO
535 16878169 : 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 16878169 : ELEMENTAL SUBROUTINE cp_unit_release(unit)
545 : TYPE(cp_unit_type), INTENT(IN) :: unit
546 :
547 : MARK_USED(unit)
548 :
549 16878169 : 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 135025352 : SUBROUTINE cp_basic_unit_check(basic_kind, basic_unit)
558 : INTEGER, INTENT(in) :: basic_kind, basic_unit
559 :
560 135871126 : SELECT CASE (basic_kind)
561 : CASE (cp_ukind_undef)
562 4336769 : SELECT CASE (basic_unit)
563 : CASE (cp_units_none)
564 : CASE default
565 845774 : CPABORT("unknown undef unit:"//TRIM(cp_to_string(basic_unit)))
566 : END SELECT
567 : CASE (cp_ukind_energy)
568 13163542 : 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 3490995 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
574 : END SELECT
575 : CASE (cp_ukind_length)
576 10462106 : 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 9672547 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
581 : END SELECT
582 : CASE (cp_ukind_temperature)
583 962634 : SELECT CASE (basic_unit)
584 : CASE (cp_units_k, cp_units_au, cp_units_none)
585 : CASE default
586 789559 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
587 : END SELECT
588 : CASE (cp_ukind_pressure)
589 652391 : 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 173075 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
593 : END SELECT
594 : CASE (cp_ukind_angle)
595 2570513 : SELECT CASE (basic_unit)
596 : CASE (cp_units_rad, cp_units_deg, cp_units_none)
597 : CASE default
598 479316 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
599 : END SELECT
600 : CASE (cp_ukind_time)
601 2137559 : 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 2091197 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
605 : END SELECT
606 : CASE (cp_ukind_mass)
607 164829 : 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 46362 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
611 : END SELECT
612 : CASE (cp_ukind_potential)
613 144600 : SELECT CASE (basic_unit)
614 : CASE (cp_units_volt, cp_units_au, cp_units_none)
615 : CASE default
616 118467 : CPABORT("unknown potential unit:"//TRIM(cp_to_string(basic_unit)))
617 : END SELECT
618 : CASE (cp_ukind_force)
619 117318060 : SELECT CASE (basic_unit)
620 : CASE (cp_units_Newton, cp_units_mNewton, cp_units_au, cp_units_none)
621 : CASE default
622 26133 : CPABORT("unknown force unit:"//TRIM(cp_to_string(basic_unit)))
623 : END SELECT
624 : CASE (cp_ukind_none)
625 117291927 : 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 135025352 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
631 : END SELECT
632 135025352 : 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 6945711 : 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 6945711 : my_power = 1
652 6945711 : IF (PRESENT(power)) my_power = power
653 6945711 : 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 7008886 : SELECT CASE (basic_kind)
660 : CASE (cp_ukind_undef)
661 1243190 : SELECT CASE (basic_unit)
662 : CASE (cp_units_none)
663 63175 : res = value
664 : CASE default
665 63175 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
666 : END SELECT
667 : CASE (cp_ukind_energy)
668 4262783 : SELECT CASE (basic_unit)
669 : CASE (cp_units_hartree, cp_units_au)
670 119451 : 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 228645 : 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 24322 : res = 0.5_dp**my_power*value
683 : CASE (cp_units_eV)
684 781880 : 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 23461 : res = kelvin**(-my_power)*value
689 : CASE default
690 1180015 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
691 : END SELECT
692 : CASE (cp_ukind_length)
693 706440 : SELECT CASE (basic_unit)
694 : CASE (cp_units_bohr, cp_units_au)
695 417359 : 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 10062 : res = value*(10.0_dp*bohr)**my_power
702 : CASE (cp_units_angstrom)
703 3715855 : res = value*bohr**my_power
704 : CASE default
705 4143332 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
706 : END SELECT
707 : CASE (cp_ukind_temperature)
708 366434 : SELECT CASE (basic_unit)
709 : CASE (cp_units_k)
710 289077 : res = kelvin**(-my_power)*value
711 : CASE (cp_units_au)
712 4 : res = value
713 : CASE default
714 289081 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
715 : END SELECT
716 : CASE (cp_ukind_pressure)
717 359275 : SELECT CASE (basic_unit)
718 : CASE (cp_units_bar)
719 68945 : res = bar**(-my_power)*value
720 : CASE (cp_units_atm)
721 0 : res = atm**(-my_power)*value
722 : CASE (cp_units_kbar)
723 12 : res = (1.0E-3_dp*bar)**(-my_power)*value
724 : CASE (cp_units_Pa)
725 8392 : 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 8 : res = (1.0E-9_dp*pascal)**(-my_power)*value
730 : CASE (cp_units_au)
731 0 : res = value
732 : CASE default
733 77357 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
734 : END SELECT
735 : CASE (cp_ukind_angle)
736 972221 : SELECT CASE (basic_unit)
737 : CASE (cp_units_rad)
738 70096 : res = value
739 : CASE (cp_units_deg)
740 220234 : res = value*(radians)**my_power
741 : CASE default
742 290330 : 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 524719 : res = value*femtoseconds**(-my_power)
750 : CASE (cp_units_ps)
751 326583 : res = value*picoseconds**(-my_power)
752 : CASE (cp_units_au)
753 50765 : res = value
754 : CASE (cp_units_wn)
755 34 : res = (twopi*wavenumbers)**(my_power)/value
756 : CASE default
757 902125 : 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 6945711 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
796 : END SELECT
797 6945711 : 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 17640555 : 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 17640555 : my_power = 1
819 17640555 : res = ""
820 17640555 : my_accept_undefined = .FALSE.
821 17640555 : IF (accept_undefined) my_accept_undefined = accept_undefined
822 17640555 : IF (PRESENT(power)) my_power = power
823 17640555 : IF (basic_unit == cp_units_none) THEN
824 836487 : 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 18477042 : SELECT CASE (basic_kind)
829 : CASE (cp_ukind_undef)
830 4318195 : SELECT CASE (basic_unit)
831 : CASE (cp_units_none)
832 836487 : res = "internal_cp2k"
833 : CASE DEFAULT
834 : CALL cp_abort(__LOCATION__, &
835 : "unit not yet fully specified, unit of kind "// &
836 836487 : TRIM(res))
837 : END SELECT
838 : CASE (cp_ukind_energy)
839 10565017 : SELECT CASE (basic_unit)
840 : CASE (cp_units_hartree, cp_units_au)
841 901757 : 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 354471 : 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 126016 : res = "Ry"
854 : CASE (cp_units_eV)
855 1780648 : res = "eV"
856 : CASE (cp_units_keV)
857 28539 : res = "keV"
858 : CASE (cp_units_k)
859 288029 : 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 3481708 : CPABORT("unknown energy unit:"//TRIM(cp_to_string(basic_unit)))
868 : END SELECT
869 : CASE (cp_ukind_length)
870 2840870 : SELECT CASE (basic_unit)
871 : CASE (cp_units_bohr, cp_units_au)
872 2060598 : res = "bohr"
873 : CASE (cp_units_m)
874 45394 : res = "m"
875 : CASE (cp_units_pm)
876 2 : res = "pm"
877 : CASE (cp_units_nm)
878 18448 : res = "nm"
879 : CASE (cp_units_angstrom)
880 7538818 : res = "angstrom"
881 : CASE default
882 0 : res = "length"
883 9663260 : CPABORT("unknown length unit:"//TRIM(cp_to_string(basic_unit)))
884 : END SELECT
885 : CASE (cp_ukind_temperature)
886 944056 : SELECT CASE (basic_unit)
887 : CASE (cp_units_k)
888 780268 : 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 780272 : CPABORT("unknown temperature unit:"//TRIM(cp_to_string(basic_unit)))
899 : END SELECT
900 : CASE (cp_ukind_pressure)
901 608606 : SELECT CASE (basic_unit)
902 : CASE (cp_units_bar)
903 138577 : res = "bar"
904 : CASE (cp_units_atm)
905 0 : res = "atm"
906 : CASE (cp_units_kbar)
907 12 : res = "kbar"
908 : CASE (cp_units_Pa)
909 16784 : res = "Pa"
910 : CASE (cp_units_MPa)
911 0 : res = "MPa"
912 : CASE (cp_units_GPa)
913 8415 : 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 163788 : CPABORT("unknown pressure unit:"//TRIM(cp_to_string(basic_unit)))
924 : END SELECT
925 : CASE (cp_ukind_angle)
926 2295737 : SELECT CASE (basic_unit)
927 : CASE (cp_units_rad)
928 213827 : res = "rad"
929 : CASE (cp_units_deg)
930 256202 : 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 470029 : CPABORT("unknown angle unit:"//TRIM(cp_to_string(basic_unit)))
939 : END SELECT
940 : CASE (cp_ukind_time)
941 166381 : SELECT CASE (basic_unit)
942 : CASE (cp_units_s)
943 129306 : res = "s"
944 : CASE (cp_units_fs)
945 1424337 : res = "fs"
946 : CASE (cp_units_ps)
947 420576 : res = "ps"
948 : CASE (cp_units_au)
949 107657 : 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 2081910 : CPABORT("unknown time unit:"//TRIM(cp_to_string(basic_unit)))
960 : END SELECT
961 : CASE (cp_ukind_mass)
962 109180 : SELECT CASE (basic_unit)
963 : CASE (cp_units_kg)
964 0 : res = "kg"
965 : CASE (cp_units_amu)
966 8540 : res = "amu"
967 : CASE (cp_units_m_e, cp_units_au)
968 28535 : 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 37075 : CPABORT("unknown mass unit:"//TRIM(cp_to_string(basic_unit)))
977 : END SELECT
978 : CASE (cp_ukind_potential)
979 126026 : SELECT CASE (basic_unit)
980 : CASE (cp_units_volt)
981 109180 : 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 109180 : 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 16836 : 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 16846 : 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 17640555 : CPABORT("unknown kind of unit:"//TRIM(cp_to_string(basic_kind)))
1016 : END SELECT
1017 17640555 : IF (my_power /= 1) THEN
1018 2045404 : a = LEN_TRIM(res)
1019 2045404 : CPASSERT(LEN(res) - a >= 3)
1020 2045404 : WRITE (res(a + 1:), "('^',i3)") my_power
1021 2045404 : CALL compress(res, .TRUE.)
1022 : END IF
1023 17640555 : 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 16785299 : 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 16785299 : res = ""
1045 16785299 : pos = 1
1046 16785299 : my_accept_undefined = .FALSE.
1047 16785299 : IF (PRESENT(accept_undefined)) my_accept_undefined = accept_undefined
1048 34425854 : DO i = 1, unit%n_kinds
1049 17640555 : CPASSERT(unit%kind_id(i) /= 0)
1050 17640555 : CPASSERT(pos < LEN(res))
1051 17640555 : my_unit = unit%unit_id(i)
1052 17640555 : has_defaults = .FALSE.
1053 17640555 : IF (PRESENT(defaults)) has_defaults = ASSOCIATED(defaults%units(1)%unit)
1054 17640555 : 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 17640555 : IF (i > 1) THEN
1063 905608 : res(pos:pos) = "*"
1064 905608 : 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 17640555 : power=unit%power(i)))
1069 34425854 : pos = LEN_TRIM(res) + 1
1070 : END DO
1071 :
1072 16785299 : 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 6394276 : 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 6394276 : my_power = 1
1094 6394276 : IF (PRESENT(power)) my_power = power
1095 6394276 : res = value
1096 13339987 : DO i_unit = 1, unit%n_kinds
1097 6945711 : CPASSERT(unit%kind_id(i_unit) > 0)
1098 6945711 : my_basic_unit = unit%unit_id(i_unit)
1099 6945711 : 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 13339987 : power=my_power*unit%power(i_unit))
1107 : END DO
1108 6394276 : 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 682143 : 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 682143 : my_power = 1
1130 682143 : IF (PRESENT(power)) my_power = power
1131 682143 : IF (PRESENT(defaults)) THEN
1132 : res = cp_unit_to_cp2k1(value=value, unit=unit, defaults=defaults, &
1133 0 : power=-my_power)
1134 : ELSE
1135 682143 : res = cp_unit_to_cp2k1(value=value, unit=unit, power=-my_power)
1136 : END IF
1137 682143 : 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 5609452 : 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 5609452 : CALL cp_unit_create(my_unit, unit_str)
1159 5609452 : IF (PRESENT(defaults)) THEN
1160 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1161 0 : power=power)
1162 : ELSE
1163 5609452 : res = cp_unit_to_cp2k1(value=value, unit=my_unit, power=power)
1164 : END IF
1165 5609452 : CALL cp_unit_release(my_unit)
1166 151455204 : 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 478407 : 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 478407 : CALL cp_unit_create(my_unit, unit_str)
1188 478407 : IF (PRESENT(defaults)) THEN
1189 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, defaults=defaults, &
1190 0 : power=power)
1191 : ELSE
1192 478407 : res = cp_unit_from_cp2k1(value=value, unit=my_unit, power=power)
1193 : END IF
1194 478407 : CALL cp_unit_release(my_unit)
1195 12916989 : 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 102681 : 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 102681 : res = .TRUE.
1211 924129 : DO i = 1, SIZE(ref_unit%kind_id)
1212 821448 : 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 924129 : EXIT
1216 : END DO
1217 :
1218 102681 : 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 102157 : 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 9287 : my_name = name
1235 9287 : CALL uppercase(my_name)
1236 :
1237 102157 : DO i = 1, cp_ukind_max
1238 92870 : NULLIFY (unit_set%units(i)%unit)
1239 2331037 : ALLOCATE (unit_set%units(i)%unit)
1240 : END DO
1241 102157 : DO i = 1, cp_ukind_max
1242 9287 : 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 9287 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : 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 18574 : power=(/1/))
1283 : CASE default
1284 0 : CPABORT("unhandled unit type "//TRIM(cp_to_string(i)))
1285 92870 : EXIT
1286 : END SELECT
1287 : CASE default
1288 92870 : CPABORT('unknown parameter set name '//TRIM(name))
1289 : END SELECT
1290 : END DO
1291 9287 : 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 9287 : SUBROUTINE cp_unit_set_release(unit_set)
1299 : TYPE(cp_unit_set_type), INTENT(INOUT) :: unit_set
1300 :
1301 : INTEGER :: i
1302 :
1303 102157 : DO i = 1, SIZE(unit_set%units)
1304 92870 : CALL cp_unit_release(unit_set%units(i)%unit)
1305 102157 : DEALLOCATE (unit_set%units(i)%unit)
1306 : END DO
1307 :
1308 9287 : END SUBROUTINE cp_unit_set_release
1309 :
1310 : ! **************************************************************************************************
1311 : !> \brief Prints info on all available units in CP2K
1312 : !> \param unit_nr ...
1313 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
1314 : ! **************************************************************************************************
1315 0 : SUBROUTINE print_all_units(unit_nr)
1316 : INTEGER, INTENT(IN) :: unit_nr
1317 :
1318 : CALL print_section_unit(unit_label="Undefined", description="If the default unit "// &
1319 : "of a keyword is explicitly undefined, all possible units of measurement can "// &
1320 : "be used to define a proper value.", &
1321 0 : units_set=s2a("internal_cp2k"), unit_nr=unit_nr)
1322 :
1323 : CALL print_section_unit(unit_label="Energy", description="Possible units of measurement "// &
1324 : "for Energies. The [energy] entry acts like a dummy flag (assumes the unit of "// &
1325 : "measurement of energy is in internal units), useful for dimensional analysis.", &
1326 : units_set=s2a("hartree", "wavenumber_e", "joule", "kcalmol", "kjmol", "Ry", &
1327 0 : "eV", "keV", "K_e", "energy"), unit_nr=unit_nr)
1328 :
1329 : CALL print_section_unit(unit_label="Length", description="Possible units of measurement "// &
1330 : "for Lengths. The [length] entry acts like a dummy flag (assumes the unit of "// &
1331 : "measurement of length is in internal units), useful for dimensional analysis.", &
1332 0 : units_set=s2a("bohr", "m", "pm", "nm", "angstrom", "length"), unit_nr=unit_nr)
1333 :
1334 : CALL print_section_unit(unit_label="Temperature", description="Possible units of measurement "// &
1335 : "for Temperature. The [temperature] entry acts like a dummy flag (assumes the unit of "// &
1336 : "measurement of temperature is in internal units), useful for dimensional analysis.", &
1337 0 : units_set=s2a("K", "au_temp", "temperature"), unit_nr=unit_nr)
1338 :
1339 : CALL print_section_unit(unit_label="Pressure", description="Possible units of measurement "// &
1340 : "for Pressure. The [pressure] entry acts like a dummy flag (assumes the unit of "// &
1341 : "measurement of pressure is in internal units), useful for dimensional analysis.", &
1342 : units_set=s2a("bar", "atm", "kbar", "Pa", "MPa", "GPa", "au_p", "pressure"), &
1343 0 : unit_nr=unit_nr)
1344 :
1345 : CALL print_section_unit(unit_label="Angle", description="Possible units of measurement "// &
1346 : "for Angles. The [angle] entry acts like a dummy flag (assumes the unit of "// &
1347 : "measurement of angle is in internal units), useful for dimensional analysis.", &
1348 0 : units_set=s2a("rad", "deg", "angle"), unit_nr=unit_nr)
1349 :
1350 : CALL print_section_unit(unit_label="Time", description="Possible units of measurement "// &
1351 : "for Time. The [time] entry acts like a dummy flag (assumes the unit of "// &
1352 : "measurement of time is in internal units), useful for dimensional analysis.", &
1353 0 : units_set=s2a("s", "fs", "ps", "au_t", "wavenumber_t", "time"), unit_nr=unit_nr)
1354 :
1355 : CALL print_section_unit(unit_label="Mass", description="Possible units of measurement "// &
1356 : "for Masses. The [mass] entry acts like a dummy flag (assumes the unit of "// &
1357 : "measurement of mass is in internal units), useful for dimensional analysis.", &
1358 0 : units_set=s2a("kg", "amu", "m_e", "mass"), unit_nr=unit_nr)
1359 :
1360 : CALL print_section_unit(unit_label="Potential", description="Possible units of measurement "// &
1361 : "for potentials. The [potential] entry acts like a dummy flag (assumes the unit of "// &
1362 : "measurement of potential is in internal units), useful for dimensional analysis.", &
1363 0 : units_set=s2a("volt", "au_pot", "potential"), unit_nr=unit_nr)
1364 :
1365 : CALL print_section_unit(unit_label="Force", description="Possible units of measurement "// &
1366 : "for forces. The [force] entry acts like a dummy flag (assumes the unit of "// &
1367 : "measurement of force is in internal units), useful for dimensional analysis.", &
1368 0 : units_set=s2a("N", "Newton", "mN", "mNewton", "au_f", "force"), unit_nr=unit_nr)
1369 :
1370 0 : END SUBROUTINE print_all_units
1371 :
1372 : ! **************************************************************************************************
1373 : !> \brief Prints info on all available units in CP2K - Low level
1374 : !> \param unit_label ...
1375 : !> \param description ...
1376 : !> \param units_set ...
1377 : !> \param unit_nr ...
1378 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
1379 : ! **************************************************************************************************
1380 0 : SUBROUTINE print_section_unit(unit_label, description, units_set, unit_nr)
1381 : CHARACTER(LEN=*), INTENT(IN) :: unit_label, description
1382 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: units_set
1383 : INTEGER, INTENT(IN) :: unit_nr
1384 :
1385 : INTEGER :: i
1386 :
1387 0 : WRITE (unit_nr, FMT='(A)') "<H2>"//TRIM(unit_label)//"</H2>"
1388 0 : WRITE (unit_nr, FMT='(A)') description//"<BR><DL>"
1389 0 : DO i = 1, SIZE(units_set)
1390 0 : WRITE (unit_nr, FMT='(A)') "<DD><B>"//TRIM(units_set(i))//"</B></DD>"
1391 : END DO
1392 0 : WRITE (unit_nr, FMT='(A)') "</DL><P>"
1393 0 : END SUBROUTINE print_section_unit
1394 :
1395 0 : END MODULE cp_units
|
