File: pgsbox.f

package info (click to toggle)
python-pywcs 1.11-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 11,888 kB
  • sloc: ansic: 31,441; lex: 6,170; fortran: 6,080; sh: 3,478; python: 3,122; sed: 408; makefile: 76
file content (2662 lines) | stat: -rw-r--r-- 88,971 bytes parent folder | download
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
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
*=======================================================================
*
* 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: pgsbox.f,v 4.8.1.1 2011/08/15 08:07:07 cal103 Exp cal103 $
*=======================================================================
*
* PGSBOX draws and labels a curvilinear coordinate grid.  The caller
* must provide a separate external function, NLFUNC, to define the
* non-linear coordinate transformation.
*
* PGLBOX, a simplified ENTRY point to PGSBOX, has been provided for
* drawing simple linear axes without the need to specify NLFUNC.
* PGLBOX allows simplified access to formatting control for labelling
* world coordinate axes that is not provided by the standard PGPLOT
* routines, PGBOX or PGTBOX.  PGLBOX uses the world coordinate range
* set by a prior call to PGSWIN and omits the following arguments:
*
*   BLC, TRC, NLFUNC, NLC, NLI, NLD, NLCPRM, NLIPRM, NLDPRM
*
* The remaining arguments are specified in the same order as PGSBOX.
*
* Given:
*   BLC       R(2)      Cartesian coordinates of the bottom left-hand
*   TRC       R(2)      corner and top right-hand corner of the frame.
*                       Any convenient Cartesian system may be used in
*                       conjunction with the non-linear transformation
*                       function, NLFUNC, described below.
*
*                       For example, FITS images have pixel coordinate
*                       (1,1) at the centre of the pixel in the bottom
*                       left-hand corner.  Thus it would be
*                       appropriate to set BLC to (0.5,0.5) and TRC to
*                       (NAXIS1+0.5, NAXIS2+0.5).
*
*   IDENTS    C(3)*(*)  Identification strings:
*                         1: Name of the first world coordinate
*                            element used for axis labelling.
*                         2: Name of the second world coordinate.
*                         3: Title, written at top.
*
*   OPT       C(2)*(*)  Formatting control for the world coordinates,
*                       used for axis labelling (see notes 1 and 2):
*                         ' ': plain numeric
*                         'A': angle in degrees expressed in decimal
*                              notation normalized in the range [0,360).
*                         'B': as 'A' but normalized in the range
*                              (-180,180].
*                         'C': as 'A' but unnormalized.
*                         'D': angle in degrees expressed in sexagesimal
*                              notation, DD^MM'SS".S, normalized in the
*                              range [0,360).
*                         'E': as 'D' but normalized in the range
*                              (-180,180].
*                         'F': as 'D' but unnormalized.
*                         'G': angle in degrees expressed in hms
*                              notation, HHhMMmSSs.S, normalized in the
*                              range [0,24) hours.
*                         'H': as 'G' but normalized in the range
*                              (-12,12] hours.
*                         'I': as 'G' but unnormalized.
*                         'L': logarithmic (see note 2)
*                         'T': time in hours expressed as HH:MM:SS.S
*                         'Y': Modified Julian Date to be expressed as
*                              a Gregorian calendar date, YYYY/MM/DD.
*                              (MJD = JD - 2400000.5.)
*
*                       For the angular types, NLFUNC is assumed to
*                       return the angle in degrees whereupon it will
*                       be formatted for display in the specified way.
*                       For example, an angle of -417.2958 degrees
*                       (returned by NLFUNC):
*
*                         'A':  302^.7042
*                         'B':  -57^.2958
*                         'C': -417^.2958
*                         'D':  302^42'15"
*                         'E':  -57^17'45"
*                         'F': -417^17'45"
*                         'H':   20h10m49s
*                         'I':   -3h49m11s
*                         'J':  -27h49m11s
*
*                       These are properly superscripted.
*
*   LABCTL    I         Decimal encoded grid labelling control:
*                            -1: Accumulate information on grid labels
*                                (see note 3) but do not write them.
*                             0: Let PGSBOX decide what edges to label.
*                             1: Label bottom of frame with the first
*                                world coordinate.
*                             2: Label bottom of frame with the second
*                                world coordinate.
*                            10: ... left side of frame.
*                            20: ... left side of frame.
*                           100: ... top of frame.
*                           200: ... top of frame.
*                          1000: ... right side of frame.
*                          2000: ... right side of frame.
*                         10000: Write labels from information
*                                accumulated in previous calls without
*                                drawing grid lines or tick marks.
*
*                       LABCTL = 0 usually gets what you want.
*                       LABCTL = 3333 labels all sides with both world
*                       coordinates.
*
*   LABDEN    I         Decimal encoded labelling density control for
*                       use where PGSBOX is called upon to determine a
*                       suitable grid spacing (e.g. via NG1 = 0,
*                       GRID1(0) = 0).  LABDEN = 100*D2 + D1 where
*                       D1, and D2 are the approximate number of grid
*                       lines for the first and second world
*                       coordinate.  LABDEN = 0 is effectively the same
*                       as LABDEN = 808.
*
*   CI        I(7)      Table of predefined colours established by
*                       calls to PGSCR.  This is used to control the
*                       colour used for different parts of the plot.
*                       CI table entries are used as follows:
*
*                                                world
*                                              coordinate
*                       Index      usage        element
*                       -----  --------------  ----------
*                         1      grid lines        1
*                         2      grid lines        2
*                         3    numeric labels      1
*                         4    numeric labels      2
*                         5    axis annotation     1
*                         6    axis annotation     2
*                         7        title           -
*
*                       For example, CI(3) is used for numeric labels
*                       for the first world coordinate.
*
*                       Colour selection is disabled for component J
*                       if CI(J) < 0.
*
*   GCODE(2)  I         Code for the type of grid to draw for each
*                       world coordinate:
*                         0: No grid or tick marks.
*                         1: Tick marks (on all edges).
*                         2: Full coordinate grid.
*
*                       Tick marks can be restricted to particular
*                       edges of the frame; a negative GCODE is
*                       interpreted as a decimal encoded control
*                       variable:
*                            -1: bottom
*                           -10: left
*                          -100: top
*                         -1000: right
*
*                       The digit scales the basic tick length.  For
*                       example, GCODE(1) = -102 restricts tick marks
*                       for the first world coordinate to the bottom
*                       and top edges of the frame.  Those on the
*                       bottom will be twice the length specified by
*                       TIKLEN.
*
*   TIKLEN    D         Tick length, in mm.  Negative values produce
*                       outside tick marks.
*
*   NG1       I         Upper array index for GRID1.
*
*   GRID1     D(0:NG1)  Grid values in WORLD(1) in the same units as
*                       returned by NLFUNC.
*
*                       If NG1 is zero, then
*                         a: if GRID1(0) is greater than zero it
*                            defines a uniform grid spacing.
*                         b: if GRID1(0) is zero a suitable spacing
*                            will be determined (see LABDEN).
*                         c: if GRID1(0) is less than zero then no
*                            grid lines will be drawn.
*
*                       If NG1 is greater than zero, then GRID1(0) is
*                       ignored.
*
*   NG2       I         Upper array index for GRID2.
*
*   GRID2     D(0:NG2)  Grid values in WORLD(2) in the same units as
*                       returned by NLFUNC, interpreted the same way
*                       as GRID1.
*
*   DOEQ      L         If NG1 = NG2 = 0, and GRID1(0) = 0D0 and/or
*                       GRID2(0) = 0D0, then choose the same grid
*                       spacing for each world coordinate.
*
*   NLFUNC    Ext       Non-linear coordinate function, see below.
*
*   NLC       I         Number of elements in NLCPRM (must be >0).
*
*   NLI       I         Number of elements in NLIPRM (must be >0).
*
*   NLD       I         Number of elements in NLDPRM (must be >0).
*
* Given and/or returned:
*   NLCPRM    C(NLC)*1  Character coefficients for NLFUNC.
*
*   NLIPRM    I(NLI)    Integer coefficients for NLFUNC.
*
*   NLDPRM    D(NLD)    Double precision coefficients for NLFUNC.
*
*   NC        I         Upper array index for CACHE (see note 3).
*
*   IC        I         Current number of entries in the CACHE table.
*                       Should be set to -1 on the first call to
*                       PGSBOX (see note 3).
*
*   CACHE     D(4,0:NC) Table of points where the tick marks or grid
*                       lines cross the frame (see note 3).
*                         1: Frame segment
*                            1: bottom
*                            2: left
*                            3: top
*                            4: right
*                         2: X or Y-Cartesian coordinate.
*                         3: World coordinate element (1 or 2).
*                         4: Value.
*
*                       CACHE(,0) is used to cache the extrema of the
*                       coordinate values between calls.  CACHE(1,NC-1)
*                       is also used to store related information.
*
*                       CACHE(,NC) will contain the margin widths in
*                       Cartesian coordinates when the labels are
*                       produced (i.e. the same Cartesian system used
*                       for BLC and TRC).
*
* Returned:
*   IERR      I         Status return value:
*                         0: Success
*                         1: Initialization error
*                         2: Invalid coordinate system
*                         3: Cache overflow (see note 3).
*
* Notes:
*   1: Where a logarithmic world coordinate type is indicated PGSBOX
*      chooses grid lines and labels on the basis that the value
*      returned by NLFUNC is a base 10 logarithm.  PGSBOX does not
*      itself take logarithms or antilogarithms.  For example, if the
*      range of values returned by NLFUNC were 0.9 - 2.5, then PGSBOX
*      would draw a subset of the following set of grid lines and
*      labels:
*
*                 value          label
*          ------------------    -----
*          0.9031 = log10(8)      8
*          0.9542 = log10(9)      9
*          1.0000 = log10(10)    10**1
*          1.3010 = log10(20)     2
*          1.4771 = log10(30)     3
*          1.6021 = log10(40)     4
*          1.6990 = log10(50)     5
*          1.7782 = log10(60)     6
*          1.8451 = log10(70)     7
*          1.9031 = log10(80)     8
*          1.9542 = log10(90)     9
*          2.0000 = log10(100)   10**2
*          2.3010 = log10(200)    2
*          2.4771 = log10(300)    3
*
*      The subset chosen depends on the coordinate increment as
*      specified by the caller (e.g. via NG1 = 0, GRID1(0) > 0) or as
*      deduced by PGSBOX from the required density of grid lines
*      specified in the LABDEN argument.  The selection is made
*      according to the following table:
*
*          increment          grid lines
*         (0.00,0.12]   1, 2, 3, 4, 5, 6, 7, 8, 9
*         (0.12,0.18]   1, 2, 3, 4, 5,    7
*         (0.18,0.23]   1, 2, 3,    5,    7
*         (0.23,0.28]   1, 2, 3,    5
*         (0.28,0.40]   1, 2,       5
*         (0.40,0.70]   1, 3
*         (0.70,1.00]   1
*
*      For increments greater than 1 the nearest integer is used.
*
*   2: PGSBOX will attempt to handle discontinuities in angle, such as
*      may occur when cycling through 360 degrees, wherever the
*      discontinuity may occur, for example
*
*        359 -> 0 -> 1
*
*      or
*
*        179 -> 180 -> -179
*
*      Only single cycles are detected, so the sequence
*
*        -360 -> 0 -> ... -> 359 -> 0 -> ... -> 359
*
*      would not be handled properly.  In such cases NLFUNC should be
*      changed to return a normalized angle, or else a continuous
*      sequence.
*
*   3: PGSBOX maintains a table of axis crossings, CACHE, in which it
*      stores information used for axis labelling.  The caller need not
*      normally be concerned about the use of this table other than to
*      provide sufficient space.  Typically, NC = 256 should be enough;
*      if not, IERR = 3 will be returned.
*
*      However, a coordinate grid may be produced via multiple calls to
*      PGSBOX with deferment of axis labelling.  This might be done to
*      change the pen colour and/or thickness for different sets of
*      grid lines.  The table accumulates information from each
*      successive call until the labels are produced.  The table index,
*      IC, may be reset to zero by the caller to discard the
*      information collected.
*
*      The extrema of the world coordinate elements are stored in
*      CACHE(,0).  When a coordinate grid is plotted with multiple
*      calls to PGSBOX the initial call should always have IC set to -1
*      to signal that PGSBOX needs to determine the extrema.  On
*      subsequent calls with IC non-negative PGSBOX uses the extrema
*      cached from the first call.  This can speed up execution
*      considerably.
*
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
* The curvilinear coordinate grid is defined by external function
* NLFUNC whose interface is defined as follows:
*
* Given:
*   OPCODE    I         Transformation code:
*                         +2: Compute a set of Cartesian coordinates
*                             that describe a path between this and
*                             the previous pair of world coordinates
*                             remembered from the last call with
*                             OPCODE = +1 or +2.  Usually only takes
*                             a single step unless traversing a
*                             discontinuity or some other
*                             irregularity (see explanation below).
*                         +1: Compute Cartesian coordinates from world
*                             coordinates.
*                          0: Initialize.
*                         -1: Compute world coordinates from Cartesian
*                             coordinates.
*
*                       N.B. NLFUNC must not change the input
*                       coordinates; that is the world coordinates for
*                       OPCODEs = +2 and +1, or the Cartesian
*                       coordinates for OPCODE = -1.
*
*   NLC       I         Number of elements in NLCPRM (must be >0).
*
*   NLI       I         Number of elements in NLIPRM (must be >0).
*
*   NLD       I         Number of elements in NLDPRM (must be >0).
*
* Given and/or returned:
*   NLCPRM    C(NLC)*1  Character array.
*
*   NLIPRM    I(NLI)    Integer coefficients.
*
*   NLDPRM    D(NLD)    Double precision coefficients.
*
*   WORLD     D(2)      World coordinates.  Given if OPCODE > 0,
*                       returned if OPCODE < 0.
*
*   XY        D(2)      Cartesian coordinates.  Given if OPCODE < 0,
*                       returned if OPCODE > 0.
*
*   CONTRL    I         Control flag for OPCODE = +2:
*                         0: Normal state.
*                         1: Force PGSBOX to flush its plotting buffer
*                            and call NLFUNC again with the same world
*                            coordinates.
*                         2: Force PGSBOX to call NLFUNC again with
*                            the same world coordinates (without
*                            flushing its plotting buffer).
*
*   CONTXT    D(20)     Context elements for OPCODE = +2.
*
* Returned:
*   IERR      I         Status return value:
*                         0: Success.
*                         1: Invalid parameters.
*                         2: Invalid world coordinate.
*                         3: Invalid Cartesian coordinate.
*
*                       The following status returns are recognized for
*                       opcodes +2 and +1
*                         -1: Accept the returned (x,y) coordinates but
*                             do not consider this as one end of a
*                             crossing segment for labelling world
*                             coordinate 1.
*                         -2: Ditto for world coordinate 2.
*                         -3: Ditto for world coordinates 1 and 2.
*
* PGSBOX passes its NLCPRM, NLIPRM, and NLDPRM adjustable size array
* arguments of length NLC, NLI, and NLD to NLFUNC without
* modification.  Comments within NLFUNC should specify the parameters
* it wants passed to it via these arrays.
*
* PGSBOX first calls NLFUNC with OPCODE = 0 to cause it to initialize
* its work arrays (if necessary).  It then uses OPCODE = -1 to
* determine the range of world coordinate values.  It anchors the
* start of each coordinate grid line with a call with OPCODE = +1, and
* then tracks it with OPCODE = +2.
*
* The CONTXT array is also passed to NLFUNC without modification to
* allow it to preserve state information between calls for OPCODE = 2.
* In particular, NLFUNC can use this to detect discontinuities in the
* grid lines.
*
* The CONTRL argument is provided so that NLFUNC can force PGSBOX to
* call it again with or without flushing its plotting buffer.  This
* may be needed when plotting a grid line through a discontinuity.
* PGSBOX does not modify CONTRL.
*
* Notes:
*   1: NLFUNC must not change the input coordinates; that is the world
*      coordinates for OPCODEs = +1 and +2, or the Cartesian coordinates
*      for OPCODE = -1.
*
*   2: NLFUNC must define a single-valued function, that is, each
*      Cartesian coordinate (x,y) must map to a unique world coordinate
*      pair (xi,eta).
*
*   3: Notwithstanding the fact that PGSBOX declares NLCPRM, NLIPRM,
*      and NLDPRM as single dimension arrays of length NLC, NLI, and
*      NLD, NLFUNC may treat these as higher-dimensional arrays, for
*      example, NLDPRM(2,NLD).  (The FORTRAN standard requires that
*      only the last dimension is adjustable.)
*
*=======================================================================
      SUBROUTINE PGSBOX (BLC_, TRC_, IDENTS, OPT, LABCTL, LABDEN, CI,
     :  GCODE, TIKLEN, NG1, GRID1, NG2, GRID2, DOEQ, NLFUNC, NLC, NLI,
     :  NLD, NLCPRM, NLIPRM, NLDPRM, NC, IC, CACHE, IERR)
