SUBROUTINE PWRZI (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT) C C +-----------------------------------------------------------------+ C | | C | Copyright (C) 1986 by UCAR | C | University Corporation for Atmospheric Research | C | All Rights Reserved | C | | C | NCARGRAPHICS Version 1.00 | C | | C +-----------------------------------------------------------------+ C C C C C LATEST REVISION JULY, 1984 C C PURPOSE PWRZI IS A CHARACTER PLOTTING ROUTINE FOR C PLOTTING CHARACTERS IN THREE-SPACE WHEN USING C ISOSRF. FOR A LARGE CLASS OF C POSSIBLE POSITIONS, THE HIDDEN CHARACTER C PROBLEM IS SOLVED. C C PWRZI WILL NOT WORK WITH ISOSRFHR. C C C USAGE CALL PWRZI (X,Y,Z,ID,N,ISIZE,LINE,ITOP,ICNT) C USE CALL PWRZI AFTER CALLING C ISOSRF AND BEFORE CALLING FRAME. C C ARGUMENTS C C ON INPUT X,Y,Z C POSITIONING COORDINATES FOR THE CHARACTERS C TO BE DRAWN. THESE ARE FLOATING POINT C NUMBERS IN THE SAME THREE-SPACE AS USED IN C ISOSRF. C C ID C CHARACTER STRING TO BE DRAWN. ID IS OF TYPE C CHARACTER . C C N C THE NUMBER OF CHARACTERS IN ID. C C ISIZE C SIZE OF THE CHARACTER: C . IF BETWEEN 0 AND 3, ISIZE IS 1., 1.5, C 2., OR 3. TIMES A STANDARD WIDTH EQUAL C TO 1/128TH OF THE SCREEN WIDTH. C . IF GREATER THAN 3, ISIZE IS THE CHARACTER C WIDTH IN PLOTTER ADDRESS UNITS. C C LINE C THE DIRECTION IN WHICH THE CHARACTERS ARE TO C BE WRITTEN. C 1 = +X -1 = -X C 2 = +Y -2 = -Y C 3 = +Z -3 = -Z C C ITOP C THE DIRECTION FROM THE CENTER OF THE FIRST C CHARACTER TO THE TOP OF THE FIRST C CHARACTER (THE POTENTIAL VALUES FOR C ITOP ARE THE SAME AS THOSE FOR LINE AS C GIVEN ABOVE.) NOTE THAT LINE CANNOT C EQUAL ITOP EVEN IN ABSOLUTE VALUE. C C ICNT C CENTERING OPTION. C -1 (X,Y,Z) IS THE CENTER OF THE LEFT EDGE OF C THE FIRST CHARACTER. C 0 (X,Y,Z) IS THE CENTER OF THE ENTIRE C STRING. C 1 (X,Y,Z) IS THE CENTER OF THE RIGHT EDGE C OF THE LAST CHARACTER. C C ON OUTPUT ALL ARGUMENTS ARE UNCHANGED. C C NOTE THE HIDDEN CHARACTER PROBLEM IS SOLVED C CORRECTLY FOR CHARACTERS NEAR (BUT NOT INSIDE) C THE THREE-SPACE OBJECT. C C ENTRY POINTS PWRZI, INITZI, PWRZOI, PWRZGI C C COMMON BLOCKS PWRZ1I,PWRZ2I C C I/O PLOTS CHARACTER(S) C C PRECISION SINGLE C C REQUIRED LIBRARY ISOSRF, THE ERPRT77 PACKAGE, AND THE SPPS C ROUTINES C C LANGUAGE FORTRAN C C HISTORY IMPLEMENTED FOR USE WITH ISOSRF. C C C C C*********************************************************************** C SAVE CHARACTER*(*) ID CHARACTER*1 JCHAR(46) ,KCHAR DIMENSION INDEX(46) ,KX(494) ,KY(494) LOGICAL LENTRY C C THE FOLLOWING DATA STATEMENTS ASSOCIATE EACH CHARACTER WITH ITS C DIGITIZATION. THAT IS, THE DIGITIZATION FOR THE CHARACTER A STARTS C AT KX(1) AND KY(1), WHILE B STARTS AT KX(13) AND KY(13), AND SO ON. C DATA JCHAR( 1),INDEX( 1)/'A', 1/ DATA JCHAR( 2),INDEX( 2)/'B', 13/ DATA JCHAR( 3),INDEX( 3)/'C', 28/ DATA JCHAR( 4),INDEX( 4)/'D', 40/ DATA JCHAR( 5),INDEX( 5)/'E', 49/ DATA JCHAR( 6),INDEX( 6)/'F', 60/ DATA JCHAR( 7),INDEX( 7)/'G', 68/ DATA JCHAR( 8),INDEX( 8)/'H', 82/ DATA JCHAR( 9),INDEX( 9)/'I', 92/ DATA JCHAR(10),INDEX(10)/'J',104/ DATA JCHAR(11),INDEX(11)/'K',113/ DATA JCHAR(12),INDEX(12)/'L',123/ DATA JCHAR(13),INDEX(13)/'M',130/ DATA JCHAR(14),INDEX(14)/'N',137/ DATA JCHAR(15),INDEX(15)/'O',143/ DATA JCHAR(16),INDEX(16)/'P',157/ DATA JCHAR(17),INDEX(17)/'Q',166/ DATA JCHAR(18),INDEX(18)/'R',182/ DATA JCHAR(19),INDEX(19)/'S',194/ DATA JCHAR(20),INDEX(20)/'T',210/ DATA JCHAR(21),INDEX(21)/'U',219/ DATA JCHAR(22),INDEX(22)/'V',229/ DATA JCHAR(23),INDEX(23)/'W',236/ DATA JCHAR(24),INDEX(24)/'X',245/ DATA JCHAR(25),INDEX(25)/'Y',252/ DATA JCHAR(26),INDEX(26)/'Z',262/ DATA JCHAR(27),INDEX(27)/'0',273/ DATA JCHAR(28),INDEX(28)/'1',286/ DATA JCHAR(29),INDEX(29)/'2',296/ DATA JCHAR(30),INDEX(30)/'3',308/ DATA JCHAR(31),INDEX(31)/'4',326/ DATA JCHAR(32),INDEX(32)/'5',339/ DATA JCHAR(33),INDEX(33)/'6',352/ DATA JCHAR(34),INDEX(34)/'7',368/ DATA JCHAR(35),INDEX(35)/'8',378/ DATA JCHAR(36),INDEX(36)/'9',398/ DATA JCHAR(37),INDEX(37)/'+',414/ DATA JCHAR(38),INDEX(38)/'-',423/ DATA JCHAR(39),INDEX(39)/'*',429/ DATA JCHAR(40),INDEX(40)/'/',444/ DATA JCHAR(41),INDEX(41)/'(',448/ DATA JCHAR(42),INDEX(42)/')',456/ DATA JCHAR(43),INDEX(43)/'=',464/ DATA JCHAR(44),INDEX(44)/' ',473/ DATA JCHAR(45),INDEX(45)/',',476/ DATA JCHAR(46),INDEX(46)/'.',486/ C C THE FOLLOWING DATA STATEMENTS CONTAIN THE DIGITIZATIONS OF THE C CHARACTERS. THE CHARACTERS ARE DIGITIZED ON A BOX 6 UNITS WIDE AND C 7 UNITS TALL. THIS INCLUDES 2 UNITS OF WHITE SPACE TO THE RIGHT OF C EACH CHARACTER. IF KX=7, KY IS A FLAG -- KY=0 MEANS THE FOLLOWING C KX AND KY ARE A PEN UP MOVE (ALL OTHERS ARE PEN DOWN MOVES), AND C KY=7 MEANS THAT THE END OF THE DIGITIZATION FOR A PARTICULAR CHARAC- C TER HAS BEEN REACHED. C c None of the following variables are used. c DATA WIDE,HIGH,WHITE/6.,7.,2./ C DATA KX( 1),KX( 2),KX( 3),KX( 4),KX( 5),KX( 6)/0,4,7,0,0,1/ DATA KY( 1),KY( 2),KY( 3),KY( 4),KY( 5),KY( 6)/3,3,0,3,6,7/ DATA KX( 7),KX( 8),KX( 9),KX( 10),KX( 11),KX( 12)/3,4,4,7,6,7/ DATA KY( 7),KY( 8),KY( 9),KY( 10),KY( 11),KY( 12)/7,6,0,0,0,7/ DATA KX( 13),KX( 14),KX( 15),KX( 16),KX( 17),KX( 18)/0,3,4,4,3,0/ DATA KY( 13),KY( 14),KY( 15),KY( 16),KY( 17),KY( 18)/7,7,6,5,4,4/ DATA KX( 19),KX( 20),KX( 21),KX( 22),KX( 23),KX( 24)/7,3,4,4,3,0/ DATA KY( 19),KY( 20),KY( 21),KY( 22),KY( 23),KY( 24)/0,4,3,1,0,0/ DATA KX( 25),KX( 26),KX( 27),KX( 28),KX( 29),KX( 30)/7,6,7,7,4,3/ DATA KY( 25),KY( 26),KY( 27),KY( 28),KY( 29),KY( 30)/0,0,7,0,6,7/ DATA KX( 31),KX( 32),KX( 33),KX( 34),KX( 35),KX( 36)/1,0,0,1,3,4/ DATA KY( 31),KY( 32),KY( 33),KY( 34),KY( 35),KY( 36)/7,6,1,0,0,1/ DATA KX( 37),KX( 38),KX( 39),KX( 40),KX( 41),KX( 42)/7,6,7,0,3,4/ DATA KY( 37),KY( 38),KY( 39),KY( 40),KY( 41),KY( 42)/0,0,7,7,7,6/ DATA KX( 43),KX( 44),KX( 45),KX( 46),KX( 47),KX( 48)/4,3,0,7,6,7/ DATA KY( 43),KY( 44),KY( 45),KY( 46),KY( 47),KY( 48)/1,0,0,0,0,7/ DATA KX( 49),KX( 50),KX( 51),KX( 52),KX( 53),KX( 54)/0,4,7,3,0,7/ DATA KY( 49),KY( 50),KY( 51),KY( 52),KY( 53),KY( 54)/7,7,0,4,4,0/ DATA KX( 55),KX( 56),KX( 57),KX( 58),KX( 59),KX( 60)/0,4,7,6,7,0/ DATA KY( 55),KY( 56),KY( 57),KY( 58),KY( 59),KY( 60)/0,0,0,0,7,7/ DATA KX( 61),KX( 62),KX( 63),KX( 64),KX( 65),KX( 66)/4,7,0,3,7,6/ DATA KY( 61),KY( 62),KY( 63),KY( 64),KY( 65),KY( 66)/7,0,4,4,0,0/ DATA KX( 67),KX( 68),KX( 69),KX( 70),KX( 71),KX( 72)/7,7,4,3,1,0/ DATA KY( 67),KY( 68),KY( 69),KY( 70),KY( 71),KY( 72)/7,0,6,7,7,6/ DATA KX( 73),KX( 74),KX( 75),KX( 76),KX( 77),KX( 78)/0,1,3,4,4,3/ DATA KY( 73),KY( 74),KY( 75),KY( 76),KY( 77),KY( 78)/1,0,0,1,3,3/ DATA KX( 79),KX( 80),KX( 81),KX( 82),KX( 83),KX( 84)/7,6,7,0,7,0/ DATA KY( 79),KY( 80),KY( 81),KY( 82),KY( 83),KY( 84)/0,0,7,7,0,4/ DATA KX( 85),KX( 86),KX( 87),KX( 88),KX( 89),KX( 90)/4,7,4,4,7,6/ DATA KY( 85),KY( 86),KY( 87),KY( 88),KY( 89),KY( 90)/4,0,7,0,0,0/ DATA KX( 91),KX( 92),KX( 93),KX( 94),KX( 95),KX( 96)/7,7,1,3,7,2/ DATA KY( 91),KY( 92),KY( 93),KY( 94),KY( 95),KY( 96)/7,0,7,7,0,7/ DATA KX( 97),KX( 98),KX( 99),KX(100),KX(101),KX(102)/2,7,1,3,7,6/ DATA KY( 97),KY( 98),KY( 99),KY(100),KY(101),KY(102)/0,0,0,0,0,0/ DATA KX(103),KX(104),KX(105),KX(106),KX(107),KX(108)/7,7,0,1,3,4/ DATA KY(103),KY(104),KY(105),KY(106),KY(107),KY(108)/7,0,1,0,0,1/ DATA KX(109),KX(110),KX(111),KX(112),KX(113),KX(114)/4,7,6,7,0,7/ DATA KY(109),KY(110),KY(111),KY(112),KY(113),KY(114)/7,0,0,7,7,0/ DATA KX(115),KX(116),KX(117),KX(118),KX(119),KX(120)/0,4,7,2,4,7/ DATA KY(115),KY(116),KY(117),KY(118),KY(119),KY(120)/3,7,0,5,0,0/ DATA KX(121),KX(122),KX(123),KX(124),KX(125),KX(126)/6,7,7,0,0,4/ DATA KY(121),KY(122),KY(123),KY(124),KY(125),KY(126)/0,7,0,7,0,0/ DATA KX(127),KX(128),KX(129),KX(130),KX(131),KX(132)/7,6,7,0,2,4/ DATA KY(127),KY(128),KY(129),KY(130),KY(131),KY(132)/0,0,7,7,3,7/ DATA KX(133),KX(134),KX(135),KX(136),KX(137),KX(138)/4,7,6,7,0,4/ DATA KY(133),KY(134),KY(135),KY(136),KY(137),KY(138)/0,0,0,7,7,0/ DATA KX(139),KX(140),KX(141),KX(142),KX(143),KX(144)/4,7,6,7,4,7/ DATA KY(139),KY(140),KY(141),KY(142),KY(143),KY(144)/7,0,0,7,7,0/ DATA KX(145),KX(146),KX(147),KX(148),KX(149),KX(150)/4,4,3,1,0,0/ DATA KY(145),KY(146),KY(147),KY(148),KY(149),KY(150)/1,6,7,7,6,1/ DATA KX(151),KX(152),KX(153),KX(154),KX(155),KX(156)/1,3,4,7,6,7/ DATA KY(151),KY(152),KY(153),KY(154),KY(155),KY(156)/0,0,1,0,0,7/ DATA KX(157),KX(158),KX(159),KX(160),KX(161),KX(162)/0,3,4,4,3,0/ DATA KY(157),KY(158),KY(159),KY(160),KY(161),KY(162)/7,7,6,5,4,4/ DATA KX(163),KX(164),KX(165),KX(166),KX(167),KX(168)/7,6,7,7,0,0/ DATA KY(163),KY(164),KY(165),KY(166),KY(167),KY(168)/0,0,7,0,1,6/ DATA KX(169),KX(170),KX(171),KX(172),KX(173),KX(174)/1,3,4,4,3,1/ DATA KY(169),KY(170),KY(171),KY(172),KY(173),KY(174)/7,7,6,1,0,0/ DATA KX(175),KX(176),KX(177),KX(178),KX(179),KX(180)/0,7,2,4,7,6/ DATA KY(175),KY(176),KY(177),KY(178),KY(179),KY(180)/1,0,2,0,0,0/ DATA KX(181),KX(182),KX(183),KX(184),KX(185),KX(186)/7,0,3,4,4,3/ DATA KY(181),KY(182),KY(183),KY(184),KY(185),KY(186)/7,7,7,6,5,4/ DATA KX(187),KX(188),KX(189),KX(190),KX(191),KX(192)/0,7,2,4,7,6/ DATA KY(187),KY(188),KY(189),KY(190),KY(191),KY(192)/4,0,4,0,0,0/ DATA KX(193),KX(194),KX(195),KX(196),KX(197),KX(198)/7,7,0,1,3,4/ DATA KY(193),KY(194),KY(195),KY(196),KY(197),KY(198)/7,0,1,0,0,1/ DATA KX(199),KX(200),KX(201),KX(202),KX(203),KX(204)/4,3,1,0,0,1/ DATA KY(199),KY(200),KY(201),KY(202),KY(203),KY(204)/3,4,4,5,6,7/ DATA KX(205),KX(206),KX(207),KX(208),KX(209),KX(210)/3,4,7,6,7,7/ DATA KY(205),KY(206),KY(207),KY(208),KY(209),KY(210)/7,6,0,0,7,0/ DATA KX(211),KX(212),KX(213),KX(214),KX(215),KX(216)/0,4,7,2,2,7/ DATA KY(211),KY(212),KY(213),KY(214),KY(215),KY(216)/7,7,0,7,0,0/ DATA KX(217),KX(218),KX(219),KX(220),KX(221),KX(222)/6,7,7,0,0,1/ DATA KY(217),KY(218),KY(219),KY(220),KY(221),KY(222)/0,7,0,7,1,0/ DATA KX(223),KX(224),KX(225),KX(226),KX(227),KX(228)/3,4,4,7,6,7/ DATA KY(223),KY(224),KY(225),KY(226),KY(227),KY(228)/0,1,7,0,0,7/ DATA KX(229),KX(230),KX(231),KX(232),KX(233),KX(234)/7,0,2,4,7,6/ DATA KY(229),KY(230),KY(231),KY(232),KY(233),KY(234)/0,7,0,7,0,0/ DATA KX(235),KX(236),KX(237),KX(238),KX(239),KX(240)/7,7,0,0,2,4/ DATA KY(235),KY(236),KY(237),KY(238),KY(239),KY(240)/7,0,7,0,4,0/ DATA KX(241),KX(242),KX(243),KX(244),KX(245),KX(246)/4,7,6,7,4,7/ DATA KY(241),KY(242),KY(243),KY(244),KY(245),KY(246)/7,0,0,7,7,0/ DATA KX(247),KX(248),KX(249),KX(250),KX(251),KX(252)/0,4,7,6,7,7/ DATA KY(247),KY(248),KY(249),KY(250),KY(251),KY(252)/7,0,0,0,7,0/ DATA KX(253),KX(254),KX(255),KX(256),KX(257),KX(258)/0,2,4,7,2,2/ DATA KY(253),KY(254),KY(255),KY(256),KY(257),KY(258)/7,4,7,0,4,0/ DATA KX(259),KX(260),KX(261),KX(262),KX(263),KX(264)/7,6,7,7,3,1/ DATA KY(259),KY(260),KY(261),KY(262),KY(263),KY(264)/0,0,7,0,4,4/ DATA KX(265),KX(266),KX(267),KX(268),KX(269),KX(270)/7,0,4,0,4,7/ DATA KY(265),KY(266),KY(267),KY(268),KY(269),KY(270)/0,7,7,0,0,0/ DATA KX(271),KX(272),KX(273),KX(274),KX(275),KX(276)/6,7,7,4,3,1/ DATA KY(271),KY(272),KY(273),KY(274),KY(275),KY(276)/0,7,0,1,0,0/ DATA KX(277),KX(278),KX(279),KX(280),KX(281),KX(282)/0,0,1,3,4,4/ DATA KY(277),KY(278),KY(279),KY(280),KY(281),KY(282)/1,6,7,7,6,1/ DATA KX(283),KX(284),KX(285),KX(286),KX(287),KX(288)/7,6,7,7,1,2/ DATA KY(283),KY(284),KY(285),KY(286),KY(287),KY(288)/0,0,7,0,6,7/ DATA KX(289),KX(290),KX(291),KX(292),KX(293),KX(294)/2,7,1,3,7,6/ DATA KY(289),KY(290),KY(291),KY(292),KY(293),KY(294)/0,0,0,0,0,0/ DATA KX(295),KX(296),KX(297),KX(298),KX(299),KX(300)/7,7,0,1,3,4/ DATA KY(295),KY(296),KY(297),KY(298),KY(299),KY(300)/7,0,6,7,7,6/ DATA KX(301),KX(302),KX(303),KX(304),KX(305),KX(306)/4,0,0,4,7,6/ DATA KY(301),KY(302),KY(303),KY(304),KY(305),KY(306)/5,1,0,0,0,0/ DATA KX(307),KX(308),KX(309),KX(310),KX(311),KX(312)/7,7,0,1,3,4/ DATA KY(307),KY(308),KY(309),KY(310),KY(311),KY(312)/7,0,6,7,7,6/ DATA KX(313),KX(314),KX(315),KX(316),KX(317),KX(318)/4,3,1,7,3,4/ DATA KY(313),KY(314),KY(315),KY(316),KY(317),KY(318)/5,4,4,0,4,3/ DATA KX(319),KX(320),KX(321),KX(322),KX(323),KX(324)/4,3,1,0,7,6/ DATA KY(319),KY(320),KY(321),KY(322),KY(323),KY(324)/1,0,0,1,0,0/ DATA KX(325),KX(326),KX(327),KX(328),KX(329),KX(330)/7,7,3,3,2,0/ DATA KY(325),KY(326),KY(327),KY(328),KY(329),KY(330)/7,0,0,7,7,4/ DATA KX(331),KX(332),KX(333),KX(334),KX(335),KX(336)/0,4,7,2,4,7/ DATA KY(331),KY(332),KY(333),KY(334),KY(335),KY(336)/3,3,0,0,0,0/ DATA KX(337),KX(338),KX(339),KX(340),KX(341),KX(342)/6,7,7,0,1,3/ DATA KY(337),KY(338),KY(339),KY(340),KY(341),KY(342)/0,7,0,1,0,0/ DATA KX(343),KX(344),KX(345),KX(346),KX(347),KX(348)/4,4,3,0,0,4/ DATA KY(343),KY(344),KY(345),KY(346),KY(347),KY(348)/1,3,4,4,7,7/ DATA KX(349),KX(350),KX(351),KX(352),KX(353),KX(354)/7,6,7,7,4,3/ DATA KY(349),KY(350),KY(351),KY(352),KY(353),KY(354)/0,0,7,0,6,7/ DATA KX(355),KX(356),KX(357),KX(358),KX(359),KX(360)/1,0,0,1,3,4/ DATA KY(355),KY(356),KY(357),KY(358),KY(359),KY(360)/7,6,1,0,0,1/ DATA KX(361),KX(362),KX(363),KX(364),KX(365),KX(366)/4,3,1,0,7,6/ DATA KY(361),KY(362),KY(363),KY(364),KY(365),KY(366)/3,4,4,3,0,0/ DATA KX(367),KX(368),KX(369),KX(370),KX(371),KX(372)/7,7,0,0,4,4/ DATA KY(367),KY(368),KY(369),KY(370),KY(371),KY(372)/7,0,6,7,7,6/ DATA KX(373),KX(374),KX(375),KX(376),KX(377),KX(378)/2,2,7,6,7,7/ DATA KY(373),KY(374),KY(375),KY(376),KY(377),KY(378)/1,0,0,0,7,0/ DATA KX(379),KX(380),KX(381),KX(382),KX(383),KX(384)/1,0,0,1,3,4/ DATA KY(379),KY(380),KY(381),KY(382),KY(383),KY(384)/4,5,6,7,7,6/ DATA KX(385),KX(386),KX(387),KX(388),KX(389),KX(390)/4,3,1,0,0,1/ DATA KY(385),KY(386),KY(387),KY(388),KY(389),KY(390)/5,4,4,3,1,0/ DATA KX(391),KX(392),KX(393),KX(394),KX(395),KX(396)/3,4,4,3,7,6/ DATA KY(391),KY(392),KY(393),KY(394),KY(395),KY(396)/0,1,3,4,0,0/ DATA KX(397),KX(398),KX(399),KX(400),KX(401),KX(402)/7,7,0,1,3,4/ DATA KY(397),KY(398),KY(399),KY(400),KY(401),KY(402)/7,0,1,0,0,1/ DATA KX(403),KX(404),KX(405),KX(406),KX(407),KX(408)/4,3,1,0,0,1/ DATA KY(403),KY(404),KY(405),KY(406),KY(407),KY(408)/6,7,7,6,4,3/ DATA KX(409),KX(410),KX(411),KX(412),KX(413),KX(414)/3,4,7,6,7,7/ DATA KY(409),KY(410),KY(411),KY(412),KY(413),KY(414)/3,4,0,0,7,0/ DATA KX(415),KX(416),KX(417),KX(418),KX(419),KX(420)/0,4,7,2,2,7/ DATA KY(415),KY(416),KY(417),KY(418),KY(419),KY(420)/3,3,0,5,1,0/ DATA KX(421),KX(422),KX(423),KX(424),KX(425),KX(426)/6,7,7,0,4,7/ DATA KY(421),KY(422),KY(423),KY(424),KY(425),KY(426)/0,7,0,3,3,0/ DATA KX(427),KX(428),KX(429),KX(430),KX(431),KX(432)/6,7,7,0,4,7/ DATA KY(427),KY(428),KY(429),KY(430),KY(431),KY(432)/0,7,0,1,5,0/ DATA KX(433),KX(434),KX(435),KX(436),KX(437),KX(438)/2,2,7,4,0,7/ DATA KY(433),KY(434),KY(435),KY(436),KY(437),KY(438)/5,1,0,3,3,0/ DATA KX(439),KX(440),KX(441),KX(442),KX(443),KX(444)/0,4,7,6,7,4/ DATA KY(439),KY(440),KY(441),KY(442),KY(443),KY(444)/5,1,0,0,7,7/ DATA KX(445),KX(446),KX(447),KX(448),KX(449),KX(450)/7,6,7,7,3,2/ DATA KY(445),KY(446),KY(447),KY(448),KY(449),KY(450)/0,0,7,1,7,6/ DATA KX(451),KX(452),KX(453),KX(454),KX(455),KX(456)/2,3,7,6,7,7/ DATA KY(451),KY(452),KY(453),KY(454),KY(455),KY(456)/1,0,0,0,7,0/ DATA KX(457),KX(458),KX(459),KX(460),KX(461),KX(462)/1,2,2,1,7,6/ DATA KY(457),KY(458),KY(459),KY(460),KY(461),KY(462)/7,6,1,0,0,0/ DATA KX(463),KX(464),KX(465),KX(466),KX(467),KX(468)/7,7,4,0,7,0/ DATA KY(463),KY(464),KY(465),KY(466),KY(467),KY(468)/7,0,5,5,0,2/ DATA KX(469),KX(470),KX(471),KX(472),KX(473),KX(474)/4,7,6,7,7,6/ DATA KY(469),KY(470),KY(471),KY(472),KY(473),KY(474)/2,0,0,7,0,0/ DATA KX(475),KX(476),KX(477),KX(478),KX(479),KX(480)/7,7,1,2,2,1/ DATA KY(475),KY(476),KY(477),KY(478),KY(479),KY(480)/7,0,0,1,2,2/ DATA KX(481),KX(482),KX(483),KX(484),KX(485),KX(486)/1,2,7,6,7,7/ DATA KY(481),KY(482),KY(483),KY(484),KY(485),KY(486)/1,1,0,0,7,0/ DATA KX(487),KX(488),KX(489),KX(490),KX(491),KX(492)/2,1,1,2,2,7/ DATA KY(487),KY(488),KY(489),KY(490),KY(491),KY(492)/0,0,1,1,0,0/ DATA KX(493),KX(494) /6,7 / DATA KY(493),KY(494) /0,7 / C C NSIZE IS THE LENGTH OF JCHAR AND INDEX. C LNGTH IS THE LENGTH OF KX AND KY. C LENTRY TELLS IF THIS IS THE FIRTST CALL TO PWRZI. C DATA NSIZE/46/ c Variable LNGTH is not used. c DATA LNGTH/494/ DATA LENTRY/.FALSE./ DATA ITHETA/0/ DATA IDUM1,IDUM2,IDUM3/1,1,1/ C C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR C CALL Q8QST4 ('GRAPHX','PWRZI','PWRZI','VERSION 1') C C SEE IF THIS IS THE FIRST CALL TO PWRZI C IF (LENTRY) GO TO 103 C C MARK THAT FUTURE CALLS NEED NOT DO THIS CODE. C LENTRY = .TRUE. C C RECORD THE LOCATION OF THE BLANK SO IT CAN BE USED FOR UNKNOWN C CHARACTERS. C IBLKPT = INDEX(44) C C CHANGE EACH CHARACTER IN THE TABLE TO RIGHT JUSTIFIED, ZERO FILLED. C C C SORT JCHAR MAINTAINING THE RELATIONSHIP BETWEEN JCHAR AND INDEX. C (THAT IS, IF JCHAR(I)='B', THEN INDEX(I)=13 FROM THE ABOVE DATA STMT.) C THIS WILL ENABLE CHARACTERS TO BE QUICKLY FOUND IN ALL SUBSEQUENT C CALLS TO PWRZI. C CALL PWRZOI (JCHAR,INDEX,NSIZE) C C ALL ONE-TIME INITIALIZATION NOW FINISHED. C 103 CONTINUE C NN = N IF (NN .LE. 0) RETURN FNNM1 = NN-1 JCNT = ICNT C C PUT RELATIVE SIZE IN Q, ADJUST FOR CURRENT PLOTTER RESOLUTION C CALL GETUSV ('XF',LX) SCALE = 32. IF (ISIZE .EQ. 0) Q = 1.3334*SCALE IF (ISIZE .EQ. 1) Q = 2.*SCALE IF (ISIZE .EQ. 2) Q = 2.6667*SCALE IF (ISIZE .EQ. 3) Q = 4.*SCALE IF (ISIZE .GT. 3) Q = FLOAT(ISIZE)*(2**(15-LX))/6. C C PUT ANGLE IN RADIANS IN T. C T = FLOAT(ITHETA)*1.5708 104 CONTINUE C C CALCULATE COMBINED TRANSFORMATION C CT = Q*COS(T) ST = Q*SIN(T) C C FIND CRT COORDINATES OF CENTER. C LINEI = LIN3 CALL INTZI (X,Y,Z,LINEI,ITOP) IF (LINEI .EQ. 0) RETURN IX = 0 IY = 0 XC = IX YC = IY C C CORRECT FOR CHARACTER DATA BEING LOWER-LEFT-HAND POSITIONED. C XC = XC-2.*CT+3.5*ST YC = YC-2.*ST-3.5*CT C C CORRECT FOR CENTERING IF TURNED ON. C JCNT = MAX0(-1,MIN0(1,JCNT))+2 GO TO (108,107,109),JCNT 107 XC = XC-CT*FNNM1*3. YC = YC-ST*FNNM1*3. GO TO 110 108 XC = XC+CT*2. YC = YC+ST*2. GO TO 110 109 XC = XC-CT*2. YC = YC-ST*2. XC = XC-CT*FNNM1*6. YC = YC-ST*FNNM1*6. 110 CALL INITZI (IFIX(XC),IFIX(YC),1,IDUM1,IDUM2,2) CALL INITZI (IFIX(XC+CT*6.*FNNM1),IFIX(YC+ST*6.*FNNM1),2,IDUM1, + IDUM2,2) CALL INITZI (IFIX(XC),IFIX(YC),IDUM1,IDUM2,IDUM3,3) DO 114 K=1,NN XB = XC YB = YC IP = 1 C C EXTRACT CHARACTER NUMBER K FROM THE STRING. C KCHAR = ID(K:K) C C FIND THE TABLE ENTRY. C CALL PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT) IF (IPOINT .EQ. -1) IPOINT = IBLKPT C C ALWAYS LESS THAN 20 INSTRUCTIONS. C DO 113 L=1,20 ISUB = IPOINT+L-1 NX = KX(ISUB) FNX = NX NY = KY(ISUB) FNY = NY C C TEST FOR OP-CODE OR DX AND DY. C IF (NX .NE. 7) GO TO 111 C C OP-CODE C IP = 0 IF (NY-7) 113,114,113 C C DX AND DY C 111 XC = XB+FNX*CT-FNY*ST YC = YB+FNX*ST+FNY*CT C C CALL DESIRED PLOTTING ROUTINE. DETERMINED BY OP-CODES. C IF (IP .NE. 0) GO TO 112 CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,3) IP = 1 GO TO 113 112 CALL INITZI (IFIX(XC+.5),IFIX(YC+.5),IDUM1,IDUM2,IDUM3,4) 113 CONTINUE 114 CONTINUE C C FLUSH PLOTIT BUFFER C CALL PLOTIT(0,0,0) RETURN END SUBROUTINE INTZI (XX,YY,ZZ,LIN3,ITOP) C C FORCE STORAGE OF X, Y, AND Z INTO COMMON BLOCK C COMMON /PWRZ2I/ X, Y, Z DATA IDUMX,IDUMY,IDUMZ /0, 0, 0/ X = XX Y = YY Z = ZZ CALL INITZI (IDUMX,IDUMY,IDUMZ,LIN3,ITOP,1) RETURN END SUBROUTINE INITZI (IX,IY,IZ,LIN3,ITOP,IENT) C SAVE COMMON /PWRZ1I/ XXMIN ,XXMAX ,YYMIN ,YYMAX , + ZZMIN ,ZZMAX ,DELCRT ,EYEX , + EYEY ,EYEZ C COMMON /PWRZ2I/ X ,Y ,Z FX(R) = R+FACTX*FLOAT(IX) FY(R) = R+FACTY*FLOAT(IY) C C C DETERMINE INITZI,VISSET,FRSTZ OR VECTZ CALL C GO TO (1000,2000,3000,4000),IENT 1000 LIN = MAX0(1,MIN0(3,IABS(LIN3))) ITO = MAX0(1,MIN0(3,IABS(ITOP))) C C SET UP SCALING CONSTANTS C DELMAX = AMAX1(XXMAX-XXMIN,YYMAX-YYMIN,ZZMAX-ZZMIN) FACTOR = DELMAX/DELCRT FACTX = SIGN(FACTOR,FLOAT(LIN3)) FACTY = SIGN(FACTOR,FLOAT(ITOP)) C C SET UP FOR PROPER PLANE C JUMP1 = LIN+(ITO-1)*3 GO TO (108,101,102,103,108,104,105,106,108),JUMP1 101 ASSIGN 111 TO JUMP GO TO 107 102 ASSIGN 112 TO JUMP GO TO 107 103 ASSIGN 113 TO JUMP GO TO 107 104 ASSIGN 114 TO JUMP GO TO 107 105 ASSIGN 115 TO JUMP GO TO 107 106 ASSIGN 116 TO JUMP 107 RETURN 108 CALL SETER ('INITZI - LINE OR ITOP IMPROPER IN PWRZI CALL' ,1,1) LIN3 = 0 RETURN C C **************************** ENTRY VISSET **************************** C ENTRY VISSET (IX,IY,IZ) C C C VISSET IS CALLED ONCE FOR EACH END OF THE CHARACTER STRING C 2000 IVIS = -1 ITEMP = 0 GO TO 110 C C SEE IF THIS END COULD BE BEHIND THE OBJECT C 109 IF (EYEX.GT.XXMAX .AND. XX.GT.XXMAX) ITEMP = ITEMP+1 IF (EYEY.GT.YYMAX .AND. YY.GT.YYMAX) ITEMP = ITEMP+1 IF (EYEZ.GT.ZZMAX .AND. ZZ.GT.ZZMAX) ITEMP = ITEMP+1 IF (EYEX.LT.XXMIN .AND. XX.LT.XXMIN) ITEMP = ITEMP+1 IF (EYEY.LT.YYMIN .AND. YY.LT.YYMIN) ITEMP = ITEMP+1 IF (EYEZ.LT.ZZMIN .AND. ZZ.LT.ZZMIN) ITEMP = ITEMP+1 IF (IZ .EQ. 1) IVISS = ITEMP C C IF EITHER END CHARACTER COULD BE HIDDEN, TEST ALL LINE SEGMENTS. C IF (IZ .EQ. 2) IVIS = MIN0(IVISS,ITEMP) RETURN C C **************************** ENTRY FRSTZ ***************************** C ENTRY FRSTZ (IX,IY) C 3000 IFRST = 1 GO TO 110 C C **************************** ENTRY VECTZ ***************************** C ENTRY VECTZ (IX,IY) C 4000 IFRST = 0 C C PICK CORRECT 3-SPACE PLANE TO DRAW IN C 110 GO TO JUMP,(111,112,113,114,115,116) 111 XX = FY(X) YY = FX(Y) ZZ = Z GO TO 117 112 XX = FY(X) YY = Y ZZ = FX(Z) GO TO 117 113 XX = FX(X) YY = FY(Y) ZZ = Z GO TO 117 114 XX = X YY = FY(Y) ZZ = FX(Z) GO TO 117 115 XX = FX(X) YY = Y ZZ = FY(Z) GO TO 117 116 XX = X YY = FX(Y) ZZ = FY(Z) C C TRANSLATE TO 2-SPACE C 117 CALL TRN32I (XX,YY,ZZ,XT,YT,DUMMY,2) IF (IVIS) 109,121,118 118 IF (IFRST) 119,120,119 C C IF IN FRONT, DRAW IN ANY CASE. C 119 CALL PLOTIT (IFIX(XT),IFIX(YT),0) RETURN 120 CALL PLOTIT (IFIX(XT),IFIX(YT),1) RETURN 121 IF (IFRST) 122,123,122 122 IX1 = XT IY1 = YT RETURN 123 IX2 = XT IY2 = YT C C IF COULD BE HIDDEN, USE HIDDEN LINE PLOTTING ENTRY IN ISOSRF C CALL DRAWI (IX1,IY1,IX2,IY2) IX1 = IX2 IY1 = IY2 RETURN END SUBROUTINE PWRZOI (JCHAR,INDEX,NSIZE) C C THIS ROUTINE SORTS JCHAR WHICH IS NSIZE IN LENGTH. THE RELATIONSHIP C BETWEEN JCHAR AND INDEX IS MAINTAINED. A BUBBLE SORT IS USED. C JCHAR IS SORTED IN ASCENDING ORDER. C SAVE CHARACTER*1 JCHAR(NSIZE) ,JTEMP ,KTEMP DIMENSION INDEX(NSIZE) LOGICAL LDONE C ISTART = 1 ISTOP = NSIZE ISTEP = 1 C C AT MOST NSIZE PASSES ARE NEEDED. C DO 104 NPASS=1,NSIZE LDONE = .TRUE. I = ISTART 101 ISUB = I+ISTEP IF (ISTEP*(ICHAR(JCHAR(I))-ICHAR(JCHAR(ISUB)))) 103,103,102 C C THEY NEED TO BE SWITCHED. C 102 LDONE = .FALSE. JTEMP = JCHAR(I) KTEMP = JCHAR(ISUB) JCHAR(I) = KTEMP JCHAR(ISUB) = JTEMP ITEMP = INDEX(I) INDEX(I) = INDEX(ISUB) INDEX(ISUB) = ITEMP C C THEY DO NOT NEED TO BE SWITCHED. C 103 I = I+ISTEP IF (I .NE. ISTOP) GO TO 101 C C IF NONE WERE SWITCHED DURING THIS PASS, WE CAN QUIT. C IF (LDONE) RETURN C C SET UP FOR THE NEXT PASS IN THE OTHER DIRECTION. C ISTEP = -ISTEP ITEMP = ISTART ISTART = ISTOP+ISTEP ISTOP = ITEMP 104 CONTINUE RETURN END SUBROUTINE PWRZGI (KCHAR,JCHAR,INDEX,NSIZE,IPOINT) C C THIS ROUTINE FINDS WHERE KCHAR IS IN JCHAR AND RETURNS THE CORRES- C PONDING INDEX IN IPOINT. BINARY HALVING IS USED. C SAVE CHARACTER*1 JCHAR(NSIZE) ,KCHAR DIMENSION INDEX(NSIZE) C C IT IS ASSUMED THAT JCHAR IS LESS THAT 2**9 IN LENGTH, SO IF KCHAR IS C NOT FOUND IN 10 STEPS, THE SEARCH IS STOPPED. C KOUNT = 0 IBOT = 1 ITOP = NSIZE I = ITOP GO TO 102 101 I = (IBOT+ITOP)/2 KOUNT = KOUNT+1 IF (KOUNT .GT. 10) GO TO 106 102 IF (ICHAR(JCHAR(I))-ICHAR(KCHAR)) 103,105,104 103 IBOT = I GO TO 101 104 ITOP = I GO TO 101 105 IPOINT = INDEX(I) RETURN C C IPOINT=-1 MEANS THAT KCHAR WAS NOT IN THE TABLE. C 106 IPOINT = -1 RETURN C C C C REVISION HISTORY---------- C C MARCH 1980 FIRST ADDED TO ULIB AS A SEPARATE FILE TO BE C USED IN CONJUNCTION WITH THE ULIB ROUTINE C ISOSRF C C JULY 1984 CONVERTED TO GKS AND FORTRAN 77 C------------------------------------------------------------------ END