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
|
subroutine process(x)
real x(..)
select rank(x)
rank (0)
x = 0
rank (2)
if (size(x,2)>=2) x(:,2) = 2
rank default
print *, 'i did not expect rank', rank(x), 'shape', shape(x)
error stop 'process bad arg'
end select
return
end subroutine process
subroutine initialize (arg, size)
real,contiguous :: arg(..)
integer :: size, i
select rank (arg)
rank (0) ! special case the scalar case
arg = 0.0
rank (*)
do i = 1, size
arg(i) = 0.0
end do
end select
return
end subroutine
|