*-----------------------------------------------------------------------
      INTEGER   BUFSIZ
      PARAMETER (BUFSIZ = 2048)

      LOGICAL   DOEDGE, DOEQ, DOLBOX, FULLSM, GETEND, INSIDE, ISANGL(2),
     :          LABLOK, MAJOR, OVERFL, PREVIN
      INTEGER   CI(7), CI0, CJ(7), CONTRL, DENS(2), FSEG, GCODE(2), IC,
     :          ID, IERR, IM, ISTEP, IW0, IWJ, IWK, IX, IY, IYPREV, J,
     :          K, KX, L, LABCTL, LABDEN, LDIV(2), LTABL(6,2:6), NC,
     :          NG(2), NG1, NG2, NLC, NLD, NLI, NLIPRM(NLI), NP,
     :          NSTEP(2), NWJ, NX, NY, TCODE(2,4)
      REAL      BLC(2), BLC_(2), S, TRC(2), TRC_(2), WXY(4), X1, X2,
     :          XPOINT, XR(BUFSIZ), XSCL, XSPAN, XTOL, XVP1, XVP2,
     :          Y1, Y2, YR(BUFSIZ), YSCL, YSPAN, YTOL, YVP1, YVP2
      DOUBLE PRECISION CONTXT(20), CACHE(4,0:NC), DW(2), DX, DY, FACT,
     :          G0(2), GSTEP(2), GRID1(0:NG1), GRID2(0:NG2),
     :          NLDPRM(NLD), STEP, SW(2), TIKLEN, TMP, VMAX(2,2),
     :          VMIN(2,2), W1PREV, W1X0, W2PREV, W2X0, WJUMP, WMAX(2),
     :          WMIN(2), WORLD(9), XY(9)
      CHARACTER FTYPE(2), IDENTS(3)*(*), NLCPRM(NLC)*1, OPT(2)*(*)

      EXTERNAL NLFUNC

*     Approximate number of grid lines for each coordinate.
      INTEGER DENS0
      PARAMETER (DENS0 = 8)

*     Double precision round-off tolerance.
      DOUBLE PRECISION TOL
      PARAMETER (TOL = 1D-8)

*     Number of steps per grid line.
      DATA NSTEP /80, 80/

*     Table of logarithmic grid values.
      DATA LTABL /3, 10,  0,  0,  0,  0,
     :            2,  5, 10,  0,  0,  0,
     :            2,  3,  5, 10,  0,  0,
     :            2,  3,  5,  7, 10,  0,
     :            2,  3,  4,  5,  7, 10/

*     These are to stop compiler messages about uninitialized variables.
      DATA IW0 /0/
      DATA LABLOK, PREVIN /2 * .FALSE./
      DATA G0 /2 * 0D0/
      DATA W1X0, W1PREV, W2X0, W2PREV /4 * 0D0/
      DATA WORLD, XY /9 * 0D0, 9 * 0D0/
*-----------------------------------------------------------------------
*  Initialize.
      DOLBOX = .FALSE.

      CALL NLFUNC (0, NLC, NLI, NLD, NLCPRM, NLIPRM, NLDPRM, WORLD,
     :  XY, CONTRL, CONTXT, IERR)
*     Quick return for now.
      IF (IERR.NE.0) THEN
        IERR = 1
        RETURN
      END IF

      BLC(1) = BLC_(1)
      BLC(2) = BLC_(2)
      TRC(1) = TRC_(1)
      TRC(2) = TRC_(2)

      DOEDGE = GCODE(1).NE.2 .AND. GCODE(2).NE.2

*-----------------------------------------------------------------------
      GO TO 10

      ENTRY PGLBOX (IDENTS, OPT, LABCTL, LABDEN, CI, GCODE, TIKLEN, NG1,
     :  GRID1, NG2, GRID2, DOEQ, NC, IC, CACHE, IERR)

      DOLBOX = .TRUE.

      BLC(1) = 0.0
      BLC(2) = 0.0
      TRC(1) = 1.0
      TRC(2) = 1.0

      DOEDGE = .TRUE.

      CONTRL = 0
      IERR = 0

 10   CONTINUE

*-----------------------------------------------------------------------
      IF (NC.LT.1) THEN
        IERR = 3
        RETURN
      END IF

      NG(1) = NG1
      NG(2) = NG2

      FTYPE(1) = OPT(1)(1:1)
      FTYPE(2) = OPT(2)(1:1)

*     Extend the PGPLOT window and rescale it.
      CALL PGQVP (0, XVP1, XVP2, YVP1, YVP2)
      CALL PGQWIN (WXY(1), WXY(2), WXY(3), WXY(4))
      CALL PGSVP (0.0, 1.0, 0.0, 1.0)
      XSCL = (TRC(1)-BLC(1))/(XVP2-XVP1)
      YSCL = (TRC(2)-BLC(2))/(YVP2-YVP1)
      CALL PGSWIN (BLC(1)-XSCL*XVP1, TRC(1)+XSCL*(1.0-XVP2),
     :             BLC(2)-YSCL*YVP1, TRC(2)+YSCL*(1.0-YVP2))

*     Determine initial colour and set colour indices.
      CALL PGQCI (CI0)
      DO 20 J = 1, 7
        IF (CI(J).GE.0) THEN
          CJ(J) = CI(J)
        ELSE
          CJ(J) = CI0
        END IF
 20   CONTINUE

*     Labels only?
      IF (LABCTL.GE.10000) GO TO 130


      XSPAN = WXY(2) - WXY(1)
      YSPAN = WXY(4) - WXY(3)
      XTOL  = XSPAN*TOL
      YTOL  = YSPAN*TOL

*  Find world coordinate ranges:
*  WMIN(1:2)  ...lower limit of each world coordinate element.
*  WMAX(1:2)  ...upper limit of each world coordinate element.
*  GSTEP(1:2) ...spacing between grid lines for each element.
*  DW(1:2)    ...span from WMIN to WMAX.
*  SW(1:2)    ...increment in world coordinate between plotting steps.
*  NSTEP(1:2) ...number of plotting steps between WMIN and WMAX.
      FULLSM = .FALSE.
      IF (IC.GE.0 .AND. IC.LT.NC-1) FULLSM = CACHE(1,NC-1).EQ.1D0

      IF (IC.GE.0 .AND. (FULLSM .OR. DOEDGE)) THEN
*       Use extrema cached from a previous call.
        WMIN(1) = CACHE(1,0)
        WMAX(1) = CACHE(2,0)
        WMIN(2) = CACHE(3,0)
        WMAX(2) = CACHE(4,0)

      ELSE
*       Do a coarse search to find approximate ranges.
        WMIN(1) =  1D99
        WMAX(1) = -1D99
        WMIN(2) =  1D99
        WMAX(2) = -1D99

*       Need to consider cycles in angle through 360 degrees.
        ISANGL(1) = INDEX('ABCDEFGHI',FTYPE(1)).NE.0
        ISANGL(2) = INDEX('ABCDEFGHI',FTYPE(2)).NE.0
        VMIN(1,1) =  1D99
        VMIN(1,2) =  1D99
        VMAX(1,1) = -1D99
        VMAX(1,2) = -1D99
        VMIN(2,1) =  1D99
        VMIN(2,2) =  1D99
        VMAX(2,1) = -1D99
        VMAX(2,2) = -1D99

*       Sample coordinates on a 50 x 50 grid.
        NX = 50
        NY = 50
        DX = DBLE(TRC(1)-BLC(1))/NX
        DY = DBLE(TRC(2)-BLC(2))/NY

        K = 0
        IYPREV = -1
        DO 40 IY = 0, NY
          XY(2) = BLC(2) + IY*DY

*         Sample the edges only?
          KX = 1
          IF (DOEDGE) THEN
            IF (IY.NE.0 .AND. IY.NE.NY) KX = NX
          END IF

          DO 30 IX = 0, NX, KX
            XY(1) = BLC(1) + IX*DX

            IF (DOLBOX) THEN
              WORLD(1) = WXY(1) + XY(1)*XSPAN
              WORLD(2) = WXY(3) + XY(2)*YSPAN
            ELSE
              CALL NLFUNC (-1, NLC, NLI, NLD, NLCPRM, NLIPRM,
     :          NLDPRM, WORLD, XY, CONTRL, CONTXT, IERR)
            END IF

            IF (IERR.EQ.0) THEN
              K = K + 1

              IF (ISANGL(1)) THEN
                IF (K.EQ.1) W1X0 = WORLD(1)

                IF (IY.NE.IYPREV) THEN
                  W1PREV = W1X0
                  W1X0 = WORLD(1)
                END IF

