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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
PROGRAM PLOTTER
* Usage:
* PLOTTER <fits file> <attr1> <attr2> <ps file> [<xlo> <ylo> <xhi> <yhi>]
* Description:
* Plots a standard grid from the specified fits header file, using
* the specified attributes, and sends postscript output to the
* specified ps file.
* Parameters:
* file file
* A text file containing fits headers.
* attr1
* A string containg a comma-separated list of attribute
* settings for the Plot.
* attr2
* A string containg a comma-separated list of attribute
* settings for the FitsChan.
* ps file
* The output postscript file
* xlo ylo xhi yhi
* The bounds within the GRID Frame of the required plot.
* Taken from the FITS headers if not supplied
IMPLICIT NONE
INCLUDE 'AST_PAR'
INTEGER STATUS, FC, FS, NAXIS1, NAXIS2, PL, PGBEG, IARGC, OC
CHARACTER FILE*80, CARD*80, DEVN*80, PSFILE*80, ATTR*255, TEXT*80
REAL GBOX(4), RANGE, DELTA, ASP
DOUBLE PRECISION PBOX(4)
STATUS = 0
*
* Check command line arguments have been supplied.
*
IF( IARGC() .LT. 3 ) THEN
WRITE(*,*) 'Usage: plotter <file file> <attrs> <fattrs> '//
: '<ps file> [<xlo> <ylo> <xhi> <yhi>]'
RETURN
END IF
*
* Use object caching to minimise allocation of new memory
*
OC = AST_TUNE( 'ObjectCaching', 1, STATUS )
IF( OC .NE. 0 ) THEN
WRITE(*,'(A,I6)') 'Default ObjectCaching VALUE is ',OC
END IF
IF( AST_TUNE( 'ObjectCaching', AST__TUNULL, STATUS ) .NE. 1 ) THEN
WRITE(*,'(A,I6)') 'Set ObjectCaching VALUE is ',OC
END IF
*
* Create a FitsChan to store the FITS headers.
*
CALL GETARG( 3, ATTR )
FC = AST_FITSCHAN( AST_NULL, AST_NULL, ATTR, STATUS )
*
* Open a text file containing a list of FITS headers.
*
CALL GETARG( 1, FILE )
OPEN( UNIT=10, FILE=FILE, STATUS='OLD' )
*
* Read each card out of the text file and store it in the FitsChan.
*
DO WHILE( .TRUE. )
READ( 10, '(A)', END = 10 ) CARD
CALL AST_PUTFITS( FC, CARD, 0, STATUS )
END DO
10 CLOSE( 10 )
*
* If the base frame box was supplied on the command line, use it.
*
IF( IARGC() .GT. 6 ) THEN
CALL GETARG( 5, TEXT )
READ( TEXT, * ) PBOX( 1 )
CALL GETARG( 6, TEXT )
READ( TEXT, * ) PBOX( 2 )
CALL GETARG( 7, TEXT )
READ( TEXT, * ) PBOX( 3 )
CALL GETARG( 8, TEXT )
READ( TEXT, * ) PBOX( 4 )
* Otherwise use NAXISi keywords in the header.
ELSE
*
* See if values were supplied for NAXIS1 and NAXIS2. If not assume a value
* of 100 for each. The FitsChan is re-wound before calling AST_FINDFITS so
* that the search starts form the beginning.
*
CALL AST_CLEAR( FC, 'CARD', STATUS )
IF ( AST_FINDFITS( FC, 'NAXIS1', CARD, .TRUE., STATUS ) ) THEN
READ(CARD(11:),*) NAXIS1
ELSE
NAXIS1 = 100
END IF
CALL AST_CLEAR( FC, 'CARD', STATUS )
IF ( AST_FINDFITS( FC, 'NAXIS2', CARD, .TRUE., STATUS ) ) THEN
READ(CARD(11:),*) NAXIS2
ELSE
NAXIS2 = 100
END IF
PBOX(1) = 0.5
PBOX(2) = 0.5
PBOX(3) = DBLE( NAXIS1 )+0.5
PBOX(4) = DBLE( NAXIS2 )+0.5
END IF
*
* Read an Object from the contents of the FitsChan. This should be a
* FrameSet (this should be tested really, and an error reported if any
* other type of Object is obtained). Re-wind the FitsChan first so that
* its entire contents are read. Note, this is a destructive read, in that
* the cards which are significant to the creation of the FrameSet are
* removed from the FitsChan (this is why NAXIS1 and NAXIS2 are read out
* earlier - just in case they are significant to the FrameSet). Any
* insignificant cards are left as they are.
*
CALL AST_CLEAR( FC, 'CARD', STATUS )
FS = AST_READ( FC, STATUS )
IF( FS .EQ. AST__NULL ) THEN
WRITE(*,*) '!!! No object read from FitsChan!!!'
GO TO 999
END IF
*
* If all is OK, start up PGPLOT.
*
IF( STATUS .EQ. 0 ) THEN
CALL GETARG( 4, PSFILE )
CALL DELETEFILE( PSFILE )
DEVN = 'pscol_l;'//PSFILE
c IF( PGBEG( 0, '?', 1, 1 ) .EQ. 1 ) THEN
IF( PGBEG( 0, DEVN, 1, 1 ) .EQ. 1 ) THEN
CALL PGPAGE
CALL PGWNAD( 0.0, 1.0, 0.0, 1.0 )
*
* Create the Plot. The pixel coordinates box is
* mapped onto a window which is 10% smaller than the full PGPLOT window.
* This gives some space for things like tick marks with negative length
* (which stick outside the pixel cooridnates box).
*
CALL PGQWIN( GBOX(1), GBOX(3), GBOX(2), GBOX(4) )
RANGE = GBOX(3) - GBOX(1)
GBOX(1) = GBOX(1) + 0.05*RANGE
GBOX(3) = GBOX(3) - 0.05*RANGE
RANGE = GBOX(4) - GBOX(2)
GBOX(2) = GBOX(2) + 0.05*RANGE
GBOX(4) = GBOX(4) - 0.05*RANGE
ASP = REAL( PBOX(4) - PBOX(2) )/REAL( PBOX(3) - PBOX(1) )
IF( ASP .LT. 0.05 .OR. ASP .GT. 20 ) ASP = 1.0
IF( ASP .GT. 1.0 ) THEN
DELTA = 0.5*( ( GBOX(3) - GBOX(1) ) -
: ( GBOX(4) - GBOX(2) )/ASP )
GBOX(3) = GBOX(3) - DELTA
GBOX(1) = GBOX(1) + DELTA
ELSE
DELTA = 0.5*( ( GBOX(4) - GBOX(2) ) -
: ASP*( GBOX(3) - GBOX(1) ) )
GBOX(4) = GBOX(4) - DELTA
GBOX(2) = GBOX(2) + DELTA
END IF
CALL GETARG( 2, ATTR )
PL = AST_PLOT( FS, GBOX, PBOX, 'title = A FITS test',
: STATUS )
CALL AST_SET( PL, ATTR, STATUS )
*
* Draw the grid.
*
CALL AST_GRID( PL, STATUS )
*
* Annul the Plot, and close PGPLOT.
*
CALL AST_ANNUL( PL, STATUS )
CALL PGEND
END IF
END IF
*
* Annul the other objects.
*
CALL AST_ANNUL( FS, STATUS )
999 CALL AST_ANNUL( FC, STATUS )
END
*
* Delete a file if it exists.
*
SUBROUTINE DELETEFILE( FILNAM )
IMPLICIT NONE
CHARACTER FILNAM*(*)
LOGICAL EXISTS
INQUIRE ( FILE = FILNAM,
: EXIST = EXISTS )
IF( EXISTS ) THEN
OPEN ( UNIT=10, FILE=FILNAM, STATUS='OLD' )
CLOSE ( 10, STATUS='DELETE' )
END IF
END
|
