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
98
99
100
101
102
103
104
105
106
107
108
|
c PCUBE -- Extract a subraster (image cube) from an image and print
c the values on the standard output. This is used with a standard
c test image to verify that the IMFORT interface is working correctly.
c
c usage: pcube image i1 i2 [j1 j2 [k1 k2]]
c ---------------------------------------------------------------------
program pcube
character*80 image, errmsg
integer i1, i2, j1, j2, k1, k2
integer im, ier, axlen(7), naxis, dtype, nargs
real pix(8192)
c --- Get image name.
call clargc (1, image, ier)
if (ier .ne. 0) then
write (*, '('' enter image name: '',$)')
read (*,*) image
endif
c --- Open the image.
call imopen (image, 1, im, ier)
if (ier .ne. 0) goto 91
call imgsiz (im, axlen, naxis, dtype, ier)
if (ier .ne. 0) goto 91
c --- Get subraster coordinates.
call clnarg (nargs)
if (nargs .lt. 3) then
write (*, '('' enter subraster coordinates (i1 i2 j1 j2): '',$)')
read (*,*) i1, i2, j1, j2
k1 = 1
k2 = 1
else
call clargi (2, i1, ier)
if (ier .ne. 0) goto 91
call clargi (3, i2, ier)
if (ier .ne. 0) goto 91
if (nargs .ge. 5) then
call clargi (4, j1, ier)
if (ier .ne. 0) goto 91
call clargi (5, j2, ier)
if (ier .ne. 0) goto 91
else
j1 = 1
j2 = 1
endif
if (nargs .ge. 7) then
call clargi (6, k1, ier)
if (ier .ne. 0) goto 91
call clargi (7, k2, ier)
if (ier .ne. 0) goto 91
else
k1 = 1
k2 = 1
endif
endif
c --- Extract the subraster.
call imgs3r (im, pix, i1, i2, j1, j2, k1, k2, ier)
if (ier .ne. 0) goto 91
c --- Print the pixel values.
call pcuber (pix, i2-i1+1, j2-j1+1, k2-k1+1, i1,i2, j1,j2, k1,k2)
c --- Close the input image and quit.
call imclos (im, ier)
if (ier .ne. 0) goto 91
stop
c --- Error handler.
91 call imemsg (ier, errmsg)
write (*, '('' Error: '', a80)') errmsg
stop
end
c PCUBER -- Print pixel values, 3d subraster, type real.
c ----------------------------------------------------------------
subroutine pcuber (pix, nx,ny,nz, i1,i2, j1,j2, k1,k2)
integer nx, ny, nz
real pix(nx,ny,nz)
integer i1, i2, j1, j2, k1, k2
integer i, j, k
nx = i2 - i1 + 1
ny = j2 - j1 + 1
nz = k2 - k1 + 1
do 20 k = k1, k2
write (*, '('' band '', i3)') k
print 81, i1, i2, j1, j2
do 10 j = 1, ny
print 82, j-1+j1, (pix(i,j,k), i = 1, nx)
10 continue
20 continue
81 format (' subraster at ', 4 i4)
82 format (' line ', i4, 8 (1x, f7.0))
end
|