*               Iron out jumps.
                WJUMP = WORLD(1) - W1PREV
                IF (ABS(WJUMP).GT.180D0) THEN
                  WJUMP = WJUMP + SIGN(180D0,WJUMP)
                  WJUMP = 360D0*INT(WJUMP/360D0)
                  WORLD(1) = WORLD(1) - WJUMP
                END IF

                W1PREV = WORLD(1)
                IYPREV = IY
              END IF

              IF (ISANGL(2)) THEN
                IF (K.EQ.1) W2X0 = WORLD(2)

                IF (IY.NE.IYPREV) THEN
                  W2PREV = W2X0
                  W2X0 = WORLD(2)
                END IF

*               Iron out jumps.
                WJUMP = WORLD(2) - W2PREV
                IF (ABS(WJUMP).GT.180D0) THEN
                  WJUMP = WJUMP + SIGN(180D0,WJUMP)
                  WJUMP = 360D0*INT(WJUMP/360D0)
                  WORLD(2) = WORLD(2) - WJUMP
                END IF

                W2PREV = WORLD(2)
                IYPREV = IY
              END IF

              IF (WORLD(1).LT.WMIN(1)) WMIN(1) = WORLD(1)
              IF (WORLD(1).GT.WMAX(1)) WMAX(1) = WORLD(1)
              IF (WORLD(2).LT.WMIN(2)) WMIN(2) = WORLD(2)
              IF (WORLD(2).GT.WMAX(2)) WMAX(2) = WORLD(2)

              IF (ISANGL(1)) THEN
*               Normalize to the range [0,360).
                WORLD(1) = MOD(WORLD(1), 360D0)
                IF (WORLD(1).LT.0D0) WORLD(1) = WORLD(1) + 360D0
                IF (WORLD(1).LT.VMIN(1,1)) VMIN(1,1) = WORLD(1)
                IF (WORLD(1).GT.VMAX(1,1)) VMAX(1,1) = WORLD(1)

*               Normalize to the range (-180,180].
                IF (WORLD(1).GT.180D0) WORLD(1) = WORLD(1) - 360D0
                IF (WORLD(1).LT.VMIN(1,2)) VMIN(1,2) = WORLD(1)
                IF (WORLD(1).GT.VMAX(1,2)) VMAX(1,2) = WORLD(1)
              END IF

              IF (ISANGL(2)) THEN
*               Normalize to the range [0,360).
                WORLD(2) = MOD(WORLD(2), 360D0)
                IF (WORLD(2).LT.0D0) WORLD(2) = WORLD(2) + 360D0
                IF (WORLD(2).LT.VMIN(2,1)) VMIN(2,1) = WORLD(2)
                IF (WORLD(2).GT.VMAX(2,1)) VMAX(2,1) = WORLD(2)

*               Normalize to the range (-180,180].
                IF (WORLD(2).GT.180D0) WORLD(2) = WORLD(2) - 360D0
                IF (WORLD(2).LT.VMIN(2,2)) VMIN(2,2) = WORLD(2)
                IF (WORLD(2).GT.VMAX(2,2)) VMAX(2,2) = WORLD(2)
              END IF
            END IF
 30       CONTINUE
 40     CONTINUE

        IF (K.EQ.0) THEN
*         No valid coordinates found within the frame.
          IERR = 2
          GO TO 999
        END IF

*       Check for cycles in angle.
        DO 50 J = 1, 2
          IF (ISANGL(J)) THEN
            IF (WMAX(J)-WMIN(J).LT.360D0 .AND.
     :          WMAX(J)-WMIN(J).GT.VMAX(J,1)-VMIN(J,1)+TOL) THEN
*             Must have a cycle, preserve the sign.
              IF (WMAX(J).GE.0D0) THEN
                WMIN(J) = VMIN(J,1)
                WMAX(J) = VMAX(J,1)
              ELSE
                WMIN(J) = VMIN(J,1) - 360D0
                WMAX(J) = VMAX(J,1) - 360D0
              END IF
            END IF

            IF (WMAX(J)-WMIN(J).LT.360D0 .AND.
     :          WMAX(J)-WMIN(J).GT.VMAX(J,2)-VMIN(J,2)+TOL) THEN
*             Must have a cycle, preserve the sign.
              IF (WMAX(J).GE.0D0) THEN
                IF (VMAX(J,2).GE.0D0) THEN
                  WMIN(J) = VMIN(J,2)
                  WMAX(J) = VMAX(J,2)
                ELSE
                  WMIN(J) = VMIN(J,2) + 360D0
                  WMAX(J) = VMAX(J,2) + 360D0
                END IF
              ELSE
                IF (VMAX(J,2).LT.0D0) THEN
                  WMIN(J) = VMIN(J,2)
                  WMAX(J) = VMAX(J,2)
                ELSE
                  WMIN(J) = VMIN(J,2) - 360D0
                  WMAX(J) = VMAX(J,2) - 360D0
                END IF
              END IF
            END IF
          END IF
 50     CONTINUE

*       Cache extrema for subsequent calls.
        CACHE(1,0) = WMIN(1)
        CACHE(2,0) = WMAX(1)
        CACHE(3,0) = WMIN(2)
        CACHE(4,0) = WMAX(2)

*       Was full sampling done?
        IF (DOEDGE) THEN
          CACHE(1,NC-1) = 0D0
        ELSE
          CACHE(1,NC-1) = 1D0
        END IF

        IC = 0
      END IF

*     Choose an appropriate grid spacing.
      IF (LABDEN.GT.0) THEN
*       User specified grid density.
        DENS(1) = MOD(LABDEN,100)
        DENS(2) = LABDEN/100
        IF (DENS(1).EQ.0) DENS(1) = DENS0
        IF (DENS(2).EQ.0) DENS(2) = DENS0
      ELSE
*       Default grid density.
        DENS(1) = DENS0
        DENS(2) = DENS0
      END IF

      IF (NG(1).EQ.0) G0(1) = GRID1(0)
      IF (NG(2).EQ.0) G0(2) = GRID2(0)

      DO 60 J = 1, 2
        IF (J.EQ.1) THEN
          K = 2
        ELSE
          K = 1
        END IF

        IF (NG(J).EQ.0 .AND. G0(J).LT.0D0) THEN
*         Defeat grid lines and tick marks.
          GCODE(J) = 0
        END IF

        IF (NG(J).EQ.0 .AND. G0(J).GT.0D0) THEN
*         User-specified, directly.
          GSTEP(J) = G0(J)
        ELSE IF (DOEQ .AND. NG(K).EQ.0 .AND. G0(K).GT.0D0) THEN
*         User-specified, indirectly.
          GSTEP(J) = G0(K)
        ELSE
*         Left to us to choose.  Even if grid lines are not drawn for
*         coordinate J, i.e. NG(J) = 0 and G0(J) < 0, GSTEP(J) is still
*         needed because it is used to deduce SW(J) which is used for
*         drawing grid lines for the other coordinate.
          DW(J) = WMAX(J) - WMIN(J)
          STEP = DW(J)/DENS(J)

          FACT = 1D0
          IF (INDEX('GHI',FTYPE(J)).NE.0) THEN
*           Rescale degrees to hours.
            FACT = 1D0/15D0
            STEP = STEP*FACT
          ELSE IF (FTYPE(J).EQ.'Y' .AND. STEP.LT.0.5D0) THEN
*           Calendar increment of less than 12h; use time format.
            FTYPE(J) = 'y'

*           Rescale days to hours.
            FACT = 24D0
            STEP = STEP*FACT
          END IF

          IF (INDEX('ABCDEF',FTYPE(J)).NE.0 .AND. STEP.GE.1D0) THEN
*           Angle with multi-degree increment.
            IF (STEP.LT.1.5D0) THEN
              STEP = 1D0
            ELSE IF (STEP.LT.3D0) THEN
              STEP = 2D0
            ELSE IF (STEP.LT.7D0) THEN
              STEP = 5D0
            ELSE IF (STEP.LT.12D0) THEN
              STEP = 10D0
            ELSE IF (STEP.LT.20D0) THEN
              STEP = 15D0
            ELSE IF (STEP.LT.40D0) THEN
              STEP = 30D0
            ELSE IF (STEP.LT.70D0) THEN
              STEP = 45D0
            ELSE IF (STEP.LT.120D0) THEN
              STEP = 90D0
            ELSE IF (STEP.LT.270D0) THEN
              STEP = 180D0
            ELSE IF (STEP.LT.520D0) THEN
              STEP = 360D0
            ELSE
              STEP = 360D0*INT(STEP/360D0 + 0.5)
            END IF

          ELSE IF (INDEX('GHITy',FTYPE(J)).NE.0 .AND.
     :      STEP.GE.1D0) THEN
*           Angle or time in hms format with multi-hour increment.
            IF (STEP.LT.1.5D0) THEN
              STEP = 1D0
            ELSE IF (STEP.LT.2.5D0) THEN
              STEP = 2D0
            ELSE IF (STEP.LT.3.5D0) THEN
              STEP = 3D0
            ELSE IF (STEP.LT.5D0) THEN
              STEP = 4D0
            ELSE IF (STEP.LT.7D0) THEN
              STEP = 6D0
            ELSE IF (STEP.LT.10D0) THEN
              STEP = 8D0
            ELSE IF (STEP.LT.15D0) THEN
              STEP = 12D0
            ELSE IF (STEP.LT.21D0) THEN
              STEP = 18D0
            ELSE IF (STEP.LT.36D0) THEN
              STEP = 24D0
            ELSE
              STEP = 24D0*INT(STEP/24D0 + 0.5)
            END IF

            STEP = STEP/FACT

          ELSE IF (INDEX('DEFGHITy',FTYPE(J)).NE.0 .AND.
     :      STEP.LT.1D0) THEN
*           Angle or time in sexagesimal format with sub-degree/hour
*           increment.
            FACT = FACT*60D0
            STEP = STEP*60D0
            IF (STEP.LT.1D0) THEN
*             Sub-minute increment.
              FACT = FACT*60D0
              STEP = STEP*60D0
            END IF

            IF (STEP.LT.1D0) THEN
*             Sub-second increment.
              TMP = 10D0**(INT(LOG10(STEP))-1)
              IF (1.5*TMP.GE.STEP) THEN
                STEP = TMP
              ELSE
                IF (3D0*TMP.GE.STEP) THEN
                  STEP = 2D0*TMP
                ELSE
                  IF (7D0*TMP.GE.STEP) THEN
                    STEP = 5D0*TMP
                  ELSE
                    STEP = 10D0*TMP
                  END IF
                END IF
              END IF

            ELSE
              IF (STEP.LT.1.5D0) THEN
                STEP = 1D0
              ELSE IF (STEP.LT.2.5D0) THEN
                STEP = 2D0
              ELSE IF (STEP.LT.3.5D0) THEN
                STEP = 3D0
              ELSE IF (STEP.LT.4.5D0) THEN
                STEP = 4D0
              ELSE IF (STEP.LT.5.5D0) THEN
                STEP = 5D0
              ELSE IF (STEP.LT.8D0) THEN
                STEP = 6D0
              ELSE IF (STEP.LT.11D0) THEN
                STEP = 10D0
              ELSE IF (STEP.LT.14D0) THEN
                STEP = 12D0
              ELSE IF (STEP.LT.18D0) THEN
                STEP = 15D0
              ELSE IF (STEP.LT.25D0) THEN
                STEP = 20D0
              ELSE IF (STEP.LT.45D0) THEN
                STEP = 30D0
              ELSE
                STEP = 60D0
              END IF
            END IF

            STEP = STEP/FACT

          ELSE IF (FTYPE(J).EQ.'Y') THEN
*           Calendar axis: use coded steps.
            IF (STEP.LT.15D0) THEN
*             Timespan of a few months; use multi-day increments.
              STEP = ANINT(STEP)
              IF (STEP.LT.1D0) THEN
                STEP = 1D0
              ELSE IF (STEP.GT.9D0) THEN
*               Fortnightly.
                STEP = 14D0
              ELSE IF (STEP.GT.4D0) THEN
*               Weekly.
                STEP = 7D0
              END IF

            ELSE IF (STEP.LT.270D0) THEN
*             Timespan of a few years; use multi-month increments.
              STEP = ANINT(STEP/30.44D0)
              IF (STEP.LT.1.5D0) THEN
                STEP = 1D0
              ELSE IF (STEP.LT.2.5D0) THEN
                STEP = 2D0
              ELSE IF (STEP.LT.3.5D0) THEN
                STEP = 3D0
              ELSE IF (STEP.LT.4.5D0) THEN
                STEP = 4D0
              ELSE
                STEP = 6D0
              END IF

