-
Notifications
You must be signed in to change notification settings - Fork 0
/
Get_Addr_m.f90
47 lines (35 loc) · 1.07 KB
/
Get_Addr_m.f90
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
module Get_Addr_M
implicit NONE
contains
subroutine Get_Addr ( A, N, X )
! Convert the address in A to numeric form in N, with an index
! register number in X. N < 0 signifies an invalid address.
character(3), intent(in) :: A
integer, intent(out) :: N
integer, intent(out), optional :: X
character(40) :: ADDR = "0123456789'/STUVWXYZ!JKLMNOPQR?ABCDEFGHI"
character(40) :: ADR2 = "0123456789|/STUVWXYZ!JKLMNOPQR?ABCDEFGHI"
integer :: I, J
integer :: d(3), Z(3)
if ( a(1:1) == '%' ) then
n = index(addr,a(3:3)) - 1
if ( present(x) ) x = 0
return
end if
! Separate the digit and zone parts of each character of A
do i = 1, 3
j = index(addr,a(i:i)) - 1
if ( j < 0 ) then
j = index(adr2,a(i:i)) - 1
if ( j < 0 ) then
n = -1
return
end if
end if
z(i) = j / 10
d(i) = mod(j,10)
end do
n = ( d(1) * 10 + d(2) ) * 10 + d(3) + 1000 * ( 4 * z(3) + z(1) )
if ( present(x) ) x = z(2)
end subroutine Get_Addr
end module Get_Addr_M