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
|
*=======================================================================
*
* PGSBOX 4.8 - draw curvilinear coordinate axes for PGPLOT.
* Copyright (C) 1997-2011, Mark Calabretta
*
* This file is part of PGSBOX.
*
* PGSBOX is free software: you can redistribute it and/or modify it
* under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* PGSBOX is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
* License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with PGSBOX. If not, see http://www.gnu.org/licenses.
*
* Correspondence concerning PGSBOX may be directed to:
* Internet email: mcalabre@atnf.csiro.au
* Postal address: Dr. Mark Calabretta
* Australia Telescope National Facility, CSIRO
* PO Box 76
* Epping NSW 1710
* AUSTRALIA
*
* Author: Mark Calabretta, Australia Telescope National Facility
* http://www.atnf.csiro.au/~mcalabre/index.html
* $Id: pgcrfn.f,v 4.8.1.1 2011/08/15 08:07:07 cal103 Exp cal103 $
*=======================================================================
*
* PGCRFN defines separable pairs of non-linear coordinate systems for
* PGSBOX.
*
* Given:
* OPCODE I Transformation code:
* +2: Compute a set of pixel coordinates that
* describe a path between this and the
* previous pair of world coordinates
* remembered from the last call with
* OPCODE = +1 or +2.
* +1: Compute pixel coordinates from world
* coordinates.
* 0: Initialize.
* -1: Compute world coordinates from pixel
* coordinates.
*
* NLC I Number of elements in FCODE (=8).
*
* NLI I Number of elements in NLIPRM (=2).
*
* NLD I Number of elements in NLDPRM.
*
* FCODE C(NLC)*1 Character array (contains the CTYPE array,
* see below).
*
* Given and/or returned:
* NLIPRM I(NLI) Integer coefficients (see below).
*
* NLDPRM D(2,NLD) Double precision coefficients (see below).
*
* WORLD D(2) World coordinates.
* Given if OPCODE > 0, returned if OPCODE < 0.
*
* PIXEL D(2) Pixel coordinates.
* Given if OPCODE < 0, returned if OPCODE > 0.
*
* CONTRL I Control flag for OPCODE = +2 (ignored, always
* set to 0 on return).
*
* CONTXT D(20) Context elements (ignored).
*
* Returned:
* IERR I Status return value:
* 0: Success.
* 1: Invalid parameters.
* 2: Invalid world coordinate.
* 3: Invalid pixel coordinate.
*
* Notes:
* PGCRFN assumes a simple 2-D image. The FCODE array contains
* two four-character mnemonics that select function types:
*
* "Lin " Linear
* "Log " Logarithmic
* "Pow " Power law
*
* The first two elements of NLIPRM are set on initialization to
* offsets used by computed GO TOs for each function type.
*
* Note that PGCRFN treats NLDPRM as an array of dimension two.
* The NLDPRM are used as follows:
*
* Type WORLD(J) =
* Lin NLDPRM(J,3) + S
* Log NLDPRM(J,3) * LOG10(S)
* Pow (NLDPRM(J,3) + S)**NLDPRM(J,4)
*
* Where in each case S = NLDPRM(J,2)*(PIXEL(J) - NLDPRM(J,1))
*
*=======================================================================
SUBROUTINE PGCRFN (OPCODE, NLC, NLI, NLD, FCODE, NLIPRM, NLDPRM,
: WORLD, PIXEL, CONTRL, CONTXT, IERR)
*-----------------------------------------------------------------------
INTEGER CONTRL, IERR, J, NLC, NLD, NLI, OPCODE, NLIPRM(NLI)
DOUBLE PRECISION CONTXT(20), NLDPRM(2,NLD), PIXEL(2), S, WORLD(2)
CHARACTER FCODE(2)*4, FCODES*20
DATA FCODES(1:20) /'Lin Log Pow '/
*-----------------------------------------------------------------------
IERR = 0
IF (OPCODE.GT.0) THEN
* Compute pixel coordinates from world coordinates.
DO 200 J = 1, 2
GO TO (110, 120, 130) NLIPRM(J)
IERR = 1
RETURN
* Linear.
110 S = WORLD(J) - NLDPRM(J,3)
GO TO 190
* Logarithmic to base 10.
120 S = 10D0**(WORLD(J)/NLDPRM(J,3))
GO TO 190
* Power.
130 S = WORLD(J)**(1D0/NLDPRM(J,4)) - NLDPRM(J,3)
190 PIXEL(J) = NLDPRM(J,1) + S/NLDPRM(J,2)
200 CONTINUE
CONTRL = 0
ELSE IF (OPCODE.EQ.0) THEN
* Initialize.
IF (NLC.LT.8 .OR. NLI.LT.2 .OR. NLD.LT.3) THEN
IERR = 1
RETURN
END IF
* Compute pointers.
NLIPRM(1) = (INDEX(FCODES,FCODE(1)) + 3)/4
NLIPRM(2) = (INDEX(FCODES,FCODE(2)) + 3)/4
IF (NLIPRM(1).EQ.0 .OR. NLIPRM(2).EQ.0) THEN
IERR = 1
RETURN
END IF
CONTRL = 0
ELSE IF (OPCODE.EQ.-1) THEN
* Compute world coordinates from pixel coordinates.
DO 300 J = 1, 2
S = NLDPRM(J,2)*(PIXEL(J) - NLDPRM(J,1))
GO TO (210, 220, 230) NLIPRM(J)
IERR = 1
RETURN
* Linear.
210 WORLD(J) = NLDPRM(J,3) + S
GO TO 300
* Logarithmic to base 10.
220 IF (S.LE.0D0) THEN
IERR = 1
RETURN
END IF
WORLD(J) = NLDPRM(J,3)*LOG10(S)
GO TO 300
* Power.
230 S = S + NLDPRM(J,3)
IF (S.LE.0D0 .AND. MOD(NLDPRM(J,4),1D0).NE.0D0) THEN
IERR = 1
RETURN
END IF
WORLD(J) = S**NLDPRM(J,4)
300 CONTINUE
ELSE
IERR = 1
END IF
RETURN
END
|