*             Coding for multi-month increments.
              STEP = 100D0*STEP

            ELSE
*             Multi-year increments.
              STEP = ANINT(DW(J)/DENS(J)/365.25D0)
              IF (STEP.LT.1D0) THEN
                STEP = 1D0
              ELSE
                TMP = 10D0**INT(LOG10(STEP))

                IF (1.5D0*TMP.GE.STEP) THEN
                  STEP = TMP
                ELSE
                  IF (3D0*TMP.GE.STEP) THEN
                    STEP = 2D0*TMP
                  ELSE
                    IF (7D0*TMP.GE.STEP) THEN
                      STEP = 5D0*TMP
                    ELSE
                      STEP = 10D0*TMP
                    END IF
                  END IF
                END IF
              END IF

*             Coding for multi-year increments.
              STEP = 10000D0*STEP
            END IF

          ELSE
*           Just numbers.
            TMP = 10D0**INT(LOG10(STEP))
            IF (STEP.LT.1D0) TMP = TMP/10D0

            IF (1.5D0*TMP.GE.STEP) THEN
              STEP = TMP
            ELSE
              IF (3D0*TMP.GE.STEP) THEN
                STEP = 2D0*TMP
              ELSE
                IF (7D0*TMP.GE.STEP) THEN
                  STEP = 5D0*TMP
                ELSE
                  STEP = 10D0*TMP
                END IF
              END IF
            END IF

*           Adjust the step size for logarithmic values.
            IF (FTYPE(J).EQ.'L') THEN
              IF (STEP.GT.0.7D0) THEN
                LDIV(J) = 1
                STEP = NINT(STEP)
              ELSE
                IF (STEP.GT.0.4D0) THEN
                  LDIV(J) = 2
                ELSE IF (STEP.GT.0.28D0) THEN
                  LDIV(J) = 3
                ELSE IF (STEP.GT.0.23D0) THEN
                  LDIV(J) = 4
                ELSE IF (STEP.GT.0.18D0) THEN
                  LDIV(J) = 5
                ELSE IF (STEP.GT.0.12D0) THEN
                  LDIV(J) = 6
                ELSE
                  LDIV(J) = 9
                END IF

                STEP = 1D0/LDIV(J)
              END IF
            END IF
          END IF

          GSTEP(J) = STEP
        END IF
 60   CONTINUE

*     Equal grid spacing?
      IF (DOEQ .AND. NG(1).EQ.0 .AND. NG(2).EQ.0) THEN
        IF (GRID1(0).EQ.0D0 .AND. GRID2(0).EQ.0D0) THEN
          GSTEP(1) = MIN(GSTEP(1), GSTEP(2))
          GSTEP(2) = GSTEP(1)
        ELSE IF (GRID1(0).EQ.0D0) THEN
          GSTEP(1) = GSTEP(2)
        ELSE IF (GRID2(0).EQ.0D0) THEN
          GSTEP(2) = GSTEP(1)
        END IF
      END IF

*     Fine tune the end points.
      DO 70 J = 1, 2
        IF (FTYPE(J).EQ.'L') THEN
          WMIN(J) = AINT(WMIN(J)-1D0)
          WMAX(J) = AINT(WMAX(J)+1D0)
        ELSE IF (FTYPE(J).EQ.'Y') THEN
*         Calendar axis.
          IF (GSTEP(J).LT.100D0) THEN
*           Daily increments.
            WMIN(J) = AINT(WMIN(J))
            WMAX(J) = AINT(WMAX(J)+1D0)
          ELSE
*           Start on Jan/01.
            CALL PGMJD (0, WMIN(J), IY, IM, ID)
            CALL PGMJD (1, WMIN(J), IY, 1, 1)

            CALL PGMJD (0, WMAX(J), IY, IM, ID)
            IF (GSTEP(J).LT.10000D0) THEN
*             Monthly increments.
              CALL PGMJD (1, WMAX(J), IY, 12, 1)
            ELSE
*             Yearly increments.
              CALL PGMJD (1, WMAX(J), IY+1, 1, 1)
            END IF
          END IF

        ELSE
          TMP = AINT(WMIN(J)/GSTEP(J))*GSTEP(J)
          IF (TMP.GE.WMIN(J)) TMP = TMP - GSTEP(J)
          WMIN(J) = TMP
          TMP = AINT(WMAX(J)/GSTEP(J))*GSTEP(J)
          IF (TMP.LE.WMAX(J)) TMP = TMP + GSTEP(J)
          WMAX(J) = TMP
        END IF

        DW(J) = WMAX(J) - WMIN(J)
        SW(J) = DW(J)/NSTEP(J)

*       Adjust NSTEP so that SW divides GSTEP.
        IF (SW(J).LT.GSTEP(J)) THEN
          SW(J) = GSTEP(J)/ANINT(GSTEP(J)/SW(J))
        ELSE
          SW(J) = GSTEP(J)
        END IF
        NSTEP(J) = ANINT(DW(J)/SW(J))
 70   CONTINUE


*  Draw the grid.
*     Get absolute scale for tick marks.
      CALL PGQVP (2, X1, X2, Y1, Y2)
      XSCL = (X2-X1)/(TRC(1)-BLC(1))
      YSCL = (Y2-Y1)/(TRC(2)-BLC(2))

*     Decode tick mark control.
      DO 80 J = 1, 2
        IF (GCODE(J).EQ.2) THEN
          TCODE(J,1) = -1
          TCODE(J,2) = -1
          TCODE(J,3) = -1
          TCODE(J,4) = -1
        ELSE IF (GCODE(J).EQ.1) THEN
          TCODE(J,1) = 1
          TCODE(J,2) = 1
          TCODE(J,3) = 1
          TCODE(J,4) = 1
        ELSE IF (GCODE(J).LT.0) THEN
          K = ABS(GCODE(J))
          TCODE(J,1) = MOD(K,10)
          TCODE(J,2) = MOD(K/10,10)
          TCODE(J,3) = MOD(K/100,10)
          TCODE(J,4) = MOD(K/1000,10)
        ELSE
          TCODE(J,1) = 0
          TCODE(J,2) = 0
          TCODE(J,3) = 0
          TCODE(J,4) = 0
        END IF
 80   CONTINUE

*     Draw each set of grid lines.
      OVERFL = .FALSE.
      DO 120 J = 1, 2
        IF (GCODE(J).EQ.0) GO TO 120

        IF (J.EQ.1) THEN
          CALL PGSCI (CJ(1))
          K = 2
        ELSE
          CALL PGSCI (CJ(2))
          K = 1
        END IF

        IF (NG(J).GT.0) THEN
          NWJ = NG(J)

        ELSE IF (FTYPE(J).EQ.'Y' .AND. GSTEP(J).GE.100D0) THEN
*         Calendar axis.
          CALL PGMJD (0, WMAX(J), IY, IM, ID)
          IF (GSTEP(J).LT.10000D0) THEN
            NWJ = 12*IY + IM
            CALL PGMJD (0, WMIN(J), IY, IM, ID)
            NWJ = (NWJ - (12*IY + IM))/INT(GSTEP(J)/100D0)
          ELSE
            NWJ = IY
            CALL PGMJD (0, WMIN(J), IY, IM, ID)
            NWJ = (NWJ - IY)/INT(GSTEP(J)/10000D0)
          END IF

        ELSE
          NWJ = NINT(DW(J)/GSTEP(J))
          IW0 = NINT(WMIN(J)/GSTEP(J))
        END IF

        DO 110 IWJ = 0, NWJ
          MAJOR = .FALSE.

*         Determine the world coordinate of the grid line.
          IF (NG(J).GT.0) THEN
*           User-specified.
            IF (IWJ.EQ.0) GO TO 110
            IF (J.EQ.1) THEN
              WORLD(1) = GRID1(IWJ)
            ELSE
              WORLD(2) = GRID2(IWJ)
            END IF

          ELSE
*           Internally computed.
            IF (FTYPE(J).EQ.'Y' .AND. GSTEP(J).GE.100D0) THEN
*             Calendar axis.
              CALL PGMJD (0, WMIN(J), IY, IM, ID)
              IF (GSTEP(J).LT.10000D0) THEN
                IM = IM + IWJ*INT(GSTEP(J)/100D0)
                CALL PGMJD (1, WORLD(J), IY, IM, ID)
              ELSE
                IY = IY + IWJ*INT(GSTEP(J)/10000D0)
                CALL PGMJD (1, WORLD(J), IY, IM, ID)
              END IF

            ELSE
              WORLD(J) = (IW0 + IWJ)*GSTEP(J)

*             Logarithmic?
              IF (FTYPE(J).EQ.'L') THEN
                TMP = MOD(WORLD(J),1D0)
                IF (TMP.LT.0D0) TMP = TMP + 1D0
                L = NINT(TMP*LDIV(J))

                IF (L.EQ.0) THEN
*                 Major tick mark.
                  MAJOR = .TRUE.
                ELSE
*                 Adjust logarithmic scales.
                  IF (LDIV(J).LE.6) THEN
                    L = LTABL(L,LDIV(J))
                  ELSE
                    L = L + 1
                  END IF

                  WORLD(J) = WORLD(J) - TMP + LOG10(DBLE(L))
                END IF
              END IF
            END IF
          END IF

          NP = 0
          GETEND = .TRUE.
          DO 100 IWK = 0, NSTEP(K)
            WORLD(K) = WMIN(K) + IWK*SW(K)

            IF (GETEND) THEN
*             Get end-point context.
              IF (DOLBOX) THEN
                XY(1) = (WORLD(1) - WXY(1))/XSPAN
                XY(2) = (WORLD(2) - WXY(3))/YSPAN
              ELSE
                CALL NLFUNC (1, NLC, NLI, NLD, NLCPRM, NLIPRM,
     :            NLDPRM, WORLD, XY, CONTRL, CONTXT, IERR)
              END IF

              IF (IERR.LE.0) THEN
                X1 = REAL(XY(1))
                Y1 = REAL(XY(2))
                INSIDE = X1.GT.BLC(1) .AND. X1.LT.TRC(1) .AND.
     :                   Y1.GT.BLC(2) .AND. Y1.LT.TRC(2)

                NP = 1
                XR(1) = X1
                YR(1) = Y1

                PREVIN = INSIDE
                GETEND = .FALSE.

                LABLOK = IERR.NE.-J .AND. IERR.NE.-3
              END IF
              GO TO 100
            END IF

            DO 90 ISTEP = 1, 1000
              IF (DOLBOX) THEN
                XY(1) = (WORLD(1) - WXY(1))/XSPAN
                XY(2) = (WORLD(2) - WXY(3))/YSPAN
              ELSE
                CALL NLFUNC (2, NLC, NLI, NLD, NLCPRM, NLIPRM,
     :            NLDPRM, WORLD, XY, CONTRL, CONTXT, IERR)
              END IF

              IF (IERR.GT.0) THEN
*               Flush buffer.
                IF (NP.GT.1) CALL PGLINE(NP, XR, YR)
                NP = 0
                GETEND = .TRUE.
                GO TO 100
              END IF

              IF (NP.EQ.BUFSIZ) THEN
*               Recycle buffer.
                CALL PGLINE(NP, XR, YR)
                XR(1) = XR(NP)
                YR(1) = YR(NP)
                NP = 1
              END IF

              X2 = REAL(XY(1))
              Y2 = REAL(XY(2))
              INSIDE = X2.GT.BLC(1) .AND. X2.LT.TRC(1) .AND.
     :                 Y2.GT.BLC(2) .AND. Y2.LT.TRC(2)

              IF (.NOT.INSIDE) THEN
*               For tick marks at the left or right edge.
                IF ((X2.EQ.BLC(1) .OR.  X2.EQ.TRC(1)) .AND.
     :               Y2.GT.BLC(2) .AND. Y2.LT.TRC(2)) THEN
                  INSIDE = X2.EQ.XR(NP)
                END IF
              END IF

              IF (.NOT.INSIDE) THEN
*               For tick marks at the bottom or top edge.
                IF ((Y2.EQ.BLC(2) .OR.  Y2.EQ.TRC(2)) .AND.
     :               X2.GT.BLC(1) .AND. X2.LT.TRC(1)) THEN
                  INSIDE = Y2.EQ.YR(NP)
                END IF
              END IF

              IF (NP.EQ.0) THEN
                NP = 1
                XR(1) = X2
                YR(1) = Y2
              ELSE
                IF (INSIDE) THEN
*                 This point is inside the frame...
                  IF (.NOT.PREVIN) THEN
