1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
module units_ambiguous_m
use fdf_prec, only: dp
implicit none
public :: inquire_unit
private
integer, parameter :: nu = 16
integer :: iu
character(8) :: dimm(nu)
character(10) :: name(nu)
real(dp) :: unit(nu)
data (dimm(iu), name(iu), unit(iu), iu=1, 3) / &
'mass ', 'g ', 1.d-3, &
'mass ', 'kg ', 1.d0, &
'mass ', 'amu ', 1.66054d-27 /
data (dimm(iu), name(iu), unit(iu), iu=4, 13) / &
'energy ', 'j ', 1.d0, &
'energy ', 'kj ', 1.d3, &
'energy ', 'erg ', 1.d-7, &
'energy ', 'mev ', 1.60219d-22, &
'energy ', 'ev ', 1.60219d-19, &
'energy ', 'mry ', 2.17991d-21, &
'energy ', 'ry ', 2.17991d-18, &
'energy ', 'mha ', 4.35982d-21, &
'energy ', 'mhartree ', 4.35982d-21, &
'energy ', 'ha ', 4.35982d-18 /
data (dimm(iu), name(iu), unit(iu), iu=14, 16) / &
'bfield ', 'Tesla ', 1.0d0, &
'bfield ', 'G ', 1.0d-4, &
'energy ', 'MeV ', 1.60219d-13/
CONTAINS
subroutine inquire_unit(unit_str, stat, phys_dim, unit_name, unit_value)
use fdf_utils, only: leqi
use fdf_prec, only: dp
character(len=*), intent(in) :: unit_str
character(len=*), intent(out) :: phys_dim
character(len=*), intent(out) :: unit_name
real(dp), intent(out) :: unit_value
integer, intent(out) :: stat
integer :: idx_colon, iu, idx
logical :: phys_dim_specified, match
idx_colon = index(unit_str,":")
if (idx_colon /= 0) then
! spec includes dimension prefix
phys_dim = unit_str(1:idx_colon-1)
unit_name = unit_str(idx_colon+1:)
phys_dim_specified = .true.
else
phys_dim = ""
unit_name = unit_str
phys_dim_specified = .false.
endif
stat = 0
idx = 0
do iu= 1, nu
match = .false.
if (leqi(name(iu), unit_name)) then
if (phys_dim_specified) then
if (leqi(dimm(iu), phys_dim)) then
match = .true.
endif
else
match = .true.
endif
endif
if (match) then
if (idx /= 0) then ! ambiguous
stat = 1
RETURN
endif
idx = iu
endif
enddo
if (idx == 0) then
stat = -1 ! not found
else
phys_dim = trim(dimm(idx))
unit_value = unit(idx)
endif
end subroutine inquire_unit
end module units_ambiguous_m
|