*                   ...but the previous one was outside.
                    X1 = XR(NP)
                    Y1 = YR(NP)

                    FSEG = 0
                    XPOINT = 0.0
                    IF (ABS(X2-X1).GT.XTOL) THEN
                      S = (Y2-Y1)/(X2-X1)
                      IF (XR(NP).LE.BLC(1)) THEN
                        FSEG = 2
                        XR(NP) = BLC(1)
                        XPOINT = Y1 + (XR(NP) - X1)*S
                        YR(NP) = XPOINT
                      ELSE IF (XR(NP).GE.TRC(1)) THEN
                        FSEG = 4
                        XR(NP) = TRC(1)
                        XPOINT = Y1 + (XR(NP) - X1)*S
                        YR(NP) = XPOINT
                      END IF
                    END IF

                    IF (ABS(Y2-Y1).GT.YTOL) THEN
                      S = (X2-X1)/(Y2-Y1)
                      IF (YR(NP).LE.BLC(2)) THEN
                        FSEG = 1
                        YR(NP) = BLC(2)
                        XPOINT = X1 + (YR(NP) - Y1)*S
                        XR(NP) = XPOINT
                      ELSE IF (YR(NP).GE.TRC(2)) THEN
                        FSEG = 3
                        YR(NP) = TRC(2)
                        XPOINT = X1 + (YR(NP) - Y1)*S
                        XR(NP) = XPOINT
                      END IF
                    END IF


                    IF (FSEG.EQ.0) THEN
*                     The crossing is too oblique.
                      INSIDE = .FALSE.

                    ELSE
*                     Record this crossing point.
                      IF (TCODE(J,FSEG).NE.0 .AND. LABLOK) THEN
                        IF (IC.LT.NC-1) THEN
                          IC = IC + 1
                          CACHE(1,IC) = FSEG
                          CACHE(2,IC) = XPOINT
                          CACHE(3,IC) = J
                          CACHE(4,IC) = WORLD(J)
                        ELSE
*                         Cache overflow.
                          OVERFL = .TRUE.
                        END IF
                      END IF

                      IF (TCODE(J,FSEG).GT.0) THEN
*                       Just want tick marks.
                        S = (XSCL*(X2-X1))**2 + (YSCL*(Y2-Y1))**2
                        S = SQRT(S)/TCODE(J,FSEG)
                        IF (MAJOR) S = S/1.5
                        NP = NP + 1
                        XR(NP) = XR(NP-1) + (X2-X1)*TIKLEN/S
                        YR(NP) = YR(NP-1) + (Y2-Y1)*TIKLEN/S

                        CALL PGLINE(NP, XR, YR)
                        NP = 1
                      END IF
                    END IF
                  END IF

                  IF (INSIDE .AND. GCODE(J).EQ.2) THEN
*                   Full grid.
                    NP = NP + 1
                  END IF
                  XR(NP) = X2
                  YR(NP) = Y2
                ELSE
*                 This point is outside the frame...
                  IF (PREVIN) THEN
*                   ...but the previous one was inside.
                    X1 = XR(NP)
                    Y1 = YR(NP)

                    NP = NP + 1
                    XR(NP) = X2
                    YR(NP) = Y2

                    FSEG = 0
                    XPOINT = 0.0
                    IF (ABS(X2-X1).GT.XTOL) THEN
                      S = (Y2-Y1)/(X2-X1)
                      IF (XR(NP).LE.BLC(1)) THEN
                        FSEG = 2
                        XR(NP) = BLC(1)
                        XPOINT = Y1 + (XR(NP) - X1)*S
                        YR(NP) = XPOINT
                      ELSE IF (XR(NP).GE.TRC(1)) THEN
                        FSEG = 4
                        XR(NP) = TRC(1)
                        XPOINT = Y1 + (XR(NP) - X1)*S
                        YR(NP) = XPOINT
                      END IF
                    END IF

                    IF (ABS(Y2-Y1).GT.YTOL) THEN
                      S = (X2-X1)/(Y2-Y1)
                      IF (YR(NP).LE.BLC(2)) THEN
                        FSEG = 1
                        YR(NP) = BLC(2)
                        XPOINT = X1 + (YR(NP) - Y1)*S
                        XR(NP) = XPOINT
                      ELSE IF (YR(NP).GE.TRC(2)) THEN
                        FSEG = 3
                        YR(NP) = TRC(2)
                        XPOINT = X1 + (YR(NP) - Y1)*S
                        XR(NP) = XPOINT
                      END IF
                    END IF


                    IF (FSEG.EQ.0) THEN
*                     The crossing is too oblique.
                      INSIDE = .TRUE.

                      IF (GCODE(J).EQ.2) THEN
*                       Full grid.
                        NP = NP + 1
                      END IF
                      XR(NP) = X2
                      YR(NP) = Y2

                    ELSE
*                     Record this crossing point.
                      IF (TCODE(J,FSEG).NE.0 .AND. LABLOK) THEN
                        IF (IC.LT.NC-1) THEN
                          IC = IC + 1
                          CACHE(1,IC) = FSEG
                          CACHE(2,IC) = XPOINT
                          CACHE(3,IC) = J
                          CACHE(4,IC) = WORLD(J)
                        ELSE
*                         Cache overflow.
                          OVERFL = .TRUE.
                        END IF
                      END IF

                      IF (TCODE(J,FSEG).GT.0) THEN
*                       Just want tick marks.
                        X1 = XR(NP)
                        Y1 = YR(NP)
                        X2 = XR(NP-1)
                        Y2 = YR(NP-1)
                        S = (XSCL*(X2-X1))**2 + (YSCL*(Y2-Y1))**2
                        S = SQRT(S)/TCODE(J,FSEG)
                        IF (MAJOR) S = S/1.5
                        XR(NP-1) = X1 + (X2-X1)*TIKLEN/S
                        YR(NP-1) = Y1 + (Y2-Y1)*TIKLEN/S
                      END IF

*                     Flush buffer.
                      IF (TCODE(J,FSEG).NE.0) THEN
                        CALL PGLINE(NP, XR, YR)
                      END IF
                      NP = 0
                    END IF
                  ELSE
*                   The previous point was also outside.
                    XR(NP) = X2
                    YR(NP) = Y2
                  END IF
                END IF
              END IF

              PREVIN = INSIDE
              LABLOK = IERR.NE.-J .AND. IERR.NE.-3

              IF (CONTRL.EQ.0) THEN
                GO TO 100
              ELSE IF (CONTRL.EQ.1) THEN
*               Flush buffer.
                IF (NP.GT.1) CALL PGLINE(NP, XR, YR)
                NP = 0
              END IF
 90         CONTINUE
 100      CONTINUE

          IF (NP.GT.1) CALL PGLINE(NP, XR, YR)
 110    CONTINUE
 120  CONTINUE

      IERR = 0
      IF (OVERFL) IERR = 3


*  Produce axis labels.
 130  IF (LABCTL.NE.-1) CALL PGCRLB (BLC, TRC, IDENTS, FTYPE, LABCTL,
     :  CJ, NC, IC, CACHE)

*     Restore the original viewport, window and pen colour.
 999  CALL PGSVP (XVP1, XVP2, YVP1, YVP2)
      CALL PGSWIN (WXY(1), WXY(2), WXY(3), WXY(4))
      CALL PGSCI (CI0)

      RETURN
      END



*=======================================================================
*
* PGCRLB is a helper routine for PGSBOX, not meant to be called directly
* since it expects the viewport and window to be scaled to the full
* extent; it labels a curvilinear coordinate grid.
*
* Given:
*   BLC       R(2)      Cartesian coordinates of the bottom left-hand
*                       corner.
*   TRC       R(2)      Cartesian coordinates of the top right-hand
*                       corner.
*
*   IDENTS    C(3)*(*)  Identification strings (see PGSBOX).
*
*   FTYPE     C(2)*1    Axis types, used for axis labelling (see
*                       PGSBOX).
*
*   LABCTL    I         Decimal encoded grid labelling control (see
*                       PGSBOX).
*
*   CI        I(7)      Colour table (see PGSBOX).
*
* Given and/or returned:
*   NC        I         Upper array index for CACHE.
*
*   IC        I         Current number of entries in the CACHE table.
*
*   CACHE     D(4,0:NC) Table of points where the tick marks or grid
*                       lines cross the frame (see PGSBOX).
*
* Author: Mark Calabretta, Australia Telescope National Facility
*=======================================================================
      SUBROUTINE PGCRLB (BLC, TRC, IDENTS, FTYPE, LABCTL, CI, NC, IC,
     :                   CACHE)
*-----------------------------------------------------------------------
      LOGICAL   ANGLE, DODEG, DOMIN, DOYEAR, LFORCE, SEXA(2), TICKIT
      INTEGER   CI(7), DOLAB(4), EDGE, EDJE, IC, ID, ID2, IM, IM2,
     :          IMAG(2), ITER, IWRLD, IY, IY2, J, JC, K, K1, K2, KWRLD,
     :          L, LABCTL, LD, LM, LMAG(2), LS, LV, M, M1, M2, MM, NC,
     :          NCH, NI(2,0:4), NLAB, NLABS(2,-2:6), NSWAP, PP,
     :          PRVDEG(2), PRVMIN(2), PRVEDG, PRVYR(2), SEXSUP(2),
     :          SKOP(4)
      REAL      ANGL, BLC(2), FJUST, BNDRY(4), OMAG(2), SI(2), TRC(2),
     :          X, XBOX(4), XCH, XL, XW1, XW2, Y, YCH, YBOX(4), YL, YW1,
     :          YW2, Z
      DOUBLE PRECISION CACHE(4,0:NC), MJD1(2), MJD2(2), TMP, VS
      CHARACTER ESCAPE*1, EXPONT*20, FMT*8, IDENTS(3)*(*), TEXT*80,
     :          FTYPE(2)*1, TXT(2)*80

      DATA ESCAPE /'\\'/

*     These are to stop compiler messages about uninitialized variables.
      DATA DODEG, DOMIN, DOYEAR /3 * .FALSE./
      DATA XL, YL /2 * -999.0/
*-----------------------------------------------------------------------
*  Normalize angular table entries.
      IF (INDEX('ABDEGH',FTYPE(1)).NE.0 .OR.
     :    INDEX('ABDEGH',FTYPE(2)).NE.0) THEN
        DO 10 J = 1, IC
          IWRLD = NINT(CACHE(3,J))

          IF (INDEX('ADG', FTYPE(IWRLD)).NE.0) THEN
            CACHE(4,J) = MOD(CACHE(4,J), 360D0)
            IF (CACHE(4,J).LT.0D0) CACHE(4,J) = CACHE(4,J) + 360D0
          ELSE IF (INDEX('BEH', FTYPE(IWRLD)).NE.0) THEN
            CACHE(4,J) = MOD(CACHE(4,J), 360D0)
            IF (CACHE(4,J).LE.-180D0) THEN
              CACHE(4,J) = CACHE(4,J) + 360D0
            ELSE IF (CACHE(4,J).GT.180D0) THEN
              CACHE(4,J) = CACHE(4,J) - 360D0
            END IF
          END IF

          IF (INDEX('GHI', FTYPE(IWRLD)).NE.0) THEN
*           Angle expressed as time.
            CACHE(4,J) = CACHE(4,J)/15D0
          END IF
 10     CONTINUE
      END IF


*  Reorganize the table entries.
*     Sort crossings for each of the four frame segments.
      DO 40 ITER = 1, IC
        NSWAP = 0
        DO 30 J = 1, IC-1
          IF (CACHE(1,J).LT.CACHE(1,J+1)) GO TO 30
          IF (CACHE(1,J).EQ.CACHE(1,J+1) .AND.
     :        CACHE(2,J).LE.CACHE(2,J+1)) GO TO 30

          NSWAP = NSWAP + 1
          DO 20 M = 1, 4
            TMP = CACHE(M,J)
            CACHE(M,J) = CACHE(M,J+1)
            CACHE(M,J+1) = TMP
 20       CONTINUE
 30     CONTINUE
        IF (NSWAP.EQ.0) GO TO 50
 40   CONTINUE

*     Squeeze out duplicates.
 50   JC = IC
      DO 90 J = 2, IC
        IF (J.GT.JC) GO TO 100

        DO 60 M = 1, 4
          IF (CACHE(M,J).NE.CACHE(M,J-1)) GO TO 90
 60     CONTINUE

*       This entry is the same as the previous one.
        JC = JC - 1
        DO 80 K = J, JC
          DO 70 M = 1, 4
            CACHE(M,K) = CACHE(M,K+1)
 70       CONTINUE
 80     CONTINUE
 90   CONTINUE

 100  IC = JC


* How do we label the edges of the frame?
*     Determine separability indices.
      NI(1,0) = 0
      NI(1,1) = 0
      NI(1,2) = 0
      NI(1,3) = 0
      NI(1,4) = 0
      NI(2,0) = 0
      NI(2,1) = 0
      NI(2,2) = 0
      NI(2,3) = 0
      NI(2,4) = 0
      DO 110 J = 1, IC
        IWRLD = NINT(CACHE(3,J))
        EDGE  = NINT(CACHE(1,J))

        NI(IWRLD,0) = NI(IWRLD,0) + 1
        NI(IWRLD,EDGE) = NI(IWRLD,EDGE) + 1
 110  CONTINUE

      SI(1) = 0.0
      SI(2) = 0.0
      IF (NI(1,0).GT.0) SI(1) = 2.0*REAL(NI(1,1)+NI(1,3))/NI(1,0) - 1.0
      IF (NI(2,0).GT.0) SI(2) = 2.0*REAL(NI(2,1)+NI(2,3))/NI(2,0) - 1.0

*     Which coordinates go on which edges?
      IF (LABCTL.GT.0) THEN
*       User-defined.
        L = LABCTL
      ELSE
*       Work it out ourselves.
        L = 0
        IF (ABS(SI(1)-SI(2)).GT.1.0) THEN
*         Approximately horizontal/vertical grid lines.
          IF (SI(1).GT.SI(2)) THEN
*           First world coordinate with vertical grid lines.
            IF (NI(1,1).GT.3 .OR. NI(1,1).GE.NI(1,3)) THEN
*             Label bottom of frame.
              L = L + 1
            ELSE
*             Label top of frame.
              L = L + 100
            END IF

*           Second world coordinate with horizontal grid lines.
            IF (NI(2,2).GT.3 .OR. NI(2,2).GE.NI(2,4)) THEN
*             Label left side of frame.
              L = L + 20
            ELSE
*             Label right side of frame.
              L = L + 2000
            END IF
          ELSE
*           First world coordinate with horizontal grid lines.
            IF (NI(1,2).GT.3 .OR. NI(1,2).GE.NI(1,4)) THEN
*             Label left side of frame.
              L = L + 10
            ELSE
*             Label right side of frame.
              L = L + 1000
            END IF

*           Second world coordinate with vertical grid lines.
            IF (NI(2,1).GT.3 .OR. NI(2,1).GE.NI(2,3)) THEN
*             Label bottom of frame.
              L = L + 2
            ELSE
*             Label top of frame.
              L = L + 200
            END IF
          END IF
        ELSE
*         Skew grid lines or worse.
          IF (SI(1).GT.0.5D0) THEN
*           First world coordinate with vertical grid lines.
            IF (NI(1,1).GT.3 .OR. NI(1,1).GT.NI(1,3)) THEN
              L = 1
            ELSE
              L = 100
            END IF

            IF (SI(2).GT.0.5D0) THEN
*             Second world coordinate also with vertical grid lines.
              IF (L.EQ.1) THEN
                L = 201
              ELSE
                IF (NI(2,1).GT.1 .OR. NI(2,1).GT.NI(2,3)) THEN
                  L = 102
                ELSE
                  L = 300
                END IF
              END IF
            ELSE
*             Second world coordinate with diagonal grid lines.
              L = L + 2020
            END IF
          ELSE IF (SI(1).LT.-0.5D0) THEN
*           First world coordinate with horizontal grid lines.
            IF (NI(1,2).GT.3 .OR. NI(1,2).GT.NI(1,4)) THEN
              L = 10
            ELSE
              L = 1000
            END IF

            IF (SI(2).LT.-0.5D0) THEN
*             Second world coordinate also with horizontal grid.
              IF (L.EQ.10) THEN
                L = 2010
              ELSE
                IF (NI(2,2).GT.1 .OR. NI(2,2).GT.NI(2,4)) THEN
                  L = 1020
                ELSE
                  L = 3000
                END IF
              END IF
            ELSE
*             Second world coordinate with diagonal grid lines.
              L = L + 202
            END IF
          ELSE IF (SI(2).GT.0.5D0) THEN
*           Second world coordinate with vertical grid lines.
            IF (NI(2,1).GT.3 .OR. NI(2,1).GT.NI(2,3)) THEN
              L = 1012
            ELSE
              L = 1210
            END IF
          ELSE IF (SI(2).LT.-0.5D0) THEN
*           Second world coordinate with horizontal grid lines.
            IF (NI(2,2).GT.3 .OR. NI(2,2).GT.NI(2,4)) THEN
              L = 121
            ELSE
              L = 2101
            END IF
          ELSE
*           Desperation stakes!  Label all four axes.
            K1 = NI(1,3) + NI(1,1)
            K2 = NI(2,4) + NI(2,2)
            L = 2121

            M1 = NI(1,4) + NI(1,1)
            M2 = NI(2,3) + NI(2,2)
            IF (M1.GE.K1 .AND. M2.GE.K2) THEN
              L  = 1221
              K1 = M1
              K2 = M2
            END IF

            M1 = NI(1,2) + NI(1,1)
            M2 = NI(2,4) + NI(2,3)
            IF (M1.GE.K1 .AND. M2.GE.K2) THEN
              L  = 2211
              K1 = M1
              K2 = M2
            END IF

            M1 = NI(1,4) + NI(1,2)
            M2 = NI(2,3) + NI(2,1)
            IF (M1.GE.K1 .AND. M2.GE.K2) THEN
              L  = 1212
              K1 = M1
              K2 = M2
            END IF

            M1 = NI(1,3) + NI(1,2)
            M2 = NI(2,4) + NI(2,1)
            IF (M1.GE.K1 .AND. M2.GE.K2) THEN
              L  = 2112
              K1 = M1
              K2 = M2
            END IF

            M1 = NI(1,4) + NI(1,3)
            M2 = NI(2,2) + NI(2,1)
            IF (M1.GE.K1 .AND. M2.GE.K2) THEN
              L  = 1122
              K1 = M1
              K2 = M2
            END IF
          END IF
        END IF
      END IF

*     Mark labels as unwanted by setting their edges negative.
      DOLAB(1) = MOD(L,10)
      DOLAB(2) = MOD(L/10,10)
      DOLAB(3) = MOD(L/100,10)
      DOLAB(4) = MOD(L/1000,10)
      DO 120 J = 1, IC
        EDGE  = NINT(CACHE(1,J))
        IWRLD = NINT(CACHE(3,J))
        IF (IWRLD.EQ.1) THEN
          IF (MOD(DOLAB(EDGE),2).NE.1) CACHE(1,J) = -EDGE
        ELSE
          IF (MOD(DOLAB(EDGE)/2,2).NE.1) CACHE(1,J) = -EDGE
        END IF
 120  CONTINUE


*  Determine labelling precision.
*     Order of magnitude for plain numeric world coordinates.
      IMAG(1) = 0
      IMAG(2) = 0

      IF (FTYPE(1).EQ.' ' .OR. FTYPE(2).EQ.' ') THEN
        OMAG(1) = 0.0
        OMAG(2) = 0.0
        DO 130 J = 1, IC
          IWRLD = NINT(CACHE(3,J))
          IF (FTYPE(IWRLD).EQ.' ') THEN
*           Plain numeric.
            IF (CACHE(4,J).EQ.0D0) GO TO 130
            OMAG(IWRLD) = OMAG(IWRLD) + LOG10(ABS(CACHE(4,J)))
            IMAG(IWRLD) = IMAG(IWRLD) + 1
          END IF
 130    CONTINUE

        IF (IMAG(1).GT.0) IMAG(1) = INT(OMAG(1)/IMAG(1))
        IF (IMAG(1).GE.-2 .AND. IMAG(1).LE.4) IMAG(1) = 0

        IF (IMAG(2).GT.0) IMAG(2) = INT(OMAG(2)/IMAG(2))
        IF (IMAG(2).GE.-2 .AND. IMAG(2).LE.4) IMAG(2) = 0

*       Renormalize grid values.
        IF (IMAG(1).NE.0 .OR. IMAG(2).NE.0) THEN
          DO 140 J = 1, IC
            IWRLD = NINT(CACHE(3,J))
            CACHE(4,J) = CACHE(4,J)/10D0**IMAG(IWRLD)
 140      CONTINUE
        END IF
      END IF

*     Sexagesimal labelling.
      SEXA(1) = INDEX('DEFGHITy', FTYPE(1)).NE.0
      SEXA(2) = INDEX('DEFGHITy', FTYPE(2)).NE.0

      IF (SEXA(1) .OR. SEXA(2)) THEN
        DO 150 K = -2, 6
          NLABS(1,K) = 0
          NLABS(2,K) = 0
 150    CONTINUE

        DO 180 J = 1, IC
*         Use this label?
          EDGE = NINT(CACHE(1,J))
          IF (EDGE.LT.0) GO TO 180

*         Skip non-sexagesimal coordinates.
          IWRLD = NINT(CACHE(3,J))
          IF (.NOT.SEXA(IWRLD)) GO TO 180

*         Defeat rounding errors.
          IF (FTYPE(IWRLD).EQ.'y') THEN
            TMP = ABS(MOD(CACHE(4,J),1D0)*86400D0) + 5D-7
          ELSE
            TMP = ABS(CACHE(4,J)*3600D0) + 5D-7
          END IF

          LV = INT(MOD(TMP, 1D0)*1D6)
          IF (LV.NE.0) THEN
*           Sub-arcsec/second resolution.
            M = 1
            DO 160 K = 1, 6
              M = M*10
              IF (MOD(LV,M).NE.0) THEN
                L = 7 - K
                GO TO 170
              END IF
 160        CONTINUE
          ELSE
            LS = INT(TMP)
            IF (MOD(LS,60).NE.0) THEN
              L =  0
            ELSE IF (MOD(LS,3600).NE.0) THEN
              L = -1
            ELSE
              L = -2
            END IF
          END IF

*         Use CACHE(1,J) temporarily to hold L.
 170      NLABS(IWRLD,L) = NLABS(IWRLD,L) + 1
          CACHE(1,J) = CACHE(1,J) + 0.1 + L/100.0
 180    CONTINUE

*       How many fields are needed to get enough labels?
        DO 200 IWRLD = 1, 2
          NLAB = 0
          DO 190 K = -2, 6
            NLAB = NLAB + NLABS(IWRLD,K)
            IF (NLAB.GT.3 .OR. K.EQ.6) THEN
              LMAG(IWRLD) = K
              GO TO 200
            END IF
            NLABS(IWRLD,K+1) = NLABS(IWRLD,K) + NLABS(IWRLD,K+1)
 190      CONTINUE
 200    CONTINUE

*       Disable unwanted labels.
        DO 210 J = 1, IC
*         Use this label?
          EDGE = NINT(CACHE(1,J))
          IF (EDGE.LT.0) GO TO 210

*         Skip non-sexagesimal coordinates.
          IWRLD = NINT(CACHE(3,J))
          IF (.NOT.SEXA(IWRLD)) GO TO 210

          L = NINT(100*MOD(CACHE(1,J),1.0)) - 10
          IF (L.LE.LMAG(IWRLD)) THEN
*           Wanted.
            CACHE(1,J) = EDGE
          ELSE
*           Not wanted.
            CACHE(1,J) = -EDGE
          END IF
 210    CONTINUE
      END IF


*  Produce labels.
      XW1 = BLC(1)
      XW2 = TRC(1)
      YW1 = BLC(2)
      YW2 = TRC(2)

*     These will define a box that just contains the labels.
      BNDRY(1) = YW1
      BNDRY(2) = XW1
      BNDRY(3) = YW2
      BNDRY(4) = XW2

*     These will record the edges on which labels were actually written.
      SKOP(1) = 0
      SKOP(2) = 0
      SKOP(3) = 0
      SKOP(4) = 0

*     Calendar date range.
      MJD1(1) =  1D99
      MJD1(2) =  1D99
      MJD2(1) = -1D99
      MJD2(2) = -1D99

*     Character height.
      CALL PGQCS (4, XCH, YCH)
      PRVEDG = 0

*     Loop through the axis crossing table.
      DO 340 J = 1, IC
*       Determine the position.
        IWRLD = NINT(CACHE(3,J))
        CALL PGSCI (CI(IWRLD+2))

        EDGE = ABS(NINT(CACHE(1,J)))
        IF (EDGE.NE.PRVEDG) THEN
*         Start of new edge.

          IF (SEXA(1) .OR. SEXA(2)) THEN
*           Sexagesimal field suppression policy.
            PRVDEG(1) = -1
            PRVMIN(1) = -1
            PRVDEG(2) = -1
            PRVMIN(2) = -1

            SEXSUP(1) = 0
            SEXSUP(2) = 0

*           Vertical sides.
            IF (MOD(EDGE,2).EQ.0) THEN
              DO 220 K = J, IC
                EDJE = ABS(NINT(CACHE(1,K)))
                IF (EDJE.NE.EDGE) GO TO 230

                KWRLD = NINT(CACHE(3,K))
                IF (SEXSUP(KWRLD).EQ.1) GO TO 220

                IF (FTYPE(KWRLD).EQ.'y') THEN
                  TMP = ABS(MOD(CACHE(4,K),1D0)*24D0)
                ELSE
                  TMP = ABS(CACHE(4,K))
                END IF

                LV = INT(TMP*3600D0 + 5D-7)
                LD =  LV/3600
                LM = (LV - LD*3600)/60
                LS =  LV - LD*3600 - LM*60
                TMP = TMP - LD

                IF (TMP.LT.5D-7) THEN
*                 Write deg/hr field only when min/sec are zero.
                  SEXSUP(KWRLD) = 1
                ELSE IF (TMP*60-LM.LT.3D-5) THEN
*                 Write min field only when sec is zero; only
*                 write the deg/hr field when min is written.
                  SEXSUP(KWRLD) = 2
                END IF
 220          CONTINUE
            END IF
          END IF
 230      CONTINUE

          PRVYR(1) = -1
          PRVYR(2) = -1

          XL = -999.0
          YL = -999.0
        END IF
        PRVEDG = EDGE
        LFORCE = .FALSE.

*       Fix up edge encoding.
        EDGE = NINT(CACHE(1,J))
        CACHE(1,J) = ABS(EDGE)

*       Use this label?
        IF (EDGE.LT.0) GO TO 340

        IF (EDGE.EQ.1) THEN
*         Bottom.
          FJUST = 0.5
          X = CACHE(2,J)
          Y = YW1 - 1.5*YCH
        ELSE IF (EDGE.EQ.2) THEN
*         Left.
          FJUST = 1.0
          X = XW1 - 0.5*XCH
          Y = CACHE(2,J) - YCH/2.0
        ELSE IF (EDGE.EQ.3) THEN
*         Top.
          FJUST = 0.5
          X = CACHE(2,J)
          Y = YW2 + 0.5*YCH
        ELSE IF (EDGE.EQ.4) THEN
*         Right.
          FJUST = 0.0
          X = XW2 + 0.5*XCH
          Y = CACHE(2,J) - YCH/2.0
        END IF

*       Format the numeric label.
        IF (INDEX('ABC', FTYPE(IWRLD)).NE.0) THEN
*         Decimal angle; allow up to 6 decimal digits.
          TMP = ABS(CACHE(4,J)) + 5D-7
          LD  = INT(TMP)

          K = 1
          IF (CACHE(4,J).LT.0D0) THEN
*           Insert a minus sign.
            TEXT(1:1) = '-'
            K = 2
          END IF

          CALL PGNUMB (LD, 0, 1, TEXT(K:), NCH)
          K = K + NCH
          TEXT(K:) = ESCAPE // 'uo' // ESCAPE // 'd'
          K = K + 4

          LV = INT(MOD(TMP,1D0)*1D6)
          IF (LV.NE.0) CALL PGNUMB (LV, -6, 1, TEXT(K:), NCH)
          TEXT(K:K) = 'd'

        ELSE IF (SEXA(IWRLD)) THEN
*         Sexagesimal format; angle or time?
          ANGLE = INDEX('DEF', FTYPE(IWRLD)).NE.0
          L = LMAG(IWRLD)

*         Use integer arithmetic to avoid rounding problems.
          IF (FTYPE(IWRLD).EQ.'y') THEN
            TMP = ABS(MOD(CACHE(4,J),1D0)*24D0)

*           Determine date range.
            IF (CACHE(4,J).LT.MJD1(IWRLD)) MJD1(IWRLD) = CACHE(4,J)
            IF (CACHE(4,J).GT.MJD2(IWRLD)) MJD2(IWRLD) = CACHE(4,J)
          ELSE
            TMP = ABS(CACHE(4,J))
          END IF
          VS = TMP*3600D0 + 5D-7
          LV = INT(VS)

*         Sexagesimal fields.
          LD =  LV/3600
          LM = (LV - LD*3600)/60
          LS =  LV - LD*3600 - LM*60

*         Field suppression policy.
          IF (SEXSUP(IWRLD).GT.0) THEN
            TMP = TMP - LD

            IF (TMP.LT.5D-7) THEN
              DODEG = .TRUE.
              DOMIN = .TRUE.
            ELSE IF (SEXSUP(IWRLD).EQ.2) THEN
              DOMIN = TMP*60-LM.LT.3D-5
              DODEG = DOMIN .AND. LD.NE.PRVDEG(IWRLD)
            ELSE
              DODEG = .FALSE.
              DOMIN = .FALSE.
            END IF
          ELSE
            DODEG = LD.NE.PRVDEG(IWRLD)
            DOMIN = LM.NE.PRVMIN(IWRLD)
          END IF

          K = 1
          IF (L.EQ.-2 .OR. DODEG) THEN
*           Write the degree/hour field.
            DODEG = .TRUE.

            IF (CACHE(4,J).LT.0D0) THEN
*             Insert a minus sign.
              TEXT(1:1) = '-'
              K = 2
            END IF

            IF (ANGLE) THEN
*             Angle.
              CALL PGNUMB (LD, 0, 1, TEXT(K:), NCH)
              K = K + NCH
              TEXT(K:) = ESCAPE // 'uo' // ESCAPE // 'd'
              K = K + 5
            ELSE
*             Time.
              IF (LD.LE.9 .AND. INDEX('Ty',FTYPE(IWRLD)).EQ.0) THEN
*               Write leading zeroes in the hour field.
                WRITE (TEXT(K:), '(I2.2)') LD
                K = K + 2
              ELSE
                CALL PGNUMB (LD, 0, 1, TEXT(K:), NCH)
                K = K + NCH
              END IF
              TEXT(K:) = ESCAPE // 'uh' // ESCAPE // 'd'
              K = K + 5
            END IF
          END IF

          IF (L.GE.-1 .AND.
     :      .NOT.(L.LE.0 .AND. K.GT.1 .AND. LM.EQ.0 .AND. LS.EQ.0)) THEN
*           Write arcminute/minute field.
            IF (L.EQ.-1 .OR. K.GT.1 .OR. DOMIN) THEN
              DOMIN = .TRUE.
              IF (ANGLE) THEN
                WRITE (TEXT(K:), '(I2.2,A)') LM, ''''
                K = K + 3
              ELSE
                WRITE (TEXT(K:), '(I2.2,A)') LM,
     :            ESCAPE // 'um' // ESCAPE // 'd'
                K = K + 7
              END IF
            END IF

            IF (L.GE.0) THEN
*             Arcsec/second field.
              IF (ANGLE) THEN
                WRITE (TEXT(K:), '(I2.2,A)') LS, '"'
                K = K + 3
              ELSE
                WRITE (TEXT(K:), '(I2.2,A)') LS,
     :            ESCAPE // 'us' // ESCAPE // 'd'
                K = K + 7
              END IF

              IF (L.GT.0) THEN
*               Sub-arcsec/second field.
                WRITE (FMT, '(A,I1,A,I1,A)') '(A,I', L, '.', L, ')'
                LV = INT(MOD(VS,1D0)*10**L)
                WRITE (TEXT(K:), FMT) '.', LV
              END IF
            END IF
          END IF

        ELSE IF (FTYPE(IWRLD).EQ.'L') THEN
*         Logarithmic.
          TMP = MOD(CACHE(4,J),1D0)
          IF (TMP.LT.0D0) TMP = TMP + 1D0
          MM = NINT(10D0**TMP)
          IF (MM.EQ.10) THEN
            TMP = TMP - 1D0
            MM = 1
          END IF

          PP = NINT(CACHE(4,J) - TMP)

          IF (MM.NE.1) THEN
            WRITE (TEXT, '(I1)') MM
          ELSE
*           FORTRAN is really abysmal sometimes.
            WRITE (TEXT, '(I8)') PP
            DO 240 K = 1, 8
              IF (TEXT(K:K).NE.' ') GO TO 250
 240        CONTINUE
 250        TEXT = '10' // ESCAPE // 'u' // TEXT(K:8)

            LFORCE = .TRUE.
          END IF

        ELSE IF (FTYPE(IWRLD).EQ.'Y') THEN
*         Convert MJD to Gregorian calendar date, YYYY/MM/DD.
          CALL PGMJD(0, CACHE(4,J), IY, IM, ID)
          DOYEAR = IY.NE.PRVYR(IWRLD)

          IF (DOYEAR) THEN
            WRITE (TEXT, 260) IY, IM, ID
 260        FORMAT (I12,'/',I2.2,'/',I2.2)

            DO 270 K = 1, 12
              IF (TEXT(K:K).NE.' ') GO TO 280
 270        CONTINUE
 280        TEXT = TEXT(K:18)

          ELSE
            WRITE (TEXT, 290) IM, ID
 290        FORMAT (I2.2,'/',I2.2)
          END IF

        ELSE
*         Plain number; allow up to six significant digits.
          IF (CACHE(4,J).NE.0D0) THEN
            PP = INT(LOG10(ABS(CACHE(4,J)))) - 6
            MM = NINT(CACHE(4,J)/10D0**PP)
          ELSE
            PP = 0
            MM = 0
          END IF

          CALL PGNUMB (MM, PP, 0, TEXT, NCH)
        END IF

*       Write the label if it doesn't overlap the previous one.
        CALL PGQTXT (X, Y, 0.0, FJUST, TEXT, XBOX, YBOX)
        IF (LFORCE .OR. XBOX(1).GT.XL .OR. YBOX(1).GT.YL) THEN
          IF (IWRLD.EQ.1) THEN
            CALL PGSCI (CI(3))
          ELSE
            CALL PGSCI (CI(4))
          END IF

          CALL PGPTXT (X, Y, 0.0, FJUST, TEXT)
          XL = XBOX(4) + 0.5*XCH
          YL = YBOX(2) + 0.5*YCH

*         Sexagesimal formatting.
          IF (SEXA(IWRLD)) THEN
            IF (DODEG) PRVDEG(IWRLD) = LD
            IF (DOMIN) PRVMIN(IWRLD) = LM
          END IF

*         Calendar formatting.
          IF (FTYPE(IWRLD).EQ.'Y') THEN
            IF (DOYEAR) PRVYR(IWRLD) = IY
          END IF

*         Record the fact.
          IF (IWRLD.EQ.1) THEN
            SKOP(EDGE) = 2*(SKOP(EDGE)/2) + 1
          ELSE
            SKOP(EDGE) = 2 + MOD(SKOP(EDGE),2)
          END IF

*         Boundary within which the numeric labels lie.
          IF (YBOX(1).LT.BNDRY(1)) BNDRY(1) = YBOX(1)
          IF (XBOX(1).LT.BNDRY(2)) BNDRY(2) = XBOX(1)
          IF (YBOX(3).GT.BNDRY(3)) BNDRY(3) = YBOX(3)
          IF (XBOX(3).GT.BNDRY(4)) BNDRY(4) = XBOX(3)

*         Check the distance to the previous grid line.
          TICKIT = .FALSE.
          K = J - 1
          IF (DOLAB(EDGE).NE.3) THEN
*           Only one coordinate element labelled on this edge, no need
*           to worry about grid lines belonging to the other.
            DO 300 K = J-1, 1, -1
              IF (IWRLD.EQ.NINT(CACHE(3,K))) GO TO 310
 300        CONTINUE
          END IF

 310      IF (K.GE.1) THEN
            EDJE = ABS(NINT(CACHE(1,K)))
            IF (EDJE.EQ.EDGE) THEN
              IF (EDGE.EQ.1 .OR. EDGE.EQ.3) THEN
                IF (XBOX(1).LT.CACHE(2,K)) TICKIT = .TRUE.
              ELSE
                IF (YBOX(1).LT.CACHE(2,K)) TICKIT = .TRUE.
              END IF
            END IF
          END IF

*         Check the distance to the next grid line.
          K = J + 1
          IF (DOLAB(EDGE).NE.3) THEN
*           Only one coordinate element labelled on this edge, no need
*           to worry about grid lines belonging to the other.
            DO 320 K = J+1, IC
              IF (IWRLD.EQ.NINT(CACHE(3,K))) GO TO 330
 320        CONTINUE
          END IF

 330      IF (K.LE.IC) THEN
            EDJE = ABS(NINT(CACHE(1,K)))
            IF (EDJE.EQ.EDGE) THEN
              IF (EDGE.EQ.1 .OR. EDGE.EQ.3) THEN
                IF (XBOX(3).GT.CACHE(2,K)) TICKIT = .TRUE.
              ELSE
                IF (YBOX(3).GT.CACHE(2,K)) TICKIT = .TRUE.
              END IF
            END IF
          END IF

*         Density of grid lines is high.
          IF (TICKIT) THEN
*           Draw outside pip mark to disambiguate grid lines.
            Z = REAL(CACHE(2,J))
            IF (EDGE.EQ.1) THEN
              CALL PGMOVE (Z, YW1-0.3*YCH)
              CALL PGDRAW (Z, YW1)
            ELSE IF (EDGE.EQ.2) THEN
              CALL PGMOVE (XW1-0.3*XCH, Z)
              CALL PGDRAW (XW1, Z)
            ELSE IF (EDGE.EQ.3) THEN
              CALL PGMOVE (Z, YW2+0.3*YCH)
              CALL PGDRAW (Z, YW2)
            ELSE IF (EDGE.EQ.4) THEN
              CALL PGMOVE (XW2+0.3*XCH, Z)
              CALL PGDRAW (XW2, Z)
            END IF
          END IF
        END IF
 340  CONTINUE


*  Write the identification strings.
*     World coordinates.
      DO 470 EDGE = 1, 4
        TEXT = ' '

        DO 440 IWRLD = 1, 2
          TXT(IWRLD) = ' '

          IF (MOD(SKOP(EDGE)/IWRLD,2).EQ.0) GO TO 440

*         Strip off leading blanks.
          L = LEN(IDENTS(IWRLD))
          DO 350 K = 1, L
            IF (IDENTS(IWRLD)(K:K).NE.' ') THEN
              TXT(IWRLD) = IDENTS(IWRLD)(K:L)
              GO TO 360
            END IF
 350      CONTINUE

 360      IF (IMAG(IWRLD).NE.0 .OR. FTYPE(IWRLD).EQ.'y') THEN
*           Find the last non-blank.
            DO 370 K = 40, 1, -1
              IF (TXT(IWRLD)(K:K).NE.' ') GO TO 380
 370        CONTINUE
 380        K = K + 1

            IF (IMAG(IWRLD).NE.0) THEN
*             Add scaling information.
              CALL PGNUMB (IMAG(IWRLD), 0, 1, EXPONT, NCH)
              TXT(IWRLD)(K:) = '  x10' // ESCAPE // 'u' // EXPONT
            ELSE
*             Add calendar date range.
              CALL PGMJD(0, MJD1(IWRLD), IY, IM, ID)

              WRITE (TEXT, 390) IY, IM, ID
 390          FORMAT (I12,'/',I2.2,'/',I2.2)
              DO 400 L = 1, 12
                IF (TEXT(L:L).NE.' ') GO TO 410
 400          CONTINUE
 410          TXT(IWRLD)(K:) = ' (' // TEXT(L:18)
              K = K + 21 - L

              CALL PGMJD(0, MJD2(IWRLD), IY2, IM2, ID2)
              WRITE (TEXT, 390) IY2, IM2, ID2
              IF (IY2.EQ.IY) THEN
                IF (IM2.EQ.IM) THEN
                  IF (ID2.EQ.ID) THEN
                    TXT(IWRLD)(K:) = ')'
                  ELSE
                    TXT(IWRLD)(K:) = ' - ' // TEXT(17:18) // ')'
                  END IF
                ELSE
                  TXT(IWRLD)(K:) = ' - ' // TEXT(14:18) // ')'
                END IF
              ELSE
                DO 420 L = 1, 12
                  IF (TEXT(L:L).NE.' ') GO TO 430
 420            CONTINUE
 430            TXT(IWRLD)(K:) = ' - ' // TEXT(L:18) // ')'
              END IF
            END IF
          END IF

 440    CONTINUE

        K = 0
        IF (TXT(1).NE.' ') THEN
*         Identify first world coordinate...
          TEXT = TXT(1)
          CALL PGSCI (CI(5))

          IF (TXT(2).NE.' ') THEN
*           ...and also second world coordinate.
            DO 450 K = 40, 1, -1
              IF (TEXT(K:K).NE.' ') GO TO 460
 450        CONTINUE
 460        K = K + 1

            TEXT(K:) = ',  ' // TXT(2)
          END IF
        ELSE IF (TXT(2).NE.' ') THEN
*         Identify second world coordinate only.
          TEXT = TXT(2)
          CALL PGSCI (CI(6))
        ELSE
*         No text to write.
          GO TO 470
        END IF

        IF (EDGE.EQ.1) THEN
          X = (XW1 + XW2)/2.0
          Y = BNDRY(1) - 1.5*YCH
          ANGL = 0.0
        ELSE IF (EDGE.EQ.2) THEN
          IF (TEXT(2:).EQ.' ') THEN
*           One character, write upright.
            X = BNDRY(2) - 1.0*XCH
            Y = (YW1 + YW2)/2.0
            ANGL = 0.0
          ELSE
            X = BNDRY(2) - 0.5*XCH
            Y = (YW1 + YW2)/2.0
            ANGL = 90.0
          END IF
        ELSE IF (EDGE.EQ.3) THEN
          X = (XW1 + XW2)/2.0
          Y = BNDRY(3) + 0.5*YCH
          ANGL = 0.0
        ELSE IF (EDGE.EQ.4) THEN
          IF (TEXT(2:).EQ.' ') THEN
*           One character, write upright.
            X = BNDRY(4) + 1.0*XCH
            Y = (YW1 + YW2)/2.0
            ANGL = 0.0
          ELSE
            X = BNDRY(4) + 0.5*XCH
            Y = (YW1 + YW2)/2.0
            ANGL = -90.0
          END IF
        END IF

        CALL PGQTXT (X, Y, ANGL, 0.5, TEXT, XBOX, YBOX)
        IF (K.EQ.0) THEN
          CALL PGPTXT (X, Y, ANGL, 0.5, TEXT)
        ELSE
*         Two-colour annotation.
          CALL PGPTXT (XBOX(1), YBOX(1), ANGL, 0.0, TEXT(:K))
          CALL PGSCI (CI(6))
          CALL PGPTXT (XBOX(4), YBOX(4), ANGL, 1.0, TEXT(K+1:))
        END IF

*       Update the boundary.
        IF (YBOX(1).LT.BNDRY(1)) BNDRY(1) = YBOX(1)
        IF (YBOX(3).LT.BNDRY(1)) BNDRY(1) = YBOX(3)
        IF (XBOX(1).LT.BNDRY(2)) BNDRY(2) = XBOX(1)
        IF (XBOX(3).LT.BNDRY(2)) BNDRY(2) = XBOX(3)
        IF (YBOX(1).GT.BNDRY(3)) BNDRY(3) = YBOX(1)
        IF (YBOX(3).GT.BNDRY(3)) BNDRY(3) = YBOX(3)
        IF (XBOX(1).GT.BNDRY(4)) BNDRY(4) = XBOX(1)
        IF (XBOX(3).GT.BNDRY(4)) BNDRY(4) = XBOX(3)
 470  CONTINUE

*     Title.
      IF (IDENTS(3).NE.' ') THEN
        CALL PGSCI (CI(7))
        X = (XW1 + XW2)/2.0
        Y = BNDRY(3) + 0.5*YCH
        CALL PGQTXT (X, Y, 0.0, 0.5, IDENTS(3), XBOX, YBOX)
        CALL PGPTXT (X, Y, 0.0, 0.5, IDENTS(3))

*       Update the boundary.
        IF (XBOX(1).LT.BNDRY(2)) BNDRY(2) = XBOX(1)
        IF (YBOX(3).GT.BNDRY(3)) BNDRY(3) = YBOX(3)
        IF (XBOX(3).GT.BNDRY(4)) BNDRY(4) = XBOX(3)
      END IF


*     Return margin widths in Cartesian coordinates.
      CACHE(1,NC) = YW1 - BNDRY(1)
      CACHE(2,NC) = XW1 - BNDRY(2)
      CACHE(3,NC) = BNDRY(3) - YW2
      CACHE(4,NC) = BNDRY(4) - XW2


      RETURN
      END


*=======================================================================
* MJD to/from Gregorian calendar date.
*
* Given:
*   CODE      I         If 1, compute MJD from IY,IM,ID, else vice
*                       versa.
*
* Given and/or returned:
*   MJD       D         Modified Julian date, (MJD = JD - 2400000.5).
*   IY        I         Year.
*   IM        I         Month (for CODE.EQ.1 may exceed 12, or be zero,
*                       or negative).
*   ID        I         Day of month (for CODE.EQ.1, may exceed the
*                       legitimate number of days in the month, or be
*                       zero, or negative).
*
* Notes:
*   These algorithms are from D.A. Hatcher, QJRAS 25, 53-55, as modified
*   by P.T. Wallace for use in SLALIB (subroutines CLDJ and DJCL).
*
*   Author: Mark Calabretta, Australia Telescope National Facility
*-----------------------------------------------------------------------
      SUBROUTINE PGMJD (CODE, MJD, IY, IM, ID)
*-----------------------------------------------------------------------
      INTEGER   CODE, DD, ID, IM, IY, JD, JM, JY, N4
      DOUBLE PRECISION MJD
*-----------------------------------------------------------------------
      IF (CODE.EQ.1) THEN
*       Calendar date to MJD.
        IF (IM.LT.1) THEN
          JY = IY - 1 + IM/12
          JM = 12 + MOD(IM,12)
        ELSE
          JY = IY + (IM-1)/12
          JM = MOD(IM-1,12) + 1
        END IF

        MJD =DBLE((1461*(JY - (12-JM)/10 + 4712))/4
     :          +(306*MOD(JM+9, 12) + 5)/10
     :          -(3*((JY - (12-JM)/10 + 4900)/100))/4
     :          + ID - 2399904)

      ELSE
*       MJD to calendar date.
        JD = 2400001 + INT(MJD)

        N4 =  4*(JD + ((2*((4*JD - 17918)/146097)*3)/4 + 1)/2 - 37)
        DD = 10*(MOD(N4-237, 1461)/4) + 5

        IY = N4/1461 - 4712
        IM = MOD(2 + DD/306, 12) + 1
        ID = MOD(DD, 306)/10 + 1
      END IF

      RETURN
      END



*=======================================================================
* This FORTRAN wrapper on PGSBOX exists solely to define fixed-length
* CHARACTER arguments for cpgsbox().
*
* Author: Mark Calabretta, Australia Telescope National Facility
*-----------------------------------------------------------------------
      SUBROUTINE PGSBOK (BLC, TRC, IDENTS, OPT, LABCTL, LABDEN, CI,
     :  GCODE, TIKLEN, NG1, GRID1, NG2, GRID2, DOEQ, NLFUNC, NLC, NLI,
     :  NLD, NLCPRM, NLIPRM, NLDPRM, NC, IC, CACHE, IERR)
*-----------------------------------------------------------------------
      LOGICAL   DOEQ
      INTEGER   CI(7), GCODE(2), IC, IERR, LABCTL, LABDEN, NC, NG1, NG2,
     :          NLC, NLD, NLI, NLIPRM(NLI)
      REAL      BLC(2), TRC(2)
      DOUBLE PRECISION CACHE(4,0:NC), GRID1(0:NG1), GRID2(0:NG2),
     :          NLDPRM(NLD), TIKLEN
      CHARACTER IDENTS(3)*80, NLCPRM(NLC)*1, OPT(2)*1

      EXTERNAL NLFUNC
*-----------------------------------------------------------------------
      CALL PGSBOX (BLC, TRC, IDENTS, OPT, LABCTL, LABDEN, CI, GCODE,
     :  TIKLEN, NG1, GRID1, NG2, GRID2, DOEQ, NLFUNC, NLC, NLI, NLD,
     :  NLCPRM, NLIPRM, NLDPRM, NC, IC, CACHE, IERR)

      RETURN
      END



*=======================================================================
* This FORTRAN wrapper on PGLBOX exists solely to define fixed-length
* CHARACTER arguments for cpglbox().
*
* Author: Mark Calabretta, Australia Telescope National Facility
*-----------------------------------------------------------------------
      SUBROUTINE PGLBOK (IDENTS, OPT, LABCTL, LABDEN, CI, GCODE, TIKLEN,
     :  NG1, GRID1, NG2, GRID2, DOEQ, NC, IC, CACHE, IERR)
*-----------------------------------------------------------------------
      LOGICAL   DOEQ
      INTEGER   CI(7), GCODE(2), IC, IERR, LABCTL, LABDEN, NC, NG1, NG2
      DOUBLE PRECISION CACHE(4,0:NC), GRID1(0:NG1), GRID2(0:NG2), TIKLEN
      CHARACTER IDENTS(3)*80, OPT(2)*1
*-----------------------------------------------------------------------
      CALL PGLBOX (IDENTS, OPT, LABCTL, LABDEN, CI, GCODE, TIKLEN, NG1,
     :  GRID1, NG2, GRID2, DOEQ, NC, IC, CACHE, IERR)

      RETURN
      END