|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 150528 (0x24c00)
Types: TextFile
Names: »psl4«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »psl4«
c REF. IN COMP. PHYS. COMMUN. 1 (1969) 15
c $IBM.
c $FORTRAN.
program PSHELLTEST
C
C
C TO EVALUATE THE F.P. COEFFICIENTS OF ALL POSSIBLE PARENT STATES
C ALLOWED BY ONE INPUT STATE. THE SUM OF THE SQUARES OF THE ALLOWED
C COEFFICIENTS IS CHECKED WITH UNITY
C
C
C INITIALIZE SIX SETS OF INPUT DATA
C
integer N(6),IL(6),IS(6)
n(1)=1
n(2)=2
n(3)=3
n(4)=4
n(5)=5
n(6)=6
il(1)=1
il(2)=1
il(3)=2
il(4)=0
il(5)=1
il(6)=0
is(1)=2
is(2)=3
is(3)=2
is(4)=1
is(5)=2
is(6)=1
C
10 FORMAT (3H N=,I1,2X,4H LI=,I1,2X,4H SI=,I1,12X,4H LJ=,I1,2X,4H SJ=
1,I1,5X,6H CFPP=,F12.8)
11 FORMAT (3H N=,I1,2X,4H LI=,I1,2X,4H SI=,I1,12X,5H SUM=,F12.8///)
14 FORMAT (24H STATE IN QUESTION,19H PARENT STATE)
15 FORMAT (1H1 ,20H P SHELL F.P.C. TEST,////)
WRITE (6,15)
C
C TAKE INPUT STATE IN QUESTION FROM DATA STATEMENT
C
DO 1 I=1,6
WRITE (2,14)
SUM = 0.0
C
C SEARCH FOR ALLOWED PARENT STATES
C
DO 6 LJ =0,6
DO 7 ISJ =1,6
CALL CFPP(N(I),IL(I),IS(I),LJ,ISJ,COEFP)
IF(COEFP-9.9) 8,7,8
8 SUM =SUM +COEFP**2
WRITE(2,10) N(I),IL(I),IS(I),LJ,ISJ,COEFP
7 CONTINUE
6 CONTINUE
C
IF(SUM) 1,1,12
12 WRITE(2,11) N(I),IL(I),IS(I),SUM
1 CONTINUE
STOP
END
c
c------------------------------------------------------------------------
c ▶18◀▶18◀ cfpp
c-------------------------------------------------------------------------
c
SUBROUTINE CFPP(N,LI,ISI,LJ,ISJ,COEFP)
C
C THIS SUBROUTINE EVALUATES THE COEFFICIENTS OF FRACTIONAL PARENTAGE
C FOR EQUIVALENT P SHELL ELECTRONS FROM TABLES GIVEN IN J.C.SLATER
C QUANTUM THEORY OF ATOMIC STRUCTURE,VOLUME2,P350(1960)
C IN THE SUBROUTINE LIST N,THE NO. OF ELECTRONS,L THE ANGULAR
C MOMENTUM QUANTUM NO.,(2S+1) THE SPIN QUANTUM NO. OF BOTH THE STATE
C IN QUESTION AND ITS PARENT STATE ARE INPUT PARAMETERS.THE RESULT
C IS OUTPUT AS COEFP
C
integer IL(3,3),IS(3,3),ITAB1(3,1),ITAB2(3,3),NORM1(3),NORM2(3)
C
C
C SET UP P SHELL PARAMETERS AND TABLES
C
il(1,1)=1
il(2,1)=1
il(2,2)=2
il(2,3)=0
il(3,1)=0
il(3,2)=2
il(3,3)=1
is(1,1)=2
is(2,1)=3
is(2,2)=1
is(2,3)=1
is(3,1)=4
is(3,2)=2
is(3,3)=2
itab1(1,1)=1
itab1(2,1)=1
itab1(3,1)=1
itab2(1,1)=1
itab2(1,2)=0
itab2(1,3)=0
itab2(2,1)=1
itab2(2,2)=-1
itab2(2,3)=0
itab2(3,1)=-9
itab2(3,2)=-5
itab2(3,3)=4
norm1(1)=1
norm1(2)=1
norm1(3)=1
norm2(1)=1
norm2(2)=2
norm2(3)=18
C
C TEST IF N IS IN THE FIRST HALF OF SHELL
C
99 IF(N-4) 40,103,103
C
C TEST IF STATE IN QUESTION IS ALLOWED
C IF IT IS, IDENTIFY THE ROW OF THE TABLE BY J1
C
40 J = 0
101 J = J+1
IF(J-4) 41,8,8
41 IF(IL(N,J)-LI) 101,42,101
42 IF(IS(N,J)-ISI) 101,43,101
43 J1 = J
C
C TEST IF PARENT STATE IS ALLOWED
C IF IT IS, IDENTIFY THE COLUMN OF THE TABLE BY J2
C
IF(N-1) 44,70,44
70 IF(LJ) 8,71,8
71 IF(ISJ-1) 8,1,8
44 J = 0
102 J = J+1
IF(J-4) 45,8,8
45 IF(IL(N-1,J)-LJ) 102,46,102
46 IF(IS(N-1,J)-ISJ) 102,47,102
47 J2 = J
GO TO 100
C
C SIMILAR SETTING OF J1 AND J2 IF N IS IN SECOND HALF OF SHELL
C
103 M =6-N
IF(M) 72,73,72
73 IF(LI) 8,74,8
74 IF(ISI-1) 8,75,8
72 J = 0
104 J = J+1
IF(J-4) 48,8,8
48 IF(IL(M,J)-LI) 104,49,104
49 IF(IS(M,J)-ISI) 104,50,104
50 J1 = J
75 J = 0
105 J = J+1
IF(J-4) 51,8,8
51 IF(IL(M+1,J)-LJ) 105,52,105
52 IF(IS(M+1,J)-ISJ) 105,53,105
53 J2 = J
C
C
C IDENTIFY THE F.P.C AS A UNIQUE ELEMENT OF ITABN(J1,J2)
C
100 GO TO (1,2,3,4,4,1),N
1 COEFP = 1.0
GO TO 10
2 COEFP = ITAB1(J1,J2)
IF(COEFP) 54,10,31
54 COEFP = -SQRT(-COEFP/NORM1(J1))
GO TO 10
31 COEFP = SQRT(COEFP/NORM1(J1))
GO TO 10
3 COEFP = ITAB2(J1,J2)
IF(COEFP) 55,10,32
55 COEFP = -SQRT(-COEFP/NORM2(J1))
GO TO 10
32 COEFP =SQRT(COEFP/NORM2(J1))
GO TO 10
C
C USE RECURRENCE RELATION EQUATION (19) OF RACAH FOR SECOND HALF OF
C SHELL
C
4 ISIGN = (-1)**((ISI+ISJ-5)/2+LI+LJ)
FACTOR = ((7.0-N)*ISJ*(2*LJ+1.0))/(N*ISI*(2*LI+1.0))
IF(N-5) 56,5,8
56 COEFP = ITAB2(J2,J1)
IF(COEFP) 57,10,33
57 COEFP = -SQRT(-COEFP/NORM2(J2))
GO TO 34
33 COEFP = SQRT(COEFP/NORM2(J2))
34 COEFP = COEFP * ISIGN * SQRT(FACTOR)
IF(LJ-1) 35,10,35
35 COEFP = -COEFP
GO TO 10
5 COEFP = ITAB1(J2,J1)
IF(COEFP) 58,10,36
58 COEFP = -SQRT(-COEFP/NORM1(J2))
GO TO 37
36 COEFP = SQRT(COEFP/NORM1(J2))
37 COEFP = COEFP * ISIGN * SQRT(FACTOR)
GO TO 10
C
C FOR AN UNALLOWED STATE THE F.P.COEFFICIENT IS SET EQUAL TO AN
C ERRONEOUS VALUE. THIS STATEMENT COULD BE REPLACED BY AN ERROR
C STATEMENT
C
8 COEFP = 9.9
10 CONTINUE
RETURN
END
FINISH
c
c acrna new d shell cfp. a new version of the program to compute
c the fractional parentage coefficients for equivalent d schell
c electrons. chivers, a.t.
c ref. in comp. phys. commun. 6 (1973) 88
program dshell
C
C
C TO EVALUATE THE F.P. COEFFICIENTS OF ALL POSSIBLE PARENT STATES
C ALLOWED BY ONE INPUT STATE. THE SUM OF THE SQUARES OF THE ALLOWED
C COEFFICIENTS IS CHECKED WITH UNITY
C
C
C INITIALIZE TEN SETS OF INPUT DATA
C
DIMENSION N(10),IV(10),IL(10),IS(10)
COMMON/INFORM/IREAD,IWRITE,IPUNCH
DATA N(1),IV(1),IL(1),IS(1)/1,1,2,2/,
1 N(2),IV(2),IL(2),IS(2)/2,2,2,1/,
2 N(3),IV(3),IL(3),IS(3)/3,3,3,2/,
3 N(4),IV(4),IL(4),IS(4)/4,2,3,3/,
4 N(5),IV(5),IL(5),IS(5)/5,5,4,2/,
5 N(6),IV(6),IL(6),IS(6)/6,4,3,1/,
6 N(7),IV(7),IL(7),IS(7)/7,3,1,4/,
7 N(8),IV(8),IL(8),IS(8)/8,2,1,3/,
8 N(9),IV(9),IL(9),IS(9)/9,1,2,2/,
9 N(10),IV(10),IL(10),IS(10)/10,0,0,1/
C
10 FORMAT (3H N=,I1,2X,4H VI=,I1,2X,4H LI=,I1,2X,4H SI=,I1,5X,4H VJ=,
1I1,2X,4H LJ=,I1,2X,4H SJ=,I1,5X,6H CFPD=,F12.8)
11 FORMAT (3H N=,I1,2X,4H VI=,I1,2X,4H LI=,I1,2X,4H SI=,I1,5X,5H SUM=
1,F12.8///)
14 FORMAT (24H STATE IN QUESTION,19H PARENT STATE)
15 FORMAT (1H1 ,20H D SHELL F.P.C. TEST,////)
IWRITE=2
WRITE(IWRITE,15)
C
C TAKE INPUT STATE IN QUESTION FROM DATA STATEMENT
C
DO 1 I=1,10
WRITE(IWRITE,14)
SUM = 0.0
C
C SEARCH FOR ALLOWED PARENT STATES
C
DO 5 IVJ1=1,6
IVJ=IVJ1-1
DO 6 LJ1=1,7
LJ=LJ1-1
DO 7 ISJ=1,6
CALL CFPD(N(I),IV(I),IL(I),IS(I),IVJ,LJ,ISJ,COEFP)
IF(COEFP-9.9)8,7,8
8 SUM=SUM +COEFP**2
WRITE(IWRITE,10) N(I),IV(I),IL(I),IS(I),IVJ,LJ,ISJ,COEFP
7 CONTINUE
6 CONTINUE
5 CONTINUE
C
IF(SUM) 1,1,12
12 WRITE(IWRITE,11) N(I),IV(I),IL(I),IS(I),SUM
1 CONTINUE
STOP
END
BLOCK DATA
C
COMMON/FRPAR2/I(719)
C
C BLOCK DATA FOR CFPD SUBROUTINE
C
DATA I( 1),I( 2),I( 3),I( 4),I( 5),I( 6),I( 7),I( 8),
1 I( 9),I( 10),I( 11),I( 12),I( 13),I( 14),I( 15),I( 16),
1 I( 17),I( 18),I( 19),I( 20),I( 21),I( 22),I( 23),I( 24),
2 I( 25),I( 26),I( 27),I( 28),I( 29),I( 30),I( 31),I( 32),
3 I( 33),I( 34),I( 35),I( 36),I( 37),I( 38),I( 39),I( 40),
4 I( 41),I( 42),I( 43),I( 44),I( 45),I( 46),I( 47),I( 48),
5 I( 49),I( 50),I( 51),I( 52),I( 53),I( 54),I( 55),I( 56),
6 I( 57),I( 58),I( 59),I( 60),I( 61),I( 62),I( 63),I( 64),
7 I( 65),I( 66),I( 67),I( 68),I( 69),I( 70),I( 71),I( 72),
8 I( 73),I( 74),I( 75),I( 76),I( 77),I( 78),I( 79),I( 80)/
1 1, 5, 8, 16, 16, 1, 2, 3,
1 4, 5, 0, 2, 3, 4, 5, 0,
1 2, 3, 4, 3, 0, 2, 3, 2,
2 5, 0, 0, 3, 4, 3, 0, 0,
3 1, 4, 5, 0, 0, 3, 2, 3,
4 0, 0, 3, 4, 3, 0, 0, 0,
5 4, 5, 0, 0, 0, 2, 3, 0,
6 0, 0, 4, 5, 0, 0, 0, 4,
7 1, 0, 0, 0, 2, 3, 0, 0,
8 0, 4, 5, 0, 0, 0, 0, 3/
DATA I( 81),I( 82),I( 83),I( 84),I( 85),I( 86),I( 87),I( 88),
1 I( 89),I( 90),I( 91),I( 92),I( 93),I( 94),I( 95),I( 96),
1 I( 97),I( 98),I( 99),I(100),I(101),I(102),I(103),I(104),
2 I(105),I(106),I(107),I(108),I(109),I(110),I(111),I(112),
3 I(113),I(114),I(115),I(116),I(117),I(118),I(119),I(120),
4 I(121),I(122),I(123),I(124),I(125),I(126),I(127),I(128),
5 I(129),I(130),I(131),I(132),I(133),I(134),I(135),I(136),
6 I(137),I(138),I(139),I(140),I(141),I(142),I(143),I(144),
7 I(145)/
1 0, 0, 0, 4, 5, 2, 3, 3,
1 2, 0, 0, 1, 1, 5, 4, 0,
1 4, 5, 4, 3, 0, 2, 4, 3,
2 2, 0, 0, 3, 3, 1, 0, 0,
3 2, 2, 6, 0, 0, 2, 1, 5,
4 0, 0, 1, 1, 4, 0, 0, 0,
5 6, 4, 0, 0, 0, 4, 3, 0,
6 0, 0, 4, 3, 0, 0, 0, 3,
7 2/
DATA I(146),I(147),I(148),I(149),I(150),I(151),I(152),I(153),
1 I(154),I(155),I(156),I(157),I(158),I(159),I(160),I(161),
1 I(162),I(163),I(164),I(165),I(166),I(167),I(168),I(169),
2 I(170),I(171),I(172),I(173),I(174),I(175),I(176),I(177),
3 I(178),I(179),I(180),I(181),I(182),I(183),I(184),I(185),
4 I(186),I(187),I(188),I(189),I(190),I(191),I(192),I(193),
5 I(194),I(195),I(196),I(197),I(198),I(199),I(200),I(201),
6 I(202),I(203),I(204),I(205),I(206),I(207),I(208),I(209),
7 I(210),I(211),I(212),I(213),I(214),I(215),I(216),I(217),
8 I(218),I(219),I(220),I(221),I(222),I(223),I(224),I(225)/
1 0, 0, 0, 2, 2, 0, 0, 0,
1 2, 2, 0, 0, 0, 0, 1, 0,
1 0, 0, 0, 0, 2, 3, 4, 5,
2 6, 0, 3, 4, 3, 4, 0, 1,
3 2, 3, 4, 0, 1, 2, 3, 4,
4 0, 1, 2, 3, 4, 0, 0, 2,
5 3, 2, 0, 0, 2, 3, 2, 0,
6 0, 2, 3, 2, 0, 0, 0, 1,
7 2, 0, 0, 0, 1, 2, 0, 0,
8 0, 1, 2, 0, 0, 0, 1, 2/
DATA I(226),I(227),I(228),I(229),I(230),I(231),I(232),I(233),
1 I(234),I(235),I(236),I(237),I(238),I(239),I(240),I(241),
1 I(242),I(243),I(244),I(245),I(246),I(247),I(248),I(249),
2 I(250),I(251),I(252),I(253),I(254),I(255),I(256),I(257),
3 I(258),I(259),I(260),I(261),I(262),I(263),I(264),I(265),
4 I(266),I(267),I(268),I(269),I(270),I(271),I(272),I(273),
5 I(274),I(275),I(276),I(277),I(278),I(279),I(280),I(281),
6 I(282),I(283),I(284),I(285),I(286),I(287),I(288),I(289),
7 I(290)/
1 0, 0, 0, 1, 2, 0, 0, 0,
1 1, 2, 0, 0, 0, 1, 2, 0,
1 0, 0, 1, 2, 1, 1, 1, 1,
2 1, 4, -7, -1, 21, 7, -21, 21,
3 -8, -1, -8, 0, 0, 28, -9, -49,
4 7, 0, 0, 1, 11, -25, -9, -25,
5 0, 0, 0, 0, -10, -10, -5, 45,
6 15, 0, 0, 0, 0, 0, 16, 0,
7 0/
DATA I(291),I(292),I(293),I(294),I(295),I(296),I(297),I(298),
1 I(299),I(300),I(301),I(302),I(303),I(304),I(305),I(306),
1 I(307),I(308),I(309),I(310),I(311),I(312),I(313),I(314),
2 I(315),I(316),I(317),I(318),I(319),I(320),I(321),I(322),
3 I(323),I(324),I(325),I(326),I(327),I(328),I(329),I(330),
4 I(331),I(332),I(333),I(334),I(335),I(336),I(337),I(338),
5 I(339),I(340),I(341),I(342),I(343),I(344),I(345),I(346),
6 I(347),I(348),I(349),I(350),I(351),I(352),I(353),I(354),
7 I(355),I(356),I(357),I(358),I(359),I(360),I(361),I(362),
8 I(363),I(364),I(365),I(366),I(367),I(368),I(369),I(370)/
1 7, 20, -560, 224, -112, -21, -56, 16,
1 0, 0, 0, 0, 0, 0, 0, 0,
1 3, 0, 0, -56, -448, 49, -64, -14,
2 0, 0, 0, 0, 0, 0, 0, 0,
3 0, 26, 308, 110, 220, 0, 0, 0,
4 7, -154, -28, -132, 0, 0, 0, 0,
5 0, -9, 297, 90, -405, 45, 0, 0,
6 3, 66, -507, -3, -60, 15, 0, 0,
7 0, 5, 315, -14, -175, -21, -56, -25,
8 0, 70, 385, -105, 28, 63, 0, 0/
DATA I(371),I(372),I(373),I(374),I(375),I(376),I(377),I(378),
1 I(379),I(380),I(381),I(382),I(383),I(384),I(385),I(386),
1 I(387),I(388),I(389),I(390),I(391),I(392),I(393),I(394),
2 I(395),I(396),I(397),I(398),I(399),I(400),I(401),I(402),
3 I(403),I(404),I(405),I(406),I(407),I(408),I(409),I(410),
4 I(411),I(412),I(413),I(414),I(415),I(416),I(417),I(418),
5 I(419),I(420),I(421),I(422),I(423),I(424),I(425),I(426),
6 I(427),I(428),I(429),I(430),I(431),I(432),I(433),I(434),
7 I(435)/
1 0, 0, 0, 315, 0, 0, 135, 0,
1 0, 189, 0, 0, 105, 0, 1, 0,
1 0, 0, 200, 15, 120, 60, -35, 10,
2 0, -25, 88, 200, 45, 20, 0, 1,
3 0, 0, 0, 16, -200, -14, -14, 25,
4 0, 0, 0, 120, -42, 42, 0, 0,
5 1, -105, -175, -175, -75, 0, 0, 0,
6 0, 0, 0, 0, 0, 0, 0, 0,
7 0/
DATA I(436),I(437),I(438),I(439),I(440),I(441),I(442),I(443),
1 I(444),I(445),I(446),I(447),I(448),I(449),I(450),I(451),
1 I(452),I(453),I(454),I(455),I(456),I(457),I(458),I(459),
2 I(460),I(461),I(462),I(463),I(464),I(465),I(466),I(467),
3 I(468),I(469),I(470),I(471),I(472),I(473),I(474),I(475),
4 I(476),I(477),I(478),I(479),I(480),I(481),I(482),I(483),
5 I(484),I(485),I(486),I(487),I(488),I(489),I(490),I(491),
6 I(492),I(493),I(494),I(495),I(496),I(497),I(498),I(499),
7 I(500),I(501),I(502),I(503),I(504),I(505),I(506),I(507),
8 I(508),I(509),I(510),I(511),I(512),I(513),I(514),I(515)/
1 154, -110, 0, 0, 231, 286, 924, -308,
1 220, -396, 0, 0, 0, 0, 0, 0,
1 -66, -90, 180, 0, 99, -99, 891,-5577,
2 -405, -9, 0, 45, 45, 0, 0, 0,
3 0, 224, 0, -56, 0, -220, 1680, 0,
4 112, 0, -21, 21, 0, -16, 0, 0,
5 -70, 14, -84, 56, 0, 55, 945, 4235,
6 -175, -315, 0, -21, 189, -25, 0, 0,
7 25, -15, -135, 35, 0, 0, 600, 968,
8 120, 600, 0, 60, 60, 10, 3, 0/
DATA I(516),I(517),I(518),I(519),I(520),I(521),I(522),I(523),
1 I(524),I(525),I(526),I(527),I(528),I(529),I(530),I(531),
1 I(532),I(533),I(534),I(535),I(536),I(537),I(538),I(539),
2 I(540),I(541),I(542),I(543),I(544),I(545),I(546),I(547),
3 I(548),I(549),I(550),I(551),I(552),I(553),I(554),I(555),
4 I(556),I(557),I(558),I(559),I(560),I(561),I(562),I(563),
5 I(564),I(565),I(566),I(567),I(568),I(569),I(570),I(571),
6 I(572),I(573),I(574),I(575),I(576),I(577),I(578),I(579),
7 I(580)/
1 0, -56, 0, -64, 0, 0, 0, 0,
1 448, 0, -9, -49, 0, 14, 0, 0,
1 0, -16, 126, 14, 0, 0, 0, 0,
2 -200, 360, 0, -14, 126, 25, 0, 0,
3 0, 0, 0, 0, -175, 182, -728,-2184,
4 0, 0, 0, 0, 0, 0, 0, 0,
5 0, 0, 0, 0, 0, 220, 880, 0,
6 -400, 0, -9, -25, 0, 0, 0, 0,
7 0/
DATA I(581),I(582),I(583),I(584),I(585),I(586),I(587),I(588),
1 I(589),I(590),I(591),I(592),I(593),I(594),I(595),I(596),
1 I(597),I(598),I(599),I(600),I(601),I(602),I(603),I(604),
2 I(605),I(606),I(607),I(608),I(609),I(610),I(611),I(612),
3 I(613),I(614),I(615),I(616),I(617),I(618),I(619),I(620),
4 I(621),I(622),I(623),I(624),I(625),I(626),I(627),I(628),
5 I(629),I(630),I(631),I(632),I(633),I(634),I(635),I(636),
6 I(637),I(638),I(639),I(640),I(641),I(642),I(643),I(644),
7 I(645),I(646),I(647),I(648),I(649),I(650),I(651),I(652),
8 I(653),I(654),I(655),I(656),I(657),I(658),I(659),I(660)/
1 0, 0, 0, -45, -5, 845,-1215, 275,
1 495, 0, -11, 99, 0, 0, 0, 0,
1 0, 0, 0, 0, 33, -7,-2541, 105,
2 -525, 0, 35, 35, -15, 0, 0, 0,
3 0, 0, 0, 0, 0, -800, 0, -160,
4 0, -5, 45, 0, 30, 0, 0, 0,
5 0, 0, 0, 0, 0, -100, 1452, 180,
6 -100, 0, -10, 90, 15, -2, 0, 0,
7 0, 0, 0, 0, 0, 0, 0, 0,
8 0, 6, 0, 0, 0, 0, 0, 0/
DATA I(661),I(662),I(663),I(664),I(665),I(666),I(667),I(668),
1 I(669),I(670),I(671),I(672),I(673),I(674),I(675),I(676),
1 I(677),I(678),I(679),I(680),I(681),I(682),I(683),I(684),
2 I(685),I(686),I(687),I(688),I(689),I(690),I(691),I(692),
3 I(693),I(694),I(695),I(696),I(697),I(698),I(699),I(700),
4 I(701),I(702),I(703),I(704),I(705),I(706),I(707),I(708),
5 I(709),I(710),I(711),I(712),I(713),I(714),I(715),I(716),
6 I(717),I(718),I(719)/
1 0, 0, 0, 0, 0, 0, 0, 0,
1 0, 0, -14, -56, 0, 0, 1, 1,
1 1, 1, 1, 5, 15, 2, 42, 70,
2 60, 140, 30, 10, 60, 1680, 840, 1680,
3 210, 360, 90, 10, 504, 1008, 560, 280,
4 140, 1, 1, 1, 420, 700, 700, 300,
5 550, 1100, 8400,18480, 2800, 2800, 50, 350,
6 700, 150, 5/
C
END
SUBROUTINE CFPD(N,IVI,LI,ISI,IVJ,LJ,ISJ,COEFP)
C
C
C THIS SUBROUTINE EVALUATES THE COEFFICIENTS OF FRACTIONAL PARENTAGE
C FOR EQUIVALENT D SHELL ELECTRONS FROM TABLES GIVEN IN J.C.SLATER
C QUANTUM THEORY OF ATOMIC STRUCTURE,VOLUME2,P350(1960)
C IN THE SUBROUTINE LIST N,THE NO.OF ELECTRONS,V THE SENIORITY QUAN
C TUM NO.,L THE ANGULAR MOMENTUM QUANTUM NO.,(2S+1) THE SPIN QUANTUM
C NO. OF BOTH THE STATE IN QUESTION AND ITS PARENT STATE ARE INPUT
C PARAMETERS THE RESULT IS OUTPUT AS COEFP
C
COMMON/FRPAR2/K(5),IV(5,16),IL(5,16),IS(5,16),ITAB1(5,1),ITAB2(8,5
1 ),ITAB3(16,8),ITAB4(16,16),NORM1(5),NORM2(8),NORM3(16),NORM4(16)
COMMON/INFORM/IREAD,IWRITE,IPUNCH
C
C
C TEST IF N IS IN THE FIRST HALF OF SHELL
C
99 IF(N-6) 40,103,103
C
C TEST IF STATE IN QUESTION IS ALLOWED
C IF IT IS, IDENTIFY THE ROW OF THE TABLE BY J1
C
40 J = 0
101 J = J+1
IF(J-17) 41,11,11
41 IF(IV(N,J)-IVI) 101,42,101
42 IF(IL(N,J)-LI) 101,43,101
43 IF(IS(N,J)-ISI) 101,44,101
44 J1=J
C
C TEST IF PARENT STATE IS ALLOWED
C IF IT IS, IDENTIFY THE COLUMN OF THE TABLE BY J2
C
IF(N-1) 45,30,45
30 IF(IVJ) 11,31,11
31 IF(LJ) 11,32,11
32 IF(ISJ-1) 11,1,11
45 J = 0
102 J = J+1
IF(J-17) 46,11,11
46 IF(IV(N-1,J)-IVJ) 102,47,102
47 IF(IL(N-1,J)-LJ) 102,48,102
48 IF(IS(N-1,J)-ISJ) 102,49,102
49 J2=J
GO TO 100
C
C SIMILAR SETTING OF J1 AND J2 IF N IS IN SECOND HALF OF SHELL
C
103 M = 10-N
IF(M) 36,33,36
33 IF(IVI) 11,34,11
34 IF(LI) 11,35,11
35 IF(ISI-1) 11,37,11
36 J = 0
104 J = J+1
IF(J-17) 50,11,11
50 IF(IV(M,J)-IVI) 104,51,104
51 IF(IL(M,J)-LI) 104,52,104
52 IF(IS(M,J)-ISI) 104,53,104
53 J1=J
37 J = 0
105 J = J+1
IF(J-17) 54,11,11
54 IF(IV(M+1,J)-IVJ) 105,55,105
55 IF(IL(M+1,J)-LJ) 105,56,105
56 IF(IS(M+1,J)-ISJ) 105,57,105
57 J2=J
C
C IDENTIFY THE F.P.C AS A UNIQUE ELEMENT OF ITABN(J1,J2)
C
100 GO TO (1,2,3,4,5,12,12,12,12,1),N
1 COEFP = 1.0
GO TO 10
2 COEFP = ITAB1(J1,J2)
IF(COEFP) 60,10,81
60 COEFP = - SQRT(-COEFP/NORM1(J1))
GO TO 10
81 COEFP = SQRT(COEFP/NORM1(J1))
GO TO 10
3 COEFP = ITAB2(J1,J2)
IF(COEFP) 61,10,82
61 COEFP = -SQRT(-COEFP/NORM2(J1))
GO TO 10
82 COEFP = SQRT(COEFP/NORM2(J1))
GO TO 10
4 COEFP = ITAB3(J1,J2)
IF(COEFP) 62,10,83
62 COEFP = -SQRT(-COEFP/NORM3(J1))
GO TO 10
83 COEFP = SQRT(COEFP/NORM3(J1))
GO TO 10
5 COEFP = ITAB4(J1,J2)
IF(COEFP) 63,10,84
63 COEFP = -SQRT(-COEFP/NORM4(J1))
GO TO 10
84 COEFP = SQRT(COEFP/NORM4(J1))
GO TO 10
C
C USE RECURRENCE RELATION EQUATION (19) OF RACAH FOR SECOND HALF OF
C SHELL
C
12 ISIGN = (-1)**((ISI+ISJ-7)/2 +LI +LJ)
FACTOR = SQRT(((11.0-N)*ISJ*(2*LJ+1.0))/(N*ISI*(2*LI+1.0)))
M1 =N-5
GO TO(6,7,8,9),M1
6 COEFP = ITAB4(J2,J1)
IF(COEFP) 64,10,85
64 COEFP = -SQRT(-COEFP/NORM4(J2))
GO TO 86
85 COEFP = SQRT(COEFP/NORM4(J2))
86 COEFP = COEFP*ISIGN*FACTOR
IF(MOD((IVJ-1)/2,2)) 87,10,87
87 COEFP = -COEFP
GO TO 10
7 COEFP = ITAB3(J2,J1)
IF(COEFP) 65,10,88
65 COEFP = -SQRT(-COEFP/NORM3(J2))
GO TO 89
88 COEFP = SQRT(COEFP/NORM3(J2))
89 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
8 COEFP = ITAB2(J2,J1)
IF(COEFP) 66,10,90
66 COEFP = -SQRT(-COEFP/NORM2(J2))
GO TO 91
90 COEFP = SQRT(COEFP/NORM2(J2))
91 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
9 COEFP = ITAB1(J2,J1)
IF(COEFP) 67,10,92
67 COEFP = -SQRT(-COEFP/NORM1(J2))
GO TO 93
92 COEFP = SQRT(COEFP/NORM1(J2))
93 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
C
C AN UNALLOWED STATE
C FOR AN UNALLOWED STATE THE F.P. COEFFICIENT IS SET EQUAL TO AN
C ERRONEOUS VALUE.BY REPLACING THE 11 COEFP=9.9 STATEMENT BY THE
C FOLLWING 3 CARDS THE USER CAN TERMINATE THE RUN WHEN AN
C UNALLOWED STATE OCCURS
C 106 FORMAT(37H FAIL IN CFPD AT 11 UNALLOWED STATE)
C 11 WRITE(IWRITE,106)
C PAUSE
C
11 COEFP=9.9
10 CONTINUE
RETURN
END
FINISH
****
1 INTO A LEVEL SCHEME ACCORDING TO THE COMBINATION PRINCIPLE.
2 WILLIAMS, I.R.
REF. IN COMP. PHYS. COMMUN. 1 (1970) 465
//IRW1 JOB 11059,MSGLEVEL=1,CLASS=C
//STEP EXEC COMPANGO,PARM.GO='DUMP=G',REGION.GO=150K
//FT63.FT50F001 DD *
**FTN,L,E,M,G.
C
C PROGRAM RITZ
C PROGRAM TO FIND ENERGY LEVELS
C (UTILISING THE RITZ COMBINATION PRINCIPLE).
C TO RUN ON THE ORNL IBM 360/91
C
C
REAL LEVEL(100)
DIMENSION GAMMA(300)
C
C READ BEGINNING ENERGY E, DECREMENTAL ENERGY DELTE,
C NUMBER OF STEPS NITER, UNCERTAINTY IN LEVEL ENERGY DLVL,
C NUMBER OF GAMMAS NGAMA, UNCERTAINTY IN GAMMA ENERGY DGAM,
C NUMBER OF LEVELS NLEVL, . . . ALL ON ONE DATA CARD.
C READ GAMMA(I) FROM NEXT CARDS
C READ LEVEL(J) FROM FINAL CARDS
C
READ (5,1) E,DELTE,NITER,NGAMA,NLEVL,DLVL,DGAM
1 FORMAT (2F6.2,3I6,2F6.2)
READ (5,2) (GAMMA(I),I=1,NGAMA)
READ (5,2) (LEVEL(J),J=1,NLEVL)
2 FORMAT (12F6.1)
WRITE (6,3) E,DELTE,NITER,NGAMA,NLEVL,DLVL,DGAM,(LEVEL(J),J=1,
C NLEVL)
3 FORMAT (1H1,56H E DELTE NITER NGAMMA NLEVEL DLVL
C DGAM//2F8.1,3I8,2F8.1///16H ENERGY LEVELS //(12F8.1/))
WRITE (6,4) (GAMMA(I),I=1,NGAMA)
4 FORMAT (///17H PHOTON ENERGIES //(12F8.1/))
WRITE (6,7)
7 FORMAT (1H ,//31H E LEVEL LEVEL(K) +,17X,11HLEVEL(KJ)
C-,16X,11HGAMMA(IJ) +/27X,8HGAMMA(L),17X,9HGAMMA(LI),18X,9HGAMMA(II
C)/)
C
C DOES E EQUAL A LEVEL ENERGY
C
N = 1
20 M = 0
DO 30 J = 1,NLEVL
IF (E - LEVEL(J) - DLVL)40,40,30
40 IF (E - LEVEL(J) + DLVL)30,60,60
30 CONTINUE
44 WRITE (6,45) E
45 FORMAT (F8.1)
GO TO 100
60 M = M + 1
WRITE (6,64) E,LEVEL(J)
64 FORMAT (2F8.1)
100 CONTINUE
C
C DOES E = LEVEL(K) + GAMMA(L)
C
DO 200 K = 1,NLEVL
DO 200 L = 1,NGAMA
IF (E - LEVEL(K)-DLVL - GAMMA(L)-DGAM)170,170,200
170 IF (E - LEVEL(K)+DLVL - GAMMA(L)+DGAM)200,190,190
190 IF (M - 1)198,196,198
196 W = LEVEL(J) - LEVEL(K) - GAMMA(L)
WRITE (6,197) LEVEL(K),GAMMA(L),W
197 FORMAT (19X,F8.1,2H +,F7.1,2X,1H(,F5.2,1H))
GO TO 200
198 WRITE (6,199) LEVEL(K),GAMMA(L)
199 FORMAT (19X,F8.1,2H +,F7.1)
200 CONTINUE
C
C DOES E = LEVEL(KJ) - GAMMA(LI)
C
DO 300 KJ = 1,NLEVL
DO 300 LI = 1,NGAMA
IF (E - LEVEL(KJ)-DLVL + GAMMA(LI)-DGAM)270,270,300
270 IF (E - LEVEL(KJ)+DLVL + GAMMA(LI)+DGAM)300,290,290
290 IF (M - 1)298,296,298
296 X = LEVEL(J) - LEVEL(KJ) + GAMMA(LI)
WRITE (6,297) LEVEL(KJ),GAMMA(LI),X
297 FORMAT (45X,F8.1,2H -,F7.1,2X,1H(,F5.2,1H))
GO TO 300
298 WRITE (6,299) LEVEL(KJ),GAMMA(LI)
299 FORMAT (45X,F8.1,2H -,F7.1)
300 CONTINUE
C
C DOES E = GAMMA(II) + GAMMA(IJ)
C
DO 400 IJ = 1,NGAMA
IJ1 = IJ + 1
DO 400 II = IJ1,NGAMA
IF (E - GAMMA(II)-DGAM - GAMMA(IJ)-DGAM)370,370,400
370 IF (E - GAMMA(II)+DGAM - GAMMA(IJ)+DGAM)400,390,390
390 IF (M - 1)398,396,398
396 Y = LEVEL(J) - GAMMA(IJ) - GAMMA(II)
WRITE (6,397) GAMMA(IJ),GAMMA(II),Y
397 FORMAT (72X,F8.1,2H +,F7.1,2X,1H(,F5.2,1H))
GO TO 400
398 WRITE (6,399) GAMMA(IJ),GAMMA(II)
399 FORMAT (72X,F8.1,2H +,F7.1)
400 CONTINUE
C
E = E - DELTE
N = N + 1
IF (N - NITER) 20,20,500
500 CALL EXIT
END
/*
//GO.FT06F001 DD SYSOUT=A
//GO.FT05F001 DD *
301000 1.0 20 21 9 0.40 0.50
50 2252 3986 4713 5052 5901 6699 8765 9382 10018 10385 10692
15517 15650 14313 16024 16177 16998 17032 17151 30010
00000 28016 28156 28305 28704 29280 29361 29960 30013
/*
//
ABWAHYDROGENIC INTERACTION INTEGRAL. A PROGRAM TO CALCULATE THE RADIAL
1 PARTS OF INTERACTION MATRIX ELEMENTS BETWEEN TWO HYDROGENIC WAVE
2 FUNCTIONS AS POWER SERIES. JAMIESON, M.J.
REF. IN COMP. PHYS. COMMUN. 1 (1970) 437
$ CDC 6400 END OF FILE CARD
JAM11,S81282,CM40K,DT10. CDC 6400 JOB CARD
RUN(S) CDC 6400 JOB CARD
LOAD(LGO) CDC 6400 JOB CARD
EXECUTE. CDC 6400 JOB CARD
$ CDC 6400 END OF RECORD CARD
PROGRAM HYDR(INPUT,OUTPUT,PUNCH,TAPE1 = INPUT,TAPE2 = OUTPUT)
C
C THIS PROGRAM TESTS SUBROUTINE HYD FOR HYDROGENIC WAVE FUNCTION
C INTEGRAL.
C
C THE PURPOSE OF SUBROUTINE HYD IS EXPLAINED AT THE BEGINNING OF IT'S
C LISTING.
C
C READS NA,LA,ZA,NB,LB,ZB,LAMBDA,IPRINT IN FORMAT(2I5,F5.1,2I5,F5.1,2I5)
C
C THE POWERS AND COEFFICIENTS IN THE HYDROGENIC WAVE FUNCTIONS AND IN
C THE INTEGRAL ARE PRINTED IF AND ONLY IF IPRINT = 1.
C
C THE PROGRAM HYDR CALLS SUBROUTINE HYD.
C THE SUBROUTINE HYD CALLS THE SUBROUTINE HYDRO.
C
C ATOMIC UNITS ARE USED THROUGHOUT.
C
C IR, IW ARE INPUT AND OUTPUT CHANNEL NUMBERS RESPECTIVELY
C
DIMENSION F(100),IPOWER(100)
COMMON/INPOUT/IR,IW
C
C SET INPUT, OUTPUT CHANNEL NUMBERS
C
IR = 1 $ IW = 2
WRITE(IW,98)
READ(IR,99) NA,LA,ZA,NB,LB,ZB,LAMBDA,IPRINT
CALL HYD(NA,LA,ZA,NB,LB,ZB,LAMBDA,IPRINT,FNOUT,LAM1,GAMMA,F,IPOWER
1)
98 FORMAT(1H1,116(1H*))
99 FORMAT(2I5,F5.1,2I5,F5.1,2I5)
CALL EXIT
END
SUBROUTINE HYD(NA,LA,ZA,NB,LB,ZB,LAMBDA,IPRINT,FNOUT,LAM1,GAMMA,F,
1POWER)
C
C THE INTEGRAL
C
C I = INTEGRAL(DX)*RAD(NA,LA,ZA/X)*((X1**LAMBDA)/(X2**(LAMBDA+1)))*
C RAD(NB,LB,ZB/X)*(X**2)
C
C WHERE X1 AND X2 ARE THE SMALLER AND LARGER OF X AND R, AND
C RAD(N,L,Z/X) DENOTES THE RADIAL PART OF THE HYDROGENIC WAVE FUNCTION
C (NLM) FOR NUCLEAR CHARGE Z, X BEING THE RADIAL COORDINATE, MAY BE
C WRITTEN IN THE FORM
C
C I = SUM(J)(F(J)*(R**(J-LAMBDA-2)*EXP(-R/GAMMA))
C + FNOUT*(R**(-LAMBDA-1))
C
C WHERE THE SUM OVER J RUNS FROM 1 TO (NA+NB+LAMBDA+1). THIS ROUTINE
C CALCULATES THE COEFFICIENTS F, FNOUT AND GAMMA.
C AT THE COMPLETION OF THIS ROUTINE
C FNOUT WILL BE IN STORE FNOUT
C -LAMBDA-1 WILL BE IN STORE LAM1
C GAMMA WILL BE IN STORE GAMMA
C F WILL BE IN STORE F(J)
C J-LAMBDA-2 WILL BE IN STORE IPOWER(J)
C
C THE INTEGRAL IS NEEDED IN THE CALCULATION OF THE MATRIX ELEMENT
C
C ((NA,LA,MA,ZA/X)/(1/MOD(X-R))/(NB,LB,MB,ZB/X))
C
C WHERE (N,L,M/R) DENOTES A HYDROGENIC WAVE FUNCTION. 1/MOD(X-R) MAY BE
C EXPANDED IN TERMS OF THE SPHERICAL HARMONICS OF THE VECTORS X AND R
C AND THE RADIAL COORDINATES X AND R.
C
C THE PROGRAM IS SET UP FOR A MAXIMUM VALUE FOR NA+NB+LAMBDA+1 OF 100
C IN IT'S DIMENSION STATEMENTS. FOR LARGER VALUES OF THIS INCREASE THE
C DIMENSIONS OF A, B, C, D, E, F, FAC, GAM AND IPOWER.
C
C THE POWERS AND COEFFICIENTS IN THE HYDROGENIC WAVE FUNCTIONS AND IN
C THE INTEGRAL ARE PRINTED IF AND ONLY IF IPRINT = 1.
C
C THE SUBROUTINE HYD CALLS THE SUBROUTINE HYDRO.
C
C ATOMIC UNITS ARE USED THROUGHOUT.
C
C IR, IW ARE INPUT AND OUTPUT CHANNEL NUMBERS RESPECTIVELY
C
DIMENSION A(100),B(100),C(100),D(100),E(100),F(100),GAM(100),
1IPOWER(100)
COMMON/FACT/FAC(100)
COMMON/INPOUT/IR,IW
C
C CALCULATE FACTORIALS. FAC(N) IS FACTORIAL(N-1)
C
NN3 = 3*(NA+NB)
FAC(1) = 1.0
DO 10 I = 2,NN3
10 FAC(I) = FAC(I-1)*FLOAT(I-1)
C
C CALCULATE COEFFICIENTS IN HYDROGENIC WAVE FUNCTIONS.
C A AND B ARE COEFFICIENTS IN THE HYDROGENIC WAVE FUNCTIONS.
C
CALL HYDRO(NA,LA,ZA,ALPHA,A,AA,IPRINT)
CALL HYDRO(NB,LB,ZB,BETA,B,BB,IPRINT)
C
C CALCULATE MISCELLANEOUS CONSTANTS
C
LAM = LAMBDA
NAB = NA+NB
LAM1 = -LAM-1
LL1 = LA+LB+1
LL2 = LA+LB+2
NLAM1 = NA+NB+LAM+1
NLAM2 = NA+NB-LAM
LA1 = LA-1
I2LAM1 = 2*LAM+1
I2LAM2 = 2*LAM+2
GAMMA = ALPHA*BETA/(ALPHA+BETA)
C
C CALCULATE POWERS OF GAMMA
C
GAM(1) = GAMMA
DO 9 I = 2,NN3
9 GAM(I) = GAM(I-1)*GAMMA
C
C CALCULATE C
C C, D, AND E ARE INTERMEDIATE QUANTITIES IN THE CALCULATION.
C
DO 30 IT = 1,LL1
30 C(IT) = 0.0
DO 11 IT = LL2,NAB
C(IT) = 0.0
IR1 = MAX0(LA+1,IT-NB)
IR2 = MIN0(NA,IT-LB-1)
DO 12 IX = IR1,IR2
12 C(IT) = C(IT)+A(IX)*B(IT-IX)
11 CONTINUE
C
C CALCULATE FNOUT
C
FNOUT = 0.0
DO 13 IT = LL2,NAB
13 FNOUT = FNOUT+C(IT)*FAC(IT+LAM+1)*GAM(IT+LAM+1)
FNOUT = FNOUT*AA*BB
IF(ABS(FNOUT).LE.1.0E-12) 1,2
1 FNOUT = 0.0
2 CONTINUE
C
C CALCULATE D
C
DO 14 IU = 1,NLAM1
D(IU) = 0.0
IU1 = IU-1-LAM
IUM = MAX0(LL2,IU1)
DO 15 IT = IUM,NAB
15 D(IU)=D(IU)-C(IT)*FAC(1+IT+LAM)*GAM(IT+LAM+2)/(FAC(IU)*GAM(IU))
14 CONTINUE
C
C CALCULATE E
C
DO 16 IU = 1,NLAM2
E(IU) = 0.0
IU1 = IU+LAM
IUM = MAX0(LL2,IU1)
DO 17 IT = IUM,NAB
17 E(IU) = E(IU)+C(IT)*FAC(IT-LAM)*GAM(IT+1)/(FAC(IU)*GAM(IU+LAM))
16 CONTINUE
C
C CALCULATE F AND SET UP TABLE OF POWERS OF R
C
DO 18 IV = 1,I2LAM1
IPOWER(IV) = IV-LAM-2
F(IV) = D(IV)*AA*BB
IF(ABS(F(IV)).LE.1.0E-12) 3,4
3 F(IV) = 0.0
4 CONTINUE
18 CONTINUE
DO 19 IV = I2LAM2,NLAM1
IPOWER(IV) = IV-LAM-2
F(IV) = (D(IV)+E(IV-2*LAM-1))*AA*BB
IF(ABS(F(IV)).LE.1.0E-12) 5,6
5 F(IV) = 0.0
6 CONTINUE
19 CONTINUE
C
C OUTPUT OF COEFFICIENTS, POWERS AND EXPONENTIAL COEFFICIENT
C
IF(IPRINT.EQ.1) 7,8
7 WRITE(IW,100) NA,LA,ZA,NB,LB,ZB,LAM,GAMMA,LAM1,FNOUT,(IPOWER(IV),
1F(IV),IV = 1,NLAM1)
WRITE(IW,101)
8 RETURN
100 FORMAT(/84H INTEGRAL(DX)*RAD(NA,LA,ZA/X)*((X1**LAMBDA)/(X2**(LAMBD
1A+1)))*RAD(NB,LB,ZB/X)*(X**2)//118H WHERE RAD(N,L,Z/X) DENOTES THE
2 RADIAL PART OF A HYDROGENIC WAVE FUNCTION, AND X1 AND X2 ARE THE
3SMALLER AND LARGER OF/36H X AND R, MAY BE WRITTEN IN THE FORM//
470H INTEGRAL = SUM(J)(F(J)*(R**IPOWER(J)))*EXP(-R/GAMMA))+FNOUT*(R
5**LAM1)//51H WHERE IPOWER(J) = J-LAMBDA-1 AND LAM1 = -LAMBDA-1.//
652H QUANTUM NUMBERS, NUCLEAR CHARGES AND LAMBDA FOLLOW./24H QUA
7NTUM NUMBER NA = ,I2/24H QUANTUM NUMBER LA = ,I2/24H NUCLEAR
8 CHARGE ZA = ,F4.1/24H QUANTUM NUMBER NB = ,I2/24H QUANTUM N
9UMBER LB = ,I2/24H NUCLEAR CHARGE ZB = ,F4.1/15X,9HLAMBDA = ,I2
1 //50H EXPONENTIAL FACTOR IS EXP(-R/GAMMA) WITH GAMMA = ,E13.6/47H
2 POWER OF R (LAM1) IN NON EXPONENTIAL TERM = , I3/48H COEFFICIEN
3T (FNOUT) OF NON EXPONENTIAL TERM = ,E13.6// 61H THE OTHER POWER
4S (IPOWER(J)) AND COEFFICIENTS (F(J)) FOLLOW./2X,5HPOWER,4X,11HCOE
5FFICIENT/(2X,I3,5X,E13.6)/)
101 FORMAT(/1X,116(1H*)/)
END
SUBROUTINE HYDRO(N,L,Z,ALPHA,A,AA,IPRINT)
C
C THIS ROUTINE CACULATES POWERS OF R, THE RADIAL COORDINATE, THEIR
C COEFFICIENTS AND THE COEFFICIENT IN THE EXPONENTIAL TERM FOR THE
C RADIAL PART OF A HYDROGENIC WAVE FUNCTION (NLM) WITH NUCLEAR CHARGE Z.
C
C THE WAVE FUNCTION, RAD(N,L,Z/R) (R(N,L/R) IN EYRING, WALTER AND
C KIMBALL'S NOTATION HAS THE FORM
C
C AA*(SUM(J)(A(J)*(R**J)))*EXP(-R/ALPHA)/R WHERE AA IS SUCH THAT
C A(N) = 1.0, AND ALPHA = N/Z.
C
C THE A'S ARE PROPORTIONAL TO THE LAGUERRE POLYNOMIAL COEFFICIENTS.
C
C THIS ROUTINE COULD BE USED BY ITSELF IF A LINE TO CALCULATE FAC(N) =
C FACTORIAL(N-1) WERE ADDED.
C
C THE POWERS AND COEFFICIENTS ARE PRINTED IF AND ONLY IF IPRINT = 1.
C
C ATOMIC UNITS ARE USED THROUGHOUT.
C
C IR, IW ARE INPUT AND OUTPUT CHANNEL NUMBERS RESPECTIVELY
C
DIMENSION A(100)
COMMON/INPOUT/IR,IW
COMMON/FACT/FAC(100)
A(N) = 1.0
IF(N-L-1) 1,3,2
1 WRITE(IW,99)
99 FORMAT(34H ERROR. N WAS LESS THAN L+1. EXIT.)
CALL EXIT
2 NL1 = N-L-1
DO 20 I = 1,NL1
20 A(N-I) = -A(N-I+1)*FLOAT((L+N+1-I)*(N-L-I)*N)/FLOAT(2*I)
3 IF(L.EQ.0) 6,7
7 DO 21 I = 1,L
21 A(I) = 0.0
6 CONTINUE
C
C CALCULATE OUTSIDE FACTOR AA
C
AA = -SQRT((Z)/((FAC(N+L+1)*FAC(N-L))))*((2.0*Z/FLOAT(N))**N)/FLOA
1T(N)
NA = (N-L)/2
IF(2*NA+L-N) 4,5,4
4 AA = -AA
5 CONTINUE
C
C EXPONENTIAL COEFFICIENT
C
ALPHA = FLOAT(N)/Z
C
C OUTPUT OF COEFFICIENTS, POWERS AND EXPONENTIAL COEFFICIENT
C
IF(IPRINT.EQ.1) 8,9
8 WRITE(IW,101) Z,N,L,ALPHA,AA,(I,A(I),I = 1,N)
WRITE(IW,102)
101 FORMAT(/45H HYDROGEN WAVE FUNCTION --- NUCLEAR CHARGE = ,F4.1/
129H QUANTUM NUMBERS N AND L ARE ,2I3//99H THE INFORMATION GIVEN RE
2FERS TO R*RADIAL PART OF THE WAVE FUNCTION, R BEING THE RADIAL COO
3RDINATE.//48H THE EXPONENTIAL FACTOR IS R/ALPHA WITH ALPHA = ,E13.
46//76H THE OUTSIDE CONSTANT (ARRANGED SO THAT THE COEFFICIENT OF R
5**N IS UNITY) = , E13.6/78H I.E. ALL COEFFICIENTS SHOULD BE MULTIP
6LIED BY THIS CONSTANT IN A CALCULATION./90H THE WAVE FUNCTION HAS
7THE FORM (OUTSIDE FACTOR)*(POWER SERIES IN R)*(EXPONENTIAL FACTOR)
8.//36H THE POWERS AND COEFFICIENTS FOLLOW./2X,5HPOWER,4X,11HCOEFFI
9CIENT/(2X,I3,5X,E13.6)/)
102 FORMAT(/1X,116(1H-))
9 RETURN
END
$ CDC 6400 END OF RECORD CARD
3 1 1.0 2 1 1.0 1 1
$ CDC 6400 END OF FILE CARD
ACQCD SHELL C.F.P.. FRACTIONAL PARENTAGE COEFFICIENTS FOR EQUIVALENT P
1 SHELL AND EQUIVALENT D SHELL ELECTRONS. ALLISON, D.C.S.
REF. IN COMP. PHYS. COMMUN. 1 (1969) 16
$IBM.
$FORTRAN.
MASTER DSHELLTEST
C
C
C TO EVALUATE THE F.P. COEFFICIENTS OF ALL POSSIBLE PARENT STATES
C ALLOWED BY ONE INPUT STATE. THE SUM OF THE SQUARES OF THE ALLOWED
C COEFFICIENTS IS CHECKED WITH UNITY
C
C
C INITIALIZE TEN SETS OF INPUT DATA
C
DIMENSION N(10),IV(10),IL(10),IS(10)
DATA N(1),IV(1),IL(1),IS(1)/1,1,2,2/,
1 N(2),IV(2),IL(2),IS(2)/2,2,2,1/,
2 N(3),IV(3),IL(3),IS(3)/3,3,3,2/,
3 N(4),IV(4),IL(4),IS(4)/4,2,3,3/,
4 N(5),IV(5),IL(5),IS(5)/5,5,4,2/,
5 N(6),IV(6),IL(6),IS(6)/6,4,3,1/,
6 N(7),IV(7),IL(7),IS(7)/7,3,1,4/,
7 N(8),IV(8),IL(8),IS(8)/8,2,1,3/,
8 N(9),IV(9),IL(9),IS(9)/9,1,2,2/,
9 N(10),IV(10),IL(10),IS(10)/10,0,0,1/
C
10 FORMAT (3H N=,I1,2X,4H VI=,I1,2X,4H LI=,I1,2X,4H SI=,I1,5X,4H VJ=,
1I1,2X,4H LJ=,I1,2X,4H SJ=,I1,5X,6H CFPD=,F12.8)
11 FORMAT (3H N=,I1,2X,4H VI=,I1,2X,4H LI=,I1,2X,4H SI=,I1,5X,5H SUM=
1,F12.8///)
14 FORMAT (24H STATE IN QUESTION,19H PARENT STATE)
15 FORMAT (1H1 ,20H D SHELL F.P.C. TEST,////)
WRITE (2,15)
C
C TAKE INPUT STATE IN QUESTION FROM DATA STATEMENT
C
DO 1 I=1,10
WRITE (2,14)
SUM = 0.0
C
C SEARCH FOR ALLOWED PARENT STATES
C
DO 5 IVJ =0,5
DO 6 LJ =0,6
DO 7 ISJ =1,6
CALL CFPD(N(I),IV(I),IL(I),IS(I),IVJ,LJ,ISJ,COEFP)
IF(COEFP-9.9) 8,7,8
8 SUM =SUM +COEFP**2
WRITE (2,10) N(I),IV(I),IL(I),IS(I),IVJ,LJ,ISJ,COEFP
7 CONTINUE
6 CONTINUE
5 CONTINUE
C
IF(SUM) 1,1,12
12 WRITE (2,11) N(I),IV(I),IL(I),IS(I),SUM
1 CONTINUE
STOP
END
SUBROUTINE CFPD(N,IVI,LI,ISI,IVJ,LJ,ISJ,COEFP)
C
C
C THIS SUBROUTINE EVALUATES THE COEFFICIENTS OF FRACTIONAL PARENTAGE
C FOR EQUIVALENT D SHELL ELECTRONS FROM TABLES GIVEN IN J.C.SLATER
C QUANTUM THEORY OF ATOMIC STRUCTURE,VOLUME2,P350(1960)
C IN THE SUBROUTINE LIST N,THE NO.OF ELECTRONS,V THE SENIORITY QUAN
C TUM NO.,L THE ANGULAR MOMENTUM QUANTUM NO.,(2S+1) THE SPIN QUANTUM
C NO. OF BOTH THE STATE IN QUESTION AND ITS PARENT STATE ARE INPUT
C PARAMETERS THE RESULT IS OUTPUT AS COEFP
C
C
DIMENSION K(5),IV(5,16),IL(5,16),IS(5,16),
1 ITAB1(5,1),ITAB2(8,5),ITAB3(16,8),ITAB4(16,16),
2 NORM1(5),NORM2(8),NORM3(16),NORM4(16)
C
21 FORMAT (5I2)
22 FORMAT (46I1)
23 FORMAT (5I1)
24 FORMAT (15I4)
25 FORMAT (12I5)
26 FORMAT (8I3)
C
IF(RINDEX-99.11) 98,99,98
98 RINDEX = 99.11
C
C READ IN D SHELL PARAMETERS AND TABLES
C PERIPHERAL 1 IS THE CARD READER
C
READ (1,21) (K(I),I=1,5)
READ (1,22) ((IV(I,J),J=1,K(I)) I=1,5)
READ (1,22) ((IL(I,J),J=1,K(I)) I=1,5)
READ (1,22) ((IS(I,J),J=1,K(I)) I=1,5)
READ (1,23) (ITAB1(I,1),I=1,K(2))
READ (1,24) ((ITAB2(I,J),J=1,K(2)) I=1,K(3))
READ (1,24) ((ITAB3(I,J),J=1,K(3)) I=1,K(4))
READ (1,25) ((ITAB4(I,J),J=1,K(4)) I=1,K(5))
READ (1,23) (NORM1(I),I=1,K(2))
READ (1,26) (NORM2(I),I=1,K(3))
READ (1,25) (NORM3(I),I=1,K(4))
READ (1,25) (NORM4(I),I=1,K(5))
C
C TEST IF N IS IN THE FIRST HALF OF SHELL
C
99 IF(N-6) 40,103,103
C
C TEST IF STATE IN QUESTION IS ALLOWED
C IF IT IS, IDENTIFY THE ROW OF THE TABLE BY J1
C
40 J = 0
101 J = J+1
IF(J-17) 41,11,11
41 IF(IV(N,J)-IVI) 101,42,101
42 IF(IL(N,J)-LI) 101,43,101
43 IF(IS(N,J)-ISI) 101,44,101
44 J1=J
C
C TEST IF PARENT STATE IS ALLOWED
C IF IT IS, IDENTIFY THE COLUMN OF THE TABLE BY J2
C
IF(N-1) 45,30,45
30 IF(IVJ) 11,31,11
31 IF(LJ) 11,32,11
32 IF(ISJ-1) 11,1,11
45 J = 0
102 J = J+1
IF(J-17) 46,11,11
46 IF(IV(N-1,J)-IVJ) 102,47,102
47 IF(IL(N-1,J)-LJ) 102,48,102
48 IF(IS(N-1,J)-ISJ) 102,49,102
49 J2=J
GO TO 100
C
C SIMILAR SETTING OF J1 AND J2 IF N IS IN SECOND HALF OF SHELL
C
103 M = 10-N
IF(M) 36,33,36
33 IF(IVI) 11,34,11
34 IF(LI) 11,35,11
35 IF(ISI-1) 11,37,11
36 J = 0
104 J = J+1
IF(J-17) 50,11,11
50 IF(IV(M,J)-IVI) 104,51,104
51 IF(IL(M,J)-LI) 104,52,104
52 IF(IS(M,J)-ISI) 104,53,104
53 J1=J
37 J = 0
105 J = J+1
IF(J-17) 54,11,11
54 IF(IV(M+1,J)-IVJ) 105,55,105
55 IF(IL(M+1,J)-LJ) 105,56,105
56 IF(IS(M+1,J)-ISJ) 105,57,105
57 J2=J
C
C IDENTIFY THE F.P.C AS A UNIQUE ELEMENT OF ITABN(J1,J2)
C
100 GO TO (1,2,3,4,5,12,12,12,12,1),N
1 COEFP = 1.0
GO TO 10
2 COEFP = ITAB1(J1,J2)
IF(COEFP) 60,10,81
60 COEFP = - SQRT(-COEFP/NORM1(J1))
GO TO 10
81 COEFP = SQRT(COEFP/NORM1(J1))
GO TO 10
3 COEFP = ITAB2(J1,J2)
IF(COEFP) 61,10,82
61 COEFP = -SQRT(-COEFP/NORM2(J1))
GO TO 10
82 COEFP = SQRT(COEFP/NORM2(J1))
GO TO 10
4 COEFP = ITAB3(J1,J2)
IF(COEFP) 62,10,83
62 COEFP = -SQRT(-COEFP/NORM3(J1))
GO TO 10
83 COEFP = SQRT(COEFP/NORM3(J1))
GO TO 10
5 COEFP = ITAB4(J1,J2)
IF(COEFP) 63,10,84
63 COEFP = -SQRT(-COEFP/NORM4(J1))
GO TO 10
84 COEFP = SQRT(COEFP/NORM4(J1))
GO TO 10
C
C USE RECURRENCE RELATION EQUATION (19) OF RACAH FOR SECOND HALF OF
C SHELL
C
12 ISIGN = (-1)**((ISI+ISJ-7)/2 +LI +LJ)
FACTOR = SQRT(((11.0-N)*ISJ*(2*LJ+1.0))/(N*ISI*(2*LI+1.0)))
M1 =N-5
GO TO(6,7,8,9),M1
6 COEFP = ITAB4(J2,J1)
IF(COEFP) 64,10,85
64 COEFP = -SQRT(-COEFP/NORM4(J2))
GO TO 86
85 COEFP = SQRT(COEFP/NORM4(J2))
86 COEFP = COEFP*ISIGN*FACTOR
IF(MOD((IVJ-1)/2,2)) 87,10,87
87 COEFP = -COEFP
GO TO 10
7 COEFP = ITAB3(J2,J1)
IF(COEFP) 65,10,88
65 COEFP = -SQRT(-COEFP/NORM3(J2))
GO TO 89
88 COEFP = SQRT(COEFP/NORM3(J2))
89 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
8 COEFP = ITAB2(J2,J1)
IF(COEFP) 66,10,90
66 COEFP = -SQRT(-COEFP/NORM2(J2))
GO TO 91
90 COEFP = SQRT(COEFP/NORM2(J2))
91 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
9 COEFP = ITAB1(J2,J1)
IF(COEFP) 67,10,92
67 COEFP = -SQRT(-COEFP/NORM1(J2))
GO TO 93
92 COEFP = SQRT(COEFP/NORM1(J2))
93 COEFP = COEFP * ISIGN * FACTOR
GO TO 10
C
C FOR AN UNALLOWED STATE THE F.P. COEFFICIENT IS SET EQUAL TO AN
C ERRONEOUS VALUE. THIS STATEMENT COULD BE REPLACED BY AN ERROR
C STATEMENT
C
11 COEFP =9.9
10 CONTINUE
RETURN
END
FINISH
$DATA.
1 5 81616
1222203333313344424424424424045535353353513535
2314203154322125433211644322000432165443322210
2331114422222253333333111111116444422222222222
11111
4 -1 0 0 0 -7 -8 0 0 0 -1 0 1 0 0
21 0 11 -10 0 7 28 -25 -10 0 -21 -9 -9 -5 16
21 -49 -25 45 0 -8 7 0 15 0
7 3 0 0 0 0 0 0 20 0 26 -9 5 0 0
0-560 0 308 297 315 0 200 0 224 -56 110 90 -14 315
15 16-112-448 220-405-175 0 120-200 -21 49 0 45 -21
0 60 -14 -56 -64 0 0 -56 135 -35 -14 16 -14 0 0
-25 0 10 25 0 0 7 3 0 0 0 0 0 0-154
66 70 189 -25 0 0 0 -28-507 385 0 88 0 0 0
-132 -3-105 0 200 120 0 0 0 -60 28 105 45 -42 0
0 0 15 63 0 20 42 0 0 0 0 0 1 0 0
0 0 0 0 0 0 1 0
1 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 -105 154 -66 0 -70 25 0 0
0 0 0 0 0 0 0 0 -175 -110 -90 224
14 -15 -56 -16 0 0 0 0 0 0 0 0
-175 0 180 0 -84 -135 0 126 0 0 0 0
0 0 0 0 -75 0 0 -56 56 35 -64 14
0 0 0 0 0 0 0 0 0 231 99 0
0 0 0 0 -175 0 -45 0 0 0 0 0
0 286 -99 -220 55 0 0 0 182 220 -5 33
0 0 0 0 0 924 891 1680 945 600 0 0
-728 880 845 -7 -800 -100 0 0 0 -308-5577 0
4235 968 0 0-2184 0-1215-2541 0 1452 0 0
0 220 -405 112 -175 120 448 -200 0 -400 275 105
-160 180 0 0 0 -396 -9 0 -315 600 0 360
0 0 495 -525 0 -100 0 0 0 0 0 -21
0 0 -9 0 0 -9 0 0 -5 0 6 0
0 0 45 21 -21 60 -49 -14 0 -25 -11 35
45 -10 0 -14 0 0 45 0 189 60 0 126
0 0 99 35 0 90 0 -56 0 0 0 -16
-25 10 14 25 0 0 0 -15 30 15 0 0
0 0 0 0 0 3 0 0 0 0 0 0
0 -2 0 0
11111
5 15 2 42 70 60140 30
10 60 1680 840 1680 210 360 90 10 504 1008 560
280 140 1 1
1 420 700 700 300 550 1100 840018480 2800 2800 50
350 700 150 5
ACRYF SHELL C.F.P.. FRACTIONAL PARENTAGE COEFFICIENTS FOR EQUIVALENT F
1 SHELL ELECTRONS. ALLISON, D.C.S., MCNULTY, J.E.
REF. IN COMP. PHYS. COMMUN. 8 (1974) 246
JOB CFPF,$ACBJ,A0385
INPUTRECORDS 1000
OUTPUTRECORDS 1000
MILL 50SECS
CORE 32K
TRANSFERS 600
INTO CFPFSOURCE
INTO CFPFDATA
INTO CFPFIN
FORTRAN GC,SS/ATLAS/CFPFSOURCE,SS/ATLAS/CFPFDATA
ER CFPFSOURCE
RUN CR0/CFPFIN,LP0/
****
LIST
PROGRAM(CFPF)
INPUT 1 = CR0
OUTPUT 2 = LP0
TRACE 2
END
MASTER FSHELL
C
C THIS DRIVER ROUTINE READS A SEQUENCE OF F SHELL STATES AND
C EVALUATES THE FRACTIONAL PARENTAGE COEFFICIENTS OF ALL POSSIBLE
C PARENT STATES ALLOWED BY THE INPUT STATES. THE SUM OF THE
C SQUARES OF THE ALLOWED COEFFICIENTS IS CHECKED WITH UNITY.
C
COMMON/FARRAY/F0(1),F1(1),F2(7),F3(17),F4(47),F5(73),F6(119),
1 F7(119)
COMMON/INFORM/IREAD,IWRITE,IPUNCH
COMMON/PARAMS/IV,IW,IU,IA,IVP,IWP,IUP,IAP
COMMON/STATES/SYL(13),SYA(3),NS(15)
DATA EPS,ZERO/1.0E-8,0.0E1/
C
100 FORMAT(14I4)
101 FORMAT(13A1)
102 FORMAT(4I3)
200 FORMAT(1H1,//,44X,20H F SHELL C.F.P. TEST///)
201 FORMAT(29X,16H DAUGHTER STATES,14X,14H PARENT STATES/)
202 FORMAT(24X,27H N S L P V W U ,4X,
1 23H S L P V W U ,8X,12H C.F.P. /)
203 FORMAT(25X,I2,3X,I1,1X,A1,1X,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),
1 7X,I1,1X,A1,1X,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),11X,F11.8)
204 FORMAT(56X,I2,1X,A1,1X,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),11X
1 ,F11.8)
205 FORMAT(38X,31H SUM OF COEFFICIENTS SQUARED = ,F11.8/)
C
IREAD=1
IWRITE=2
C
READ(IREAD,100)(NS(I),I=1,14)
READ(IREAD,101)(SYL(I),I=1,13)
READ(IREAD,101)(SYA(I),I=1,3)
C N
C WRITE OUT TABLE OF POSSIBLE F STATES. THIS MAY BE USED TO
C IDENTIFY THE IP PARAMETER OF A STATE WITH GIVEN IS AND IL .
C
CALL FTABLE
C
WRITE(IWRITE,200)
WRITE(IWRITE,201)
WRITE(IWRITE,202)
C
C READ IN SEQUENCE OF INPUT STATES
C
DO 10 I=1,14
READ(IREAD,102) N,IS,IL,IP
NSTATS=NS(N)
C
C N-1
C SUM OVER ALL F STATES
C
SUMSQ=ZERO
DO 11 J=1,NSTATS
GO TO (1,2,3,4,5,6,7,8,7,6,5,4,3,2),N
1 NP=F0(J)
GO TO 12
2 NP=F1(J)
GO TO 12
3 NP=F2(J)
GO TO 12
4 NP=F3(J)
GO TO 12
5 NP=F4(J)
GO TO 12
6 NP=F5(J)
GO TO 12
7 NP=F6(J)
GO TO 12
8 NP=F7(J)
C
C USE FARRAY VALUES TO FIND IP, IS AND IL VALUES OF PARENT STATE
C
12 IF(NP.LT.999) GO TO 13
ISP=NP/1000
IF(NP/10*10.EQ.NP) GO TO 14
ILP=(NP-ISP*1000)/10
IPP=NP-ISP*1000-ILP*10
GO TO 15
14 ILP=(NP-ISP*1000)/100
IPP=10
GO TO 15
13 ISP=NP/100
ILP=(NP-ISP*100)/10
IPP=NP-ISP*100-ILP*10
C
15 CALL CFPF(N,IP,IS,IL,IPP,ISP,ILP,CFP)
C
IF(ABS(CFP).LT.EPS) GO TO 11
SUMSQ=SUMSQ+CFP*CFP
SLP=SYL(ILP+1)
IF(ABS(SUMSQ-CFP*CFP).GT.EPS) GO TO 16
SL=SYL(IL+1)
WRITE(IWRITE,203)N,IS,SL,IP,IV,IW,IU,ISP,SLP,IPP,IVP,IWP,IUP,CFP
GO TO 11
16 WRITE(IWRITE,204)ISP,SLP,IPP,IVP,IWP,IUP,CFP
11 CONTINUE
C
C WRITE OUT SUM OF SQUARES OF ALLOWED COEFFICIENTS
C
WRITE(IWRITE,205) SUMSQ
10 CONTINUE
STOP
END
SUBROUTINE FTABLE
C
C TABULAR OUTPUT OF F SHELL STATES
C
DIMENSION IS(119),IL(119),IP(119),IV(119),IW(119),IU(119),IA(119),
1 S(119)
COMMON/FARRAY/F0(1),F1(1),F2(7),F3(17),F4(47),F5(73),F6(119),
1 F7(119)
COMMON/INFORM/IREAD,IWRITE,IPUNCH
COMMON/POINTR/IPT(981)
COMMON/STATES/SYL(13),SYA(3),NS(15)
C
200 FORMAT(///,50X,12H STATES OF F,I1//)
201 FORMAT(15X,4(I1,A1,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),A1,4X))
202 FORMAT(15X,2(I1,A1,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),A1,4X)
1 ,(I1,A1,I2,2X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),A1,4X)
2 ,(I1,A1,I1,3X,I1,1X,1H(,I3,1H),1X,1H(,I2,1H),A1,4X))
203 FORMAT(1H1,//,40X,33H TABLE OF POSSIBLE F SHELL STATES)
C
WRITE(IWRITE,203)
C
DO 11 J=1,8
JM1=J-1
WRITE(IWRITE,200)JM1
NSTATS=NS(J)
C
C LOOP OVER ALL POSSIBLE STATES
C
DO 12 I=1,NSTATS
GO TO (1,2,3,4,5,6,7,8),J
1 NP=F0(I)
GO TO 9
2 NP=F1(I)
GO TO 9
3 NP=F2(I)
GO TO 9
4 NP=F3(I)
GO TO 9
5 NP=F4(I)
GO TO 9
6 NP=F5(I)
GO TO 9
7 NP=F6(I)
GO TO 9
8 NP=F7(I)
C
C DECODE IS,IL AND IP VALUES FROM FARRAY VALUES
C
9 IF(NP.LT.999) GO TO 10
IS(I)=NP/1000
IF(NP/10*10.EQ.NP) GO TO 20
IL(I)=(NP-IS(I)*1000)/10
IP(I)=NP-IS(I)*1000-IL(I)*10
GO TO 30
20 IL(I)=(NP-IS(I)*1000)/100
IP(I)=10
GO TO 30
10 IS(I)=NP/100
IL(I)=(NP-IS(I)*100)/10
IP(I)=NP-IS(I)*100-IL(I)*10
C
C DECODE IV,IW,IU,IA VALUES FROM POINTER TABLE
C
30 IPOINT=(IS(I)-1)*130+IL(I)*10+IP(I)
IV(I)=IPT(IPOINT)/1000000
IW(I)=(IPT(IPOINT)-IV(I)*1000000)/1000
IU(I)=(IPT(IPOINT)-IV(I)*1000000-IW(I)*1000)/10
IA(I)=IPT(IPOINT)-IV(I)*1000000-IW(I)*1000-IU(I)*10
S(I)=SYA(1)
IF(IA(I).NE.2) GO TO 12
S(I-1)=SYA(2)
S(I)=SYA(3)
12 CONTINUE
C
C WRITE OUT TABLE IN FORMAT SIMILAR TO NIELSON AND KOSTER (REF 7)
C
IF(NSTATS.EQ.1) GO TO 15
NL=NSTATS/4+1
NEL=NL*4-NSTATS
NFL=NL-NEL
DO 13 I=1,NL
I1=I+NL
I2=I1+NL
L=IL(I)+1
L1=IL(I1)+1
L2=IL(I2)+1
IF(I.GT.NFL) GO TO 16
I3=I2+NL
L3=IL(I3)+1
IF(IP(I2).EQ.10) GO TO 14
WRITE(IWRITE,201)IS(I),SYL(L),IP(I),IV(I),IW(I),IU(I),S(I)
1 ,IS(I1),SYL(L1),IP(I1),IV(I1),IW(I1),IU(I1),S(I1)
2 ,IS(I2),SYL(L2),IP(I2),IV(I2),IW(I2),IU(I2),S(I2)
3 ,IS(I3),SYL(L3),IP(I3),IV(I3),IW(I3),IU(I3),S(I3)
GO TO 13
14 WRITE(IWRITE,202)IS(I),SYL(L),IP(I),IV(I),IW(I),IU(I),S(I)
1 ,IS(I1),SYL(L1),IP(I1),IV(I1),IW(I1),IU(I1),S(I1)
2 ,IS(I2),SYL(L2),IP(I2),IV(I2),IW(I2),IU(I2),S(I2)
3 ,IS(I3),SYL(L3),IP(I3),IV(I3),IW(I3),IU(I3),S(I3)
GO TO 13
16 WRITE(IWRITE,201)IS(I),SYL(L),IP(I),IV(I),IW(I),IU(I),S(I)
1 ,IS(I1),SYL(L1),IP(I1),IV(I1),IW(I1),IU(I1),S(I1)
2 ,IS(I2),SYL(L2),IP(I2),IV(I2),IW(I2),IU(I2),S(I2)
13 CONTINUE
GO TO 11
15 L=IL(1)+1
WRITE(IWRITE,201)IS(1),SYL(L),IP(1),IV(1),IW(1),IU(1),S(1)
11 CONTINUE
C
RETURN
END
SUBROUTINE CFPF(N,IP,IS,IL,IPP,ISP,ILP,CFP)
C
C F-SHELL FRACTIONAL PARENTAGE COEFFICIENT ROUTINE
C
C *****************************************************************
C
C PARAMETER IDENTIFICATION
C
C *****************************************************************
C
C THE FOLLOWING PARAMETERS PERTAIN TO THE DAUGHTER STATE
C
C N THE NUMBER OF ELECTRONS IN THE F-SHELL
C
C IP THE LABEL ASSOCIATED WITH THE STATE SEE FTABLE OUTPUT
C
C IS THE 2*S+1 VALUE,WHERE S IS THE TOTAL SPIN
C
C IL THE L VALUE,WHERE L IS THE TOTAL ORBITAL ANG.MOMENTUM
C
C THE REMAINING PARAMETERS IPP,ISP,ILP, PERTAIN TO THE
C PARENT TERM AND ARE SIMILARLY DEFINED.
C
C CFP THE FRACTIONAL PARENTAGE COEFFICIENT
C
C *****************************************************************
C
C DIMENSION AND COMMON STATEMENTS
C
C *****************************************************************
C
COMMON/INFORM/IREAD,IWRITE,IPUNCH
COMMON/FBLOCK/CFPFT1(84),CFPFT2(287),CFPFT3(1246),ID1(84),
1 ID2(287),ID3(1246),IF2(11),IF3(43)
COMMON/PARAMS/IV,IW,IU,IA,IVP,IWP,IUP,IAP
COMMON/POINTR/IPT(981)
DATA EPS,ZERO,ONE,ITEST/1.0E-8,0.0E1,0.1E1,1/
C
C *****************************************************************
C
C FORMAT STATEMENTS
C
C *****************************************************************
C
1000 FORMAT(//42H ERROR IN EVALUATION TERM1 IN CFPF FOR IS=,I2,4H IW=,I
13,5H ISP=,I2,5H ISW=,I3/)
2000 FORMAT(//42H ERROR IN EVALUATING TERM2 IN CFPF FOR IW=,I3,4H IU=,I
12,5H IWP=,I3,5H IUP=,I2/)
3000 FORMAT(//42H ERROR IN EVALUATING TERM3 IN CFPF FOR IU=,I2,4H IL=,I
12,5H IUP=,I2,5H ILP=,I2,/)
4000 FORMAT(/43H ERROR IN EITHER L OR S VALUES IN CFPF, IL=,I2,5H ILP=,
1I2,4H IS=,I2,5H ISP=,I2/)
5000 FORMAT(/43H ERROR IN EITHER W OR U VALUES IN CFPF, IW=,I3,5H IWP=,
1I2,4H IU=,I2,5H IUP=,I3/)
C
ISWT=1
C
C TESTS ON L AND S
C
IF(IABS(IL-ILP).GT.3) GO TO 902
IF((IL+ILP).LT.3) GO TO 902
IF(IABS(IS-ISP).GT.1) GO TO 902
C
C
C THIS SECTION TAKES THE IS, IL AND IP VALUES AND CALCULATES THE
C IV, IW, IU AND IA VALUES OF BOTH DAUGHTER AND PARENT STATES
C
C IV THE SENIORITY NUMBER
C
C IU THE G2 GROUP REPRESENTATION SYMBOL
C
C IW THE R7 GROUP REPRESENTATION SYMBOL
C
C IA THE A OR B DEGENERACY IDENTIFIER, FOR A IA=1, FOR B
C IA=2 ... IN NON-DEGENERATE CASES IA=1 ALSO
C
C
IPOINT=(IS-1)*130+IL*10+IP
IVWU=IPT(IPOINT)
IV=IVWU/1000000
IW=(IVWU-IV*1000000)/1000
IU=(IVWU-IV*1000000-IW*1000)/10
IA=IVWU-IV*1000000-IW*1000-IU*10
IPOINT=(ISP-1)*130+ILP*10+IPP
IVWUP=IPT(IPOINT)
IVP=IVWUP/1000000
IWP=(IVWUP-IVP*1000000)/1000
IUP=(IVWUP-IVP*1000000-IWP*1000)/10
IAP=IVWUP-IVP*1000000-IWP*1000-IUP*10
C
C TEST IF N IS IN THE FIRST HALF OF THE SHELL
C
IF(N.LT.8) GO TO 2
CALL SECHAF(N,IS,IL,ISP,ILP,ISWT,CONST)
ISWT=2
GO TO 3
2 CONST=ONE
C
C DECODE IW,IWP,IU AND IUP
C
3 IW1=IW/100
IW2=(IW-100*IW1)/10
IW3=IW-100*IW1-10*IW2
IWP1=IWP/100
IWP2=(IWP-100*IWP1)/10
IWP3=IWP-100*IWP1-10*IWP2
ISUM=IABS(IW1-IWP1)+IABS(IW2-IWP2)+IABS(IW3-IWP3)
IF(ISUM.GT.1) GO TO 903
IU1=IU/10
IU2=IU-10*IU1
IUP1=IUP/10
IUP2=IUP-10*IUP1
II1=IABS(IU1-IUP1)
II2=IABS(IU2-IUP2)
IF(II1.GT.1.OR.II2.GT.1) GO TO 903
C
C *****************************************************************
C
C CFP = TERM1*TERM2*TERM3*CONST
C
C *****************************************************************
C
C EVALUATION OF TERM1
C
C DETERMINE JSW AND JSWP
C
IF(IW2.GT.0) IW2=IW2+1
IF(IW3.GT.0) IW3=IW3+2
JW=IW1+IW2+IW3+1
JSW=10*(IS-1)+JW
IF(IWP2.GT.0) IWP2=IWP2+1
IF(IWP3.GT.0) IWP3=IWP3+2
JWP=IWP1+IWP2+IWP3+1
JSWP=10*(ISP-1)+JWP
C
C DETERMINE IDENT1, THE POSITION OF THE VALUE IN THE ARRAY CFPFT1
C
JSW1=80*(JSW-1)+JSWP
MAXJ = 0
M=N-1
IF(M.EQ.0) GO TO 101
DO 100 I=1,M
MAXJ=MAXJ+I*(I+1)/2
100 CONTINUE
101 MINJ=MAXJ+1
MAXJ=MAXJ+(M+1)*(M+2)/2
IDENT1= 0
DO 200 J=MINJ,MAXJ
IF(ID1(J).EQ.JSW1) GO TO 201
200 CONTINUE
GO TO 203
201 IDENT1=J
203 IF(IDENT1.NE.0) GO TO 300
WRITE(IWRITE,1000) IS,IW,ISP,IWP
GO TO 900
300 TERM1=CFPFT1(IDENT1)
C
C EVALUATION OF TERM2
C
C DETERMINE JWU,JWUP
C
JU=IU1+4*IU2+1
IF(IU.EQ.22) JU=9
JUP=IUP1+4*IUP2+1
IF(IUP.EQ.22) JUP=9
JWU=10*(JU-1)+JW
JWUP=10*(JUP-1)+JWP
C
C DETERMINE IDENT2, THE POSITION OF THE VALUE IN THE ARRAY CFPFT2
C
JWU1=90*(JWU-1)+JWUP
DO 400 I=1,10
ILIM1=IF2(I)
ILIM2=IF2(I+1)
IF(JWU1.GE.ILIM1.AND.JWU1.LT.ILIM2)IMEM=I
400 CONTINUE
MINJ =(IMEM-1)*30+1
MAXJ=MINJ+29
IDENT2=0
DO 500 J=MINJ,MAXJ
IF(ID2(J).EQ.JWU1) GO TO 501
500 CONTINUE
GO TO 503
501 IDENT2=J
503 IF(IDENT2.NE.0) GO TO 600
WRITE(IWRITE,2000) IW,IU,IWP,IUP
504 GO TO 900
600 TERM2=CFPFT2(IDENT2)
IF(ABS(TERM2).LT.EPS) GO TO 900
C
C EVALUATION OF TERM3
C
C DETERMINE JL,JLP,JUL,JULP AND JUL1
C
JL = 0
IF(IA.EQ.2) JL=10
JL=JL+IL+1
JLP = 0
IF(IAP.EQ.2) JLP=10
JLP=JLP+ILP+1
JUL = 19*(JU-1)+JL
JULP = 19*(JUP-1)+JLP
JUL1=171*(JUL-1)+JULP
C
C DETERMINE IDENT3, THE POSITION OF THE VALUE IN THE ARRAY CFPFT3
C
DO 700 I=1,42
ILIM1=IF3(I)
ILIM2=IF3(I+1)
IF(JUL1.GE.ILIM1.AND.JUL1.LT.ILIM2) GO TO 701
700 CONTINUE
701 IMEM=I
MINJ=(IMEM-1)*30+1
MAXJ=MINJ+29
IDENT3=0
DO 800 J=MINJ,MAXJ
IF(ID3(J).EQ.JUL1) GO TO 801
800 CONTINUE
GO TO 803
801 IDENT3=J
803 IF(IDENT3.NE.0) GO TO 804
WRITE(IWRITE,3000) IU,IL,IUP,ILP
GO TO 900
804 TERM3=CFPFT3(IDENT3)
C
CFP=TERM1*TERM2*TERM3*CONST
C
GO TO 901
902 IF(ITEST.EQ.0) WRITE(IWRITE,4000) IL,ILP,IS,ISP
GO TO 900
903 IF(ITEST.EQ.0) WRITE(IWRITE,5000) IW,IWP,IU,IUP
900 CFP=ZERO
901 IF(ISWT.EQ.2) CALL SECHAF(N,IS,IL,ISP,ILP,ISWT,CONST)
RETURN
END
SUBROUTINE SECHAF(N,IS,IL,ISP,ILP,ISWT,CONST)
C
C THIS ROUTINE IS ENTERED ONLY WHEN A COEFFICIENT IN THE SECOND
C HALF OF THE F SHELL IS REQUIRED. I.E. N.GT.7
C
C IN THIS CASE RECURRENCE RELATION (19) OF RACAH (REF 1) IS USED TO
C RELATE TO A COEFFICIENT IN THE FIRST HALF OF THE SHELL
C
COMMON/PARAMS/IV,IW,IU,IA,IVP,IWP,IUP,IAP
C
IF(ISWT.EQ.2) GO TO 1
ISIGN=(-1)**((IS+ISP-9)/2+IL+ILP)
FACTOR=SQRT(((15.0-N)*ISP*(2*ILP+1.0))/(N*IS*(2*IL+1.0)))
IF(N.NE.8) GO TO 2
IF(IV.EQ.(IVP+1)) ISIGN=-ISIGN
2 CONST=ISIGN*FACTOR
1 N=15-N
CALL SWAP(IS,ISP)
CALL SWAP(IL,ILP)
CALL SWAP(IV,IVP)
CALL SWAP(IW,IWP)
CALL SWAP(IU,IUP)
CALL SWAP(IA,IAP)
RETURN
END
SUBROUTINE SWAP(IA,IB)
C
C THIS ROUTINE INTERCHANGES THE VALUES OF IA AND IB
C
IC=IA
IA=IB
IB=IC
RETURN
END
****
BLOCK DATA
C
C BLOCK DATA FOR CFPF
C
COMMON/FARRAY/F0(1),F1(1),F2(7),F3(17),F4(47),F5(73),F6(119)
1 ,F7(119)
COMMON/FBLOCK/A(84),B(287),C(1246),L(84),M(287),N(1246),
1 IM(11),IN(43)
COMMON/POINTR/I(981)
C N
C TABLE OF POSSIBLE F STATES
C
DATA F0(1)/101/
DATA F1(1)/231/
DATA F2(1),F2(2),F2(3),F2(4),F2(5),F2(6),F2(7)/
1 311,331,351,101,121,141,161/
DATA F3(1),F3(2),F3(3),F3(4),F3(5),F3(6),F3(7),F3(8),F3(9),F3(10),
2 F3(11),F3(12),F3(13),F3(14),F3(15),F3(16),F3(17)/
1 401,421,431,441,461,211,221,222,231,232,
2 241,242,251,252,261,271,281/
DATA F4(1),F4(2),F4(3),F4(4),F4(5),F4(6),F4(7),F4(8),F4(9),F4(10),
2 F4(11),F4(12),F4(13),F4(14),F4(15),F4(16),F4(17),F4(18),
3 F4(19),F4(20),F4(21),F4(22),F4(23),F4(24),F4(25),F4(26),
4 F4(27),F4(28),F4(29),F4(30),F4(31),F4(32),F4(33),F4(34),
5 F4(35),F4(36),F4(37),F4(38),F4(39),F4(40),F4(41),F4(42),
6 F4(43),F4(44),F4(45),F4(46),F4(47)/
1 501,521,531,541,561,311,312,313,321,322,
2 331,332,333,334,341,342,343,351,
3 352,353,354,361,362,371,372,381,
4 391,101,102,121,122,123,124,131,
5 141,142,143,144,151,152,161,162,
6 163,171,181,182,1101/
DATA F5(1),F5(2),F5(3),F5(4),F5(5),F5(6),F5(7),F5(8),F5(9),F5(10),
2 F5(11),F5(12),F5(13),F5(14),F5(15),F5(16),F5(17),F5(18),
3 F5(19),F5(20),F5(21),F5(22),F5(23),F5(24),F5(25),F5(26),
4 F5(27),F5(28),F5(29),F5(30),F5(31),F5(32),F5(33),F5(34),
5 F5(35),F5(36),F5(37),F5(38),F5(39),F5(40),F5(41),F5(42),
6 F5(43),F5(44),F5(45),F5(46),F5(47),F5(48),F5(49),F5(50),
7 F5(51),F5(52),F5(53),F5(54),F5(55),F5(56),F5(57),F5(58),
8 F5(59),F5(60),F5(61),F5(62),F5(63),F5(64),F5(65),F5(66),
9 F5(67),F5(68),F5(69),F5(70),F5(71),F5(72),F5(73)/
1 611,631,651,401,411,412,421,422,423,431,
2 432,433,434,441,442,443,444,451,
3 452,453,461,462,463,471,472,481,
4 491,211,212,213,214,221,222,223,
5 224,225,231,232,233,234,235,236,
6 237,241,242,243,244,245,246,251,
7 252,253,254,255,256,257,261,262,
8 263,264,265,271,272,273,274,275,
9 281,282,283,291,292,2101,2111/
DATA F6(1),F6(2),F6(3),F6(4),F6(5),F6(6),F6(7),F6(8),F6(9),F6(10),
2 F6(11),F6(12),F6(13),F6(14),F6(15),F6(16),F6(17),F6(18),
3 F6(19),F6(20),F6(21),F6(22),F6(23),F6(24),F6(25),F6(26),
4 F6(27),F6(28),F6(29),F6(30),F6(31),F6(32),F6(33),F6(34),
5 F6(35),F6(36),F6(37),F6(38),F6(39),F6(40),F6(41),F6(42),
6 F6(43),F6(44),F6(45),F6(46),F6(47),F6(48),F6(49),F6(50),
7 F6(51),F6(52),F6(53),F6(54),F6(55),F6(56),F6(57),F6(58),
8 F6(59),F6(60),F6(61),F6(62),F6(63),F6(64),F6(65),F6(66),
9 F6(67),F6(68),F6(69),F6(70),F6(71),F6(72),F6(73),F6(74)/
1 731,501,511,521,522,523,531,532,541,542,
2 543,551,552,561,562,571,581,311,
3 312,313,314,315,316,321,322,323,
4 324,325,331,332,333,334,335,336,
5 337,338,339,341,342,343,344,345,
6 346,347,351,352,353,354,355,356,
7 357,358,359,361,362,363,364,365,
8 366,371,372,373,374,375,376,381,
9 382,383,391,392,393,3101,3111,101/
DATA F6(75),F6(76),F6(77),F6(78),F6(79),F6(80),F6(81),F6(82),
2 F6(83),F6(84),F6(85),F6(86),F6(87),F6(88),F6(89),F6(90),
3 F6(91),F6(92),F6(93),F6(94),F6(95),F6(96),F6(97),F6(98),
4 F6(99),F6(100),F6(101),F6(102),F6(103),F6(104),F6(105),
5 F6(106),F6(107),F6(108),F6(109),F6(110),F6(111),F6(112),
6 F6(113),F6(114),F6(115),F6(116),F6(117),F6(118),F6(119)/
1 102,103,104,111,121,122,123,124,
2 125,126,131,132,133,134,141,142,
3 143,144,145,146,147,148,151,152,
4 153,154,161,162,163,164,165,
5 166,167,171,172,173,181,182,
6 183,184,191,192,1101,1102,1121/
DATA F7(1),F7(2),F7(3),F7(4),F7(5),F7(6),F7(7),F7(8),F7(9),F7(10),
2 F7(11),F7(12),F7(13),F7(14),F7(15),F7(16),F7(17),F7(18),
3 F7(19),F7(20),F7(21),F7(22),F7(23),F7(24),F7(25),F7(26),
4 F7(27),F7(28),F7(29),F7(30),F7(31),F7(32),F7(33),F7(34),
5 F7(35),F7(36),F7(37),F7(38),F7(39),F7(40),F7(41),F7(42),
6 F7(43),F7(44),F7(45),F7(46),F7(47),F7(48),F7(49),F7(50),
7 F7(51),F7(52),F7(53),F7(54),F7(55),F7(56),F7(57),F7(58),
8 F7(59),F7(60),F7(61),F7(62),F7(63),F7(64),F7(65),F7(66),
9 F7(67),F7(68),F7(69),F7(70),F7(71),F7(72),F7(73),F7(74)/
1 801,611,621,631,641,651,661,401,402,411,
2 412,421,422,423,424,425,426,431,
3 432,433,434,435,441,442,443,444,
4 445,446,447,451,452,453,454,455,
5 461,462,463,464,465,471,472,473,
6 481,482,483,491,4101,201,202,211,
7 212,213,214,215,221,222,223,224,
8 225,226,227,231,232,233,234,235,
9 236,237,238,239,2310,241,242,243/
DATA F7(75),F7(76),F7(77),F7(78),F7(79),F7(80),F7(81),F7(82),
2 F7(83),F7(84),F7(85),F7(86),F7(87),F7(88),F7(89),F7(90),
3 F7(91),F7(92),F7(93),F7(94),F7(95),F7(96),F7(97),F7(98),
4 F7(99),F7(100),F7(101),F7(102),F7(103),F7(104),F7(105),
5 F7(106),F7(107),F7(108),F7(109),F7(110),F7(111),F7(112),
6 F7(113),F7(114),F7(115),F7(116),F7(117),F7(118),F7(119)/
1 244,245,246,247,248,249,2410,251,
2 252,253,254,255,256,257,258,259,
3 261,262,263,264,265,266,267,268,
4 269,271,272,273,274,275,276,
5 277,281,282,283,284,285,291,
6 292,293,294,2101,2102,2111,2121/
C
C POINTER TABLE
C
DATA I( 1),I( 2),I( 3),I( 4),I( 11),I( 21),I( 22),I( 23),
1 I( 24),I( 25),I( 26),I( 31),I( 32),I( 33),I( 34),I( 41),
2 I( 42),I( 43),I( 44),I( 45),I( 46),I( 47),I( 48),I( 51),
3 I( 52),I( 53),I( 54),I( 61),I( 62),I( 63),I( 64),I( 65),
4 I( 66),I( 67),I( 71),I( 72),I( 73),I( 81),I( 82),I( 83),
5 I( 84),I( 91),I( 92),I(101),I(102),I(121),I(131),I(132),
6 I(141),I(142),I(143),I(144),I(145),I(151),I(152),I(153),
7 I(154),I(155),I(156),I(157),I(161),I(162),I(163),I(164),
8 I(165),I(166),I(167),I(168),I(169),I(170),I(171),I(172),
9 I(173),I(174),I(175),I(176),I(177),I(178),I(179),I(180)/
1 1,4220221,6222001,6222401,6222301,2200201,4220201,4220211,
1 4220221,6222201,6222401,4220211,6222101,6222301,6222401,2200201,
2 4220201,4220211,4220221,6222201,6222301,6222401,6222402,4220211,
3 4220221,6222301,6222401,2200201,4220201,4220221,6222201,6222301,
4 6222401,6222402,4220211,6222301,6222401,4220211,4220221,6222401,
5 6222402,6222301,6222401,4220221,6222401,6222401,7222001,7222401,
6 3210111,5221111,5221301,5221311,7222301,3210201,3210211,5221201,
7 5221211,5221311,7222201,7222401,1100101,3210211,5221101,5221211,
8 5221301,5221311,5221312,7222101,7222301,7222401,3210201,3210211,
9 5221201,5221211,5221301,5221311,7222201,7222301,7222401,7222402/
DATA I(181),I(182),I(183),I(184),I(185),I(186),I(187),I(188),
1 I(189),I(191),I(192),I(193),I(194),I(195),I(196),I(197),
2 I(198),I(199),I(201),I(202),I(203),I(204),I(205),I(206),
3 I(207),I(211),I(212),I(213),I(214),I(215),I(221),I(222),
4 I(223),I(224),I(231),I(232),I(241),I(251),I(271),I(272),
5 I(273),I(274),I(275),I(276),I(281),I(282),I(283),I(284),
6 I(285),I(291),I(292),I(293),I(294),I(295),I(296),I(297),
7 I(298),I(299),I(301),I(302),I(303),I(304),I(305),I(306),
8 I(307),I(311),I(312),I(313),I(314),I(315),I(316),I(317),
9 I(318),I(319),I(321),I(322),I(323),I(324),I(325),I(326)/
1 3210111,3210211,5221111,5221211,5221301,5221311,5221312,7222301,
1 7222401,3210201,5221201,5221301,5221311,5221312,7222201,7222301,
2 7222401,7222402,3210211,5221211,5221301,5221311,5221312,7222301,
3 7222401,3210211,5221211,5221311,7222401,7222402,5221301,5221311,
4 7222301,7222401,5221311,7222401,5221311,7222401,2110111,4211111,
5 4211301,6221111,6221301,6221311,4211201,4211211,6221201,6221211,
6 6221311,2110101,4211101,4211211,4211301,6221101,6221211,6221301,
7 6221311,6221312,4211201,4211211,4211301,6221201,6221211,6221301,
8 6221311,2110111,4211111,4211211,4211301,6221111,6221211,6221301,
9 6221311,6221312,4211201,4211301,6221201,6221301,6221311,6221312/
DATA I(331),I(332),I(333),I(334),I(335),I(336),I(341),I(342),
1 I(343),I(351),I(352),I(353),I(361),I(371),I(391),I(392),
2 I(401),I(402),I(411),I(412),I(413),I(414),I(415),I(416),
3 I(421),I(422),I(423),I(424),I(425),I(431),I(432),I(433),
4 I(434),I(435),I(436),I(437),I(441),I(442),I(443),I(444),
5 I(445),I(451),I(452),I(453),I(454),I(455),I(461),I(462),
6 I(463),I(471),I(472),I(473),I(481),I(491),I(521),I(531),
7 I(541),I(542),I(543),I(551),I(552),I(561),I(562),I(563),
8 I(571),I(572),I(581),I(582),I(591),I(601),I(661),I(671),
9 I(681),I(691),I(701),I(711),I(811),I(911)/
1 4211211,4211301,6221211,6221301,6221311,6221312,4211211,6221211,
1 6221311,4211301,6221301,6221311,6221311,6221311,3111001,7220221,
2 5211111,5211301,3111201,5211201,5211211,7220201,7220211,7220221,
3 3111101,5211101,5211211,5211301,7220211,3111201,5211201,5211211,
4 5211301,7220201,7220211,7220221,5211111,5211211,5211301,7220211,
5 7220221,3111201,5211201,5211301,7220201,7220221,5211211,5211301,
6 7220211,5211211,7220211,7220221,5211301,7220221,4111001,6210111,
7 4111201,6210201,6210211,4111101,6210211,4111201,6210201,6210211,
8 6210111,6210211,4111201,6210201,6210211,6210211,5110111,7200201,
9 5110101,7200201,5110111,7200201,6100101,7000001/
C
C TABLE 1
C
DATA L( 1),L( 2),L( 3),L( 4),L( 5),L( 6),L( 7),L( 8),L( 9),L(10),
1 L(11),L(12),L(13),L(14),L(15),L(16),L(17),L(18),L(19),L(20),
2 L(21),L(22),L(23),L(24),L(25),L(26),L(27),L(28),L(29),L(30),
3 L(31),L(32),L(33),L(34),L(35),L(36),L(37),L(38),L(39),L(40),
4 L(41),L(42),L(43),L(44),L(45),L(46),L(47),L(48),L(49),L(50),
5 L(51),L(52),L(53),L(54),L(55),L(56),L(57),L(58),L(59),L(60),
6 L(61),L(62),L(63),L(64),L(65),L(66),L(67),L(68),L(69),L(70),
7 L(71),L(72),L(73),L(74),L(75),L(76),L(77),L(78),L(79),L(80),
8 L(81),L(82),L(83),L(84)/
1 881, 1852, 12, 172, 2904, 904, 881, 883, 1144, 1123,
1 3717, 1877, 1852, 1855, 2197, 2175, 12, 172, 175, 415,
2 4287, 2927, 2904, 2908, 3007, 2988, 904, 881, 883, 1144,
3 1148, 1123, 1126, 1468, 1446, 4934, 3734, 3717, 3718, 3574,
4 3558, 1877, 1852, 1855, 2197, 2198, 2175, 2179, 2278, 2259,
5 12, 172, 175, 415, 419, 739, 5662, 4302, 4287, 4285,
6 4222, 4205, 2927, 2904, 2908, 3007, 3005, 2988, 2989, 2845,
7 2829, 904, 881, 883, 1144, 1148, 1123, 1126, 1468, 1469,
8 1446, 1450, 1549, 1530/
DATA A( 1),A( 2),A( 3),A( 4),A( 5),
1 A( 6),A( 7),A( 8),A( 9),A( 10),
2 A( 11),A( 12),A( 13),A( 14),A( 15),
3 A( 16),A( 17),A( 18),A( 19),A( 20),
4 A( 21),A( 22),A( 23),A( 24),A( 25),
5 A( 26),A( 27),A( 28),A( 29),A( 30),
6 A( 31),A( 32),A( 33),A( 34),A( 35),
7 A( 36),A( 37),A( 38),A( 39),A( 40),
8 A( 41),A( 42),A( 43),A( 44),A( 45)/
1 1.00000000, 1.00000000,-1.00000000, 1.00000000,-1.00000000,
1 -0.70710678, 0.53452248, 0.46291005,-0.70710678, 0.70710678,
2 -1.00000000, 0.57735027, 0.64549722,-0.50000000,-0.57735027,
3 0.81649658,-1.00000000, 0.64549722,-0.76376262, 1.00000000,
4 1.00000000, 0.50000000,-0.69282032,-0.51961524, 0.50000000,
5 -0.86602540,-0.77459667, 0.37796447, 0.50709255,-0.48989795,
6 -0.60000000, 0.48989795, 0.40000000,-0.77459667, 0.63245553,
7 1.00000000,-0.44721360,-0.70710678, 0.54772256, 0.44721360,
8 -0.89442719, 0.66666667, 0.47140452,-0.57735027,-0.40824829/
DATA A( 46),A( 47),A( 48),A( 49),A( 50),
1 A( 51),A( 52),A( 53),A( 54),A( 55),
2 A( 56),A( 57),A( 58),A( 59),A( 60),
3 A( 61),A( 62),A( 63),A( 64),A( 65),
4 A( 66),A( 67),A( 68),A( 69),A( 70),
5 A( 71),A( 72),A( 73),A( 74),A( 75),
6 A( 76),A( 77),A( 78),A( 79),A( 80),
7 A( 81),A( 82),A( 83),A( 84)/
1 0.52704628, 0.57735027,-0.47140452,-0.66666667, 0.74535599,
1 -1.00000000, 0.47140452,-0.88191710, 0.70710678,-0.70710678,
2 1.00000000,-1.00000000,-0.40824829, 0.69006556, 0.59761430,
3 -0.40824829, 0.91287093, 0.59761430,-0.50709255,-0.62105900,
4 0.34503278, 0.48795004,-0.59761430,-0.53452248, 0.59761430,
5 -0.80178373,-0.80178373, 0.28571429, 0.52489066,-0.35856858,
6 -0.71713717, 0.35856858, 0.47809144,-0.53452248,-0.59761430,
7 0.43643578, 0.40824829,-0.80178373, 0.59761430/
C
C POINTER TABLE FOR TABLE 2
C
DATA IM( 1),IM( 2),IM( 3),IM( 4),IM( 5),IM( 6),IM( 7),IM( 8),
1 IM( 9),IM(10),IM(11)/
1 12, 1508, 1730, 2358, 2558, 3449, 4883, 5278,
1 6057, 7048, 99999/
C
C TABLE 2
C
DATA M( 1),M( 2),M( 3),M( 4),M( 5),M( 6),M( 7),M( 8),
1 M( 9),M( 10),M( 11),M( 12),M( 13),M( 14),M( 15),M( 16),
2 M( 17),M( 18),M( 19),M( 20),M( 21),M( 22),M( 23),M( 24),
3 M( 25),M( 26),M( 27),M( 28),M( 29),M( 30),M( 31),M( 32),
4 M( 33),M( 34),M( 35),M( 36),M( 37),M( 38),M( 39),M( 40),
5 M( 41),M( 42),M( 43),M( 44),M( 45),M( 46),M( 47),M( 48),
6 M( 49),M( 50),M( 51),M( 52),M( 53),M( 54),M( 55),M( 56),
7 M( 57),M( 58),M( 59),M( 60),M( 61),M( 62),M( 63),M( 64),
8 M( 65),M( 66),M( 67),M( 68),M( 69),M( 70),M( 71),M( 72)/
1 12, 547, 554, 557, 558, 594, 598, 820,
1 829, 830, 869, 991, 1004, 1013, 1044, 1177,
2 1182, 1187, 1195, 1197, 1225, 1235, 1447, 1454,
3 1457, 1458, 1467, 1468, 1494, 1498, 1508, 1537,
4 1547, 1548, 1549, 1555, 1557, 1558, 1559, 1585,
5 1588, 1589, 1595, 1598, 1599, 1630, 1638, 1639,
6 1640, 1646, 1648, 1649, 1650, 1678, 1679, 1686,
7 1688, 1689, 1720, 1729, 1730, 1739, 1740, 1769,
8 1779, 1992, 2005, 2035, 2045, 2174, 2178, 2183/
DATA M( 73),M( 74),M( 75),M( 76),M( 77),M( 78),M( 79),M( 80),
1 M( 81),M( 82),M( 83),M( 84),M( 85),M( 86),M( 87),M( 88),
2 M( 89),M( 90),M( 91),M( 92),M( 93),M( 94),M( 95),M( 96),
3 M( 97),M( 98),M( 99),M(100),M(101),M(102),M(103),M(104),
4 M(105),M(106),M(107),M(108),M(109),M(110),M(111),M(112),
5 M(113),M(114),M(115),M(116),M(117),M(118),M(119),M(120),
6 M(121),M(122),M(123),M(124),M(125),M(126),M(127),M(128),
7 M(129),M(130),M(131),M(132),M(133),M(134),M(135),M(136),
8 M(137),M(138),M(139),M(140),M(141),M(142),M(143),M(144)/
1 2186, 2188, 2198, 2214, 2218, 2226, 2228, 2269,
1 2275, 2279, 2289, 2305, 2309, 2315, 2319, 2329,
2 2354, 2357, 2358, 2367, 2368, 2378, 2394, 2398,
3 2408, 2447, 2448, 2449, 2455, 2457, 2458, 2459,
4 2468, 2469, 2485, 2488, 2489, 2495, 2498, 2499,
5 2509, 2538, 2539, 2540, 2546, 2548, 2549, 2550,
6 2558, 2559, 2560, 2578, 2579, 2586, 2588, 2589,
7 2599, 2629, 2630, 2639, 2640, 2649, 2650, 2669,
8 2679, 2689, 3355, 3357, 3358, 3359, 3368, 3369/
DATA M(145),M(146),M(147),M(148),M(149),M(150),M(151),M(152),
1 M(153),M(154),M(155),M(156),M(157),M(158),M(159),M(160),
2 M(161),M(162),M(163),M(164),M(165),M(166),M(167),M(168),
3 M(169),M(170),M(171),M(172),M(173),M(174),M(175),M(176),
4 M(177),M(178),M(179),M(180),M(181),M(182),M(183),M(184),
5 M(185),M(186),M(187),M(188),M(189),M(190),M(191),M(192),
6 M(193),M(194),M(195),M(196),M(197),M(198),M(199),M(200),
7 M(201),M(202),M(203),M(204),M(205),M(206),M(207),M(208),
8 M(209),M(210),M(211),M(212),M(213),M(214),M(215),M(216)/
1 3395, 3398, 3399, 3409, 3446, 3448, 3449, 3450,
1 3458, 3459, 3460, 3470, 3486, 3488, 3489, 3499,
2 3539, 3540, 3549, 3550, 3560, 3579, 3589, 4449,
3 4450, 4460, 4489, 4777, 4782, 4787, 4795, 4797,
4 4825, 4835, 4874, 4878, 4883, 4886, 4888, 4914,
5 4918, 4926, 4928, 4946, 5137, 5147, 5148, 5149,
6 5155, 5157, 5158, 5159, 5185, 5188, 5189, 5195,
7 5198, 5199, 5230, 5238, 5239, 5240, 5246, 5248,
8 5249, 5250, 5278, 5279, 5286, 5288, 5289, 5306/
DATA M(217),M(218),M(219),M(220),M(221),M(222),M(223),M(224),
1 M(225),M(226),M(227),M(228),M(229),M(230),M(231),M(232),
2 M(233),M(234),M(235),M(236),M(237),M(238),M(239),M(240),
3 M(241),M(242),M(243),M(244),M(245),M(246),M(247),M(248),
4 M(249),M(250),M(251),M(252),M(253),M(254),M(255),M(256),
5 M(257),M(258),M(259),M(260),M(261),M(262),M(263),M(264),
6 M(265),M(266),M(267),M(268),M(269),M(270),M(271),M(272),
7 M(273),M(274),M(275),M(276),M(277),M(278),M(279),M(280),
8 M(281),M(282),M(283),M(284),M(285),M(286),M(287)/
1 5774, 5778, 5783, 5786, 5788, 5798, 5814, 5818,
1 5826, 5828, 5846, 5869, 5875, 5879, 5889, 5905,
2 5909, 5915, 5919, 5929, 6047, 6048, 6049, 6055,
3 6057, 6058, 6059, 6068, 6069, 6085, 6088, 6089,
4 6095, 6098, 6099, 6109, 6138, 6139, 6140, 6146,
5 6148, 6149, 6150, 6158, 6159, 6160, 6178, 6179,
6 6186, 6188, 6189, 6199, 6206, 7046, 7048, 7049,
7 7050, 7058, 7059, 7060, 7070, 7086, 7088, 7089,
8 7099, 7106, 7705, 7709, 7715, 7719, 7729/
DATA B( 1),B( 2),B( 3),B( 4),B( 5),
1 B( 6),B( 7),B( 8),B( 9),B( 10),
2 B( 11),B( 12),B( 13),B( 14),B( 15),
3 B( 16),B( 17),B( 18),B( 19),B( 20),
4 B( 21),B( 22),B( 23),B( 24),B( 25),
5 B( 26),B( 27),B( 28),B( 29),B( 30),
6 B( 31),B( 32),B( 33),B( 34),B( 35),
7 B( 36),B( 37),B( 38),B( 39),B( 40),
8 B( 41),B( 42),B( 43),B( 44),B( 45)/
1 1.00000000, 0.00000000, 1.00000000,-1.00000000, 1.00000000,
1 0.00000000, 0.00000000, 0.00000000, 1.00000000,-1.00000000,
2 0.00000000, 1.00000000, 0.57735027, 1.00000000, 0.81649658,
3 0.29277002, 1.00000000, 0.63245553, 0.77459667, 0.71713717,
4 0.63245553, 0.00000000,-0.37796447, 0.81649658,-0.61237244,
5 -0.20412415, 0.69436507, 0.79056942,-0.57735027, 0.57735027,
6 0.00000000, 0.87831007,-0.47434165,-0.26352314, 0.66666667,
7 0.63245553, 0.05976143,-0.61237244, 0.00000000,-0.77459667,
8 0.74535599, 0.74535599, 0.00000000, 0.00000000, 0.00000000/
DATA B( 46),B( 47),B( 48),B( 49),B( 50),
1 B( 51),B( 52),B( 53),B( 54),B( 55),
2 B( 56),B( 57),B( 58),B( 59),B( 60),
3 B( 61),B( 62),B( 63),B( 64),B( 65),
4 B( 66),B( 67),B( 68),B( 69),B( 70),
5 B( 71),B( 72),B( 73),B( 74),B( 75),
6 B( 76),B( 77),B( 78),B( 79),B( 80),
7 B( 81),B( 82),B( 83),B( 84),B( 85),
8 B( 86),B( 87),B( 88),B( 89),B( 90)/
1 0.42857143, 0.94280904, 0.37267800, 0.73192505,-1.00000000,
1 0.00000000, 0.86602540, 0.52972846, 0.33333333,-0.33333333,
2 0.00000000, 0.00000000, 0.00000000,-0.37796447, 0.64549722,
3 -0.38729833,-0.50000000, 0.84091787,-0.57735027, 0.00000000,
4 1.00000000, 0.50709255, 0.36514837, 0.78072006, 0.88191710,
5 0.24002743, 1.00000000,-0.53452248, 0.39840954, 0.47574935,
6 0.47140452, 0.51320024, 0.84515425,-0.54216671,-0.33945005,
7 -0.67612340, 0.56343617,-0.67281119, 0.73029674, 0.28688766,
8 0.09759001,-0.17981635, 0.00000000, 0.47140452, 0.35355339/
DATA B( 91),B( 92),B( 93),B( 94),B( 95),
1 B( 96),B( 97),B( 98),B( 99),B(100),
2 B(101),B(102),B(103),B(104),B(105),
3 B(106),B(107),B(108),B(109),B(110),
4 B(111),B(112),B(113),B(114),B(115),
5 B(116),B(117),B(118),B(119),B(120),
6 B(121),B(122),B(123),B(124),B(125),
7 B(126),B(127),B(128),B(129),B(130),
8 B(131),B(132),B(133),B(134),B(135)/
1 0.01309457,-0.93541435, 0.15214515, 0.72671914,-0.88191710,
1 -0.09799079, 0.66253866, 0.93541435,-0.31180478, 0.00000000,
2 0.53452248, 0.35355339,-0.58655573,-0.43643578, 0.49441323,
3 0.00000000, 0.57735027,-0.33333333, 0.33333333,-0.61721340,
4 -0.45074894,-0.83571089, 0.00000000, 0.00000000, 0.44095855,
5 -0.28867513, 0.84515425,-0.61721340,-0.34156503, 0.62678317,
6 0.00000000,-0.69920590, 0.72374686, 0.74535599,-0.44721360,
7 0.53452248, 0.25197632, 0.00000000, 0.00000000, 0.23787468,
8 0.42817442, 0.55277080,-0.59160798, 0.24002743, 0.68313005/
DATA B(136),B(137),B(138),B(139),B(140),
1 B(141),B(142),B(143),B(144),B(145),
2 B(146),B(147),B(148),B(149),B(150),
3 B(151),B(152),B(153),B(154),B(155),
4 B(156),B(157),B(158),B(159),B(160),
5 B(161),B(162),B(163),B(164),B(165),
6 B(166),B(167),B(168),B(169),B(170),
7 B(171),B(172),B(173),B(174),B(175),
8 B(176),B(177),B(178),B(179),B(180)/
1 -0.56291423,-0.51320024, 0.00000000, 0.37796447, 1.00000000,
1 0.29277002, 0.00000000,-0.84327404, 0.33333333, 0.92582010,
2 0.45074894,-0.26590801, 0.90453403,-0.59761430, 0.00000000,
3 -0.41403934, 0.16116459, 0.47140452,-0.81989159,-0.46291005,
4 0.87163080, 0.80178373, 0.88191710,-0.33976479, 0.20225996,
5 0.37796447, 0.40451992,-0.40824829,-0.77459667,-0.48617243,
6 0.74438737, 0.36927447, 0.50000000,-0.31622777,-0.94868330,
7 0.86602540, 0.00000000, 1.00000000,-0.31622777, 0.29277002,
8 -0.94868330, 0.00000000, 0.95618289, 1.00000000,-0.40824829/
DATA B(181),B(182),B(183),B(184),B(185),
1 B(186),B(187),B(188),B(189),B(190),
2 B(191),B(192),B(193),B(194),B(195),
3 B(196),B(197),B(198),B(199),B(200),
4 B(201),B(202),B(203),B(204),B(205),
5 B(206),B(207),B(208),B(209),B(210),
6 B(211),B(212),B(213),B(214),B(215),
7 B(216),B(217),B(218),B(219),B(220),
8 B(221),B(222),B(223),B(224),B(225)/
1 1.00000000, 0.80178373, 0.59761430, 0.00000000, 0.00000000,
1 -0.59761430, 0.69006556, 0.00000000, 0.00000000, 0.94868330,
2 0.52704628, 0.16666667, 0.95618289,-0.31622777,-0.46291005,
3 0.73192505, 0.00000000, 0.00000000, 0.00000000,-0.29277002,
4 0.71269665, 0.66068747, 0.00000000, 0.74535599,-0.23570226,
5 -0.46291005, 0.59761430, 0.65465367,-0.62105900,-0.88640526,
6 0.00000000, 0.00000000, 0.80178373,-0.12598816, 0.74748255,
7 0.00000000, 0.00000000, 0.00000000, 1.00000000, 0.05011148,
8 -0.29880715, 0.75691259, 1.00000000,-0.10206207, 0.49551560/
DATA B(226),B(227),B(228),B(229),B(230),
1 B(231),B(232),B(233),B(234),B(235),
2 B(236),B(237),B(238),B(239),B(240),
3 B(241),B(242),B(243),B(244),B(245),
4 B(246),B(247),B(248),B(249),B(250),
5 B(251),B(252),B(253),B(254),B(255),
6 B(256),B(257),B(258),B(259),B(260),
7 B(261),B(262),B(263),B(264),B(265),
8 B(266),B(267),B(268),B(269),B(270)/
1 0.57217214, 0.86715231, 0.00000000, 0.69436507, 0.23145502,
1 0.58630197,-0.35355339, 0.25000000, 0.62678317,-0.56694671,
2 -0.46770717, 0.00000000, 0.00000000, 0.00000000,-0.47245559,
3 1.00000000,-0.29277002, 0.11572751, 0.49441323, 0.68401897,
4 0.43301270, 0.33333333,-0.04166667, 0.76764947,-0.74748255,
5 0.15748520, 0.70156076, 0.00000000, 0.00000000, 0.00000000,
6 -0.17519122,-0.76764947, 0.00000000,-0.37796447,-0.41247896,
7 -0.37267800, 0.92582010, 0.43700369, 0.34960295,-0.85042006,
8 0.22271770,-0.67269997, 0.53512955, 0.49607837, 0.00000000/
DATA B(271),B(272),B(273),B(274),B(275),
1 B(276),B(277),B(278),B(279),B(280),
2 B(281),B(282),B(283),B(284),B(285),
3 B(286),B(287)/
1 0.00000000, 0.00000000, 0.00000000, 0.81649658, 0.12909944,
1 0.26726124, 0.96362411,-0.40824829, 0.57735027, 0.31139958,
2 -0.94146887, 0.91287093, 0.00000000, 0.00000000, 1.00000000,
3 0.30151134, 0.95346259/
C
C POINTER TABLE FOR TABLE 3
C
DATA IN( 1),IN( 2),IN( 3),IN( 4),IN( 5),IN( 6),IN( 7),IN( 8),
1 IN( 9),IN(10),IN(11),IN(12),IN(13),IN(14),IN(15),IN(16),
2 IN(17),IN(18),IN(19),IN(20),IN(21),IN(22),IN(23),IN(24),
3 IN(25),IN(26),IN(27),IN(28),IN(29),IN(30),IN(31),IN(32),
4 IN(33),IN(34),IN(35),IN(36),IN(37),IN(38),IN(39),IN(40),
5 IN(41),IN(42),IN(43)/
1 23, 7247, 9998, 10380, 10551, 10697, 10857, 11026,
1 11372, 13418, 13656, 13914, 14102, 14278, 14505, 14791,
2 15481, 15870, 16224, 19971, 20147, 20318, 20490, 20840,
3 21025, 23202, 23375, 23544, 23682, 23833, 23927, 24090,
4 24261, 24518, 24787, 25124, 25455, 25616, 25769, 26470,
5 26985, 27501, 99999/
C
C TABLE 3
C
DATA N( 1),N( 2),N( 3),N( 4),N( 5),N( 6),N( 7),
1 N( 8),N( 9),N( 10),N( 11),N( 12),N( 13),N( 14),
2 N( 15),N( 16),N( 17),N( 18),N( 19),N( 20),N( 21),
3 N( 22),N( 23),N( 24),N( 25),N( 26),N( 27),N( 28),
4 N( 29),N( 30),N( 31),N( 32),N( 33),N( 34),N( 35),
5 N( 36),N( 37),N( 38),N( 39),N( 40),N( 41),N( 42),
6 N( 43),N( 44),N( 45),N( 46),N( 47),N( 48),N( 49),
7 N( 50),N( 51),N( 52),N( 53),N( 54),N( 55),N( 56),
8 N( 57),N( 58),N( 59),N( 60),N( 61),N( 62),N( 63)/
1 23, 3763, 3785, 3803, 3805, 3807, 3859,
1 3863, 6863, 6881, 6883, 6899, 6901, 6902,
2 6903, 6937, 6941, 6957, 6958, 6959, 6960,
3 7205, 7223, 7225, 7227, 7241, 7243, 7244,
4 7245, 7246, 7247, 7279, 7283, 7299, 7300,
5 7301, 7302, 7304, 7547, 7567, 7569, 7585,
6 7586, 7587, 7588, 7589, 7591, 7625, 7642,
7 7643, 7644, 7646, 7647, 9959, 9961, 9977,
8 9979, 9980, 9995, 9997, 9998, 9999, 10009/
DATA N( 64),N( 65),N( 66),N( 67),N( 68),N( 69),N( 70),
1 N( 71),N( 72),N( 73),N( 74),N( 75),N( 76),N( 77),
2 N( 78),N( 79),N( 80),N( 81),N( 82),N( 83),N( 84),
3 N( 85),N( 86),N( 87),N( 88),N( 89),N( 90),N( 91),
4 N( 92),N( 93),N( 94),N( 95),N( 96),N( 97),N( 98),
5 N( 99),N( 100),N( 101),N( 102),N( 103),N( 104),N( 105),
6 N( 106),N( 107),N( 108),N( 109),N( 110),N( 111),N( 112),
7 N( 113),N( 114),N( 115),N( 116),N( 117),N( 118),N( 119),
8 N( 120),N( 121),N( 122),N( 123),N( 124),N( 125),N( 126)/
1 10035, 10036, 10037, 10053, 10054, 10055, 10056,
1 10065, 10301, 10303, 10305, 10319, 10321, 10322,
2 10323, 10324, 10337, 10339, 10340, 10341, 10342,
3 10343, 10351, 10353, 10377, 10378, 10379, 10380,
4 10395, 10396, 10397, 10398, 10399, 10400, 10407,
5 10409, 10410, 10472, 10474, 10476, 10490, 10492,
6 10493, 10494, 10495, 10496, 10510, 10511, 10512,
7 10513, 10514, 10515, 10522, 10524, 10548, 10549,
8 10550, 10551, 10553, 10566, 10567, 10568, 10569/
DATA N( 127),N( 128),N( 129),N( 130),N( 131),N( 132),N( 133),
1 N( 134),N( 135),N( 136),N( 137),N( 138),N( 139),N( 140),
2 N( 141),N( 142),N( 143),N( 144),N( 145),N( 146),N( 147),
3 N( 148),N( 149),N( 150),N( 151),N( 152),N( 153),N( 154),
4 N( 155),N( 156),N( 157),N( 158),N( 159),N( 160),N( 161),
5 N( 162),N( 163),N( 164),N( 165),N( 166),N( 167),N( 168),
6 N( 169),N( 170),N( 171),N( 172),N( 173),N( 174),N( 175),
7 N( 176),N( 177),N( 178),N( 179),N( 180),N( 181),N( 182),
8 N( 183),N( 184),N( 185),N( 186),N( 187),N( 188),N( 189)/
1 10570, 10571, 10572, 10578, 10580, 10581, 10582,
1 10643, 10645, 10647, 10663, 10664, 10665, 10666,
2 10667, 10681, 10682, 10683, 10684, 10685, 10686,
3 10687, 10693, 10695, 10697, 10719, 10720, 10721,
4 10722, 10724, 10725, 10738, 10739, 10740, 10741,
5 10742, 10743, 10744, 10749, 10751, 10752, 10753,
6 10816, 10818, 10834, 10835, 10836, 10837, 10838,
7 10840, 10853, 10854, 10855, 10856, 10857, 10858,
8 10859, 10864, 10866, 10868, 10891, 10892, 10893/
DATA N( 190),N( 191),N( 192),N( 193),N( 194),N( 195),N( 196),
1 N( 197),N( 198),N( 199),N( 200),N( 201),N( 202),N( 203),
2 N( 204),N( 205),N( 206),N( 207),N( 208),N( 209),N( 210),
3 N( 211),N( 212),N( 213),N( 214),N( 215),N( 216),N( 217),
4 N( 218),N( 219),N( 220),N( 221),N( 222),N( 223),N( 224),
5 N( 225),N( 226),N( 227),N( 228),N( 229),N( 230),N( 231),
6 N( 232),N( 233),N( 234),N( 235),N( 236),N( 237),N( 238),
7 N( 239),N( 240),N( 241),N( 242),N( 243),N( 244),N( 245),
8 N( 246),N( 247),N( 248),N( 249),N( 250),N( 251),N( 252)/
1 10895, 10896, 10910, 10911, 10912, 10913, 10914,
1 10915, 10916, 10920, 10922, 10923, 10924, 10987,
2 10989, 11006, 11007, 11008, 11009, 11011, 11025,
3 11026, 11027, 11028, 11029, 11030, 11031, 11035,
4 11037, 11039, 11063, 11064, 11066, 11067, 11082,
5 11083, 11084, 11085, 11086, 11087, 11088, 11093,
6 11094, 11095, 11331, 11350, 11351, 11353, 11369,
7 11370, 11371, 11372, 11373, 11375, 11379, 11381,
8 11408, 11409, 11426, 11427, 11428, 11429, 11430/
DATA N( 253),N( 254),N( 255),N( 256),N( 257),N( 258),N( 259),
1 N( 260),N( 261),N( 262),N( 263),N( 264),N( 265),N( 266),
2 N( 267),N( 268),N( 269),N( 270),N( 271),N( 272),N( 273),
3 N( 274),N( 275),N( 276),N( 277),N( 278),N( 279),N( 280),
4 N( 281),N( 282),N( 283),N( 284),N( 285),N( 286),N( 287),
5 N( 288),N( 289),N( 290),N( 291),N( 292),N( 293),N( 294),
6 N( 295),N( 296),N( 297),N( 298),N( 299),N( 300),N( 301),
7 N( 302),N( 303),N( 304),N( 305),N( 306),N( 307),N( 308),
8 N( 309),N( 310),N( 311),N( 312),N( 313),N( 314),N( 315)/
1 11431, 11436, 11437, 13055, 13057, 13073, 13075,
1 13076, 13131, 13132, 13133, 13143, 13397, 13399,
2 13400, 13401, 13415, 13417, 13418, 13419, 13420,
3 13429, 13473, 13474, 13475, 13476, 13477, 13485,
4 13487, 13568, 13570, 13571, 13572, 13573, 13586,
5 13588, 13589, 13590, 13591, 13592, 13600, 13602,
6 13644, 13645, 13646, 13647, 13648, 13649, 13656,
7 13658, 13659, 13739, 13741, 13742, 13743, 13744,
8 13745, 13759, 13760, 13761, 13762, 13763, 13764/
DATA N( 316),N( 317),N( 318),N( 319),N( 320),N( 321),N( 322),
1 N( 323),N( 324),N( 325),N( 326),N( 327),N( 328),N( 329),
2 N( 330),N( 331),N( 332),N( 333),N( 334),N( 335),N( 336),
3 N( 337),N( 338),N( 339),N( 340),N( 341),N( 342),N( 343),
4 N( 344),N( 345),N( 346),N( 347),N( 348),N( 349),N( 350),
5 N( 351),N( 352),N( 353),N( 354),N( 355),N( 356),N( 357),
6 N( 358),N( 359),N( 360),N( 361),N( 362),N( 363),N( 364),
7 N( 365),N( 366),N( 367),N( 368),N( 369),N( 370),N( 371),
8 N( 372),N( 373),N( 374),N( 375),N( 376),N( 377),N( 378)/
1 13771, 13773, 13815, 13816, 13817, 13818, 13819,
1 13820, 13821, 13827, 13829, 13830, 13831, 13912,
2 13913, 13914, 13915, 13916, 13930, 13931, 13932,
3 13933, 13934, 13935, 13936, 13942, 13944, 13946,
4 13987, 13988, 13989, 13990, 13991, 13992, 13993,
5 13998, 14000, 14001, 14002, 14083, 14084, 14085,
6 14086, 14087, 14089, 14102, 14103, 14104, 14105,
7 14106, 14107, 14108, 14113, 14115, 14117, 14159,
8 14160, 14161, 14162, 14163, 14164, 14165, 14169/
DATA N( 379),N( 380),N( 381),N( 382),N( 383),N( 384),N( 385),
1 N( 386),N( 387),N( 388),N( 389),N( 390),N( 391),N( 392),
2 N( 393),N( 394),N( 395),N( 396),N( 397),N( 398),N( 399),
3 N( 400),N( 401),N( 402),N( 403),N( 404),N( 405),N( 406),
4 N( 407),N( 408),N( 409),N( 410),N( 411),N( 412),N( 413),
5 N( 414),N( 415),N( 416),N( 417),N( 418),N( 419),N( 420),
6 N( 421),N( 422),N( 423),N( 424),N( 425),N( 426),N( 427),
7 N( 428),N( 429),N( 430),N( 431),N( 432),N( 433),N( 434),
8 N( 435),N( 436),N( 437),N( 438),N( 439),N( 440),N( 441)/
1 14171, 14172, 14173, 14255, 14256, 14257, 14258,
1 14260, 14274, 14275, 14276, 14277, 14278, 14279,
2 14280, 14284, 14286, 14288, 14331, 14332, 14333,
3 14334, 14335, 14336, 14337, 14342, 14343, 14344,
4 14427, 14428, 14429, 14431, 14446, 14447, 14448,
5 14449, 14450, 14451, 14457, 14459, 14503, 14504,
6 14505, 14506, 14507, 14508, 14509, 14513, 14514,
7 14515, 14599, 14600, 14602, 14618, 14619, 14620,
8 14621, 14622, 14624, 14628, 14630, 14675, 14676/
DATA N( 442),N( 443),N( 444),N( 445),N( 446),N( 447),N( 448),
1 N( 449),N( 450),N( 451),N( 452),N( 453),N( 454),N( 455),
2 N( 456),N( 457),N( 458),N( 459),N( 460),N( 461),N( 462),
3 N( 463),N( 464),N( 465),N( 466),N( 467),N( 468),N( 469),
4 N( 470),N( 471),N( 472),N( 473),N( 474),N( 475),N( 476),
5 N( 477),N( 478),N( 479),N( 480),N( 481),N( 482),N( 483),
6 N( 484),N( 485),N( 486),N( 487),N( 488),N( 489),N( 490),
7 N( 491),N( 492),N( 493),N( 494),N( 495),N( 496),N( 497),
8 N( 498),N( 499),N( 500),N( 501),N( 502),N( 503),N( 504)/
1 14677, 14678, 14679, 14680, 14685, 14686, 14771,
1 14773, 14790, 14791, 14792, 14793, 14795, 14801,
2 14847, 14848, 14849, 14850, 14851, 14857, 15115,
3 15134, 15135, 15137, 15191, 15192, 15193, 15449,
4 15451, 15452, 15453, 15454, 15455, 15469, 15470,
5 15471, 15472, 15473, 15474, 15481, 15483, 15525,
6 15526, 15527, 15528, 15529, 15530, 15531, 15537,
7 15539, 15540, 15541, 15793, 15794, 15795, 15796,
8 15797, 15799, 15812, 15813, 15814, 15815, 15816/
DATA N( 505),N( 506),N( 507),N( 508),N( 509),N( 510),N( 511),
1 N( 512),N( 513),N( 514),N( 515),N( 516),N( 517),N( 518),
2 N( 519),N( 520),N( 521),N( 522),N( 523),N( 524),N( 525),
3 N( 526),N( 527),N( 528),N( 529),N( 530),N( 531),N( 532),
4 N( 533),N( 534),N( 535),N( 536),N( 537),N( 538),N( 539),
5 N( 540),N( 541),N( 542),N( 543),N( 544),N( 545),N( 546),
6 N( 547),N( 548),N( 549),N( 550),N( 551),N( 552),N( 553),
7 N( 554),N( 555),N( 556),N( 557),N( 558),N( 559),N( 560),
8 N( 561),N( 562),N( 563),N( 564),N( 565),N( 566),N( 567)/
1 15817, 15818, 15823, 15825, 15827, 15869, 15870,
1 15871, 15872, 15873, 15874, 15875, 15879, 15881,
2 15882, 15883, 16137, 16138, 16139, 16141, 16156,
3 16157, 16158, 16159, 16160, 16161, 16167, 16169,
4 16213, 16214, 16215, 16216, 16217, 16218, 16219,
5 16223, 16224, 16225, 16439, 16457, 16459, 16533,
6 16534, 16535, 17123, 17141, 17143, 17145, 17217,
7 17218, 17219, 17220, 17222, 17223, 19877, 19879,
8 19895, 19897, 19898, 19899, 19933, 19937, 19953/
DATA N( 568),N( 569),N( 570),N( 571),N( 572),N( 573),N( 574),
1 N( 575),N( 576),N( 577),N( 578),N( 579),N( 580),N( 581),
2 N( 582),N( 583),N( 584),N( 585),N( 586),N( 587),N( 588),
3 N( 589),N( 590),N( 591),N( 592),N( 593),N( 594),N( 595),
4 N( 596),N( 597),N( 598),N( 599),N( 600),N( 601),N( 602),
5 N( 603),N( 604),N( 605),N( 606),N( 607),N( 608),N( 609),
6 N( 610),N( 611),N( 612),N( 613),N( 614),N( 615),N( 616),
7 N( 617),N( 618),N( 619),N( 620),N( 621),N( 622),N( 623),
8 N( 624),N( 625),N( 626),N( 627),N( 628),N( 629),N( 630)/
1 19954, 19955, 19956, 19971, 19972, 19973, 19974,
1 19975, 19983, 19985, 19989, 19991, 19993, 19994,
2 20048, 20050, 20052, 20066, 20068, 20069, 20070,
3 20071, 20104, 20108, 20124, 20125, 20126, 20127,
4 20142, 20143, 20144, 20145, 20146, 20147, 20154,
5 20156, 20157, 20160, 20162, 20164, 20165, 20166,
6 20219, 20221, 20223, 20237, 20239, 20240, 20241,
7 20242, 20243, 20275, 20279, 20295, 20296, 20297,
8 20298, 20300, 20313, 20314, 20315, 20316, 20317/
DATA N( 631),N( 632),N( 633),N( 634),N( 635),N( 636),N( 637),
1 N( 638),N( 639),N( 640),N( 641),N( 642),N( 643),N( 644),
2 N( 645),N( 646),N( 647),N( 648),N( 649),N( 650),N( 651),
3 N( 652),N( 653),N( 654),N( 655),N( 656),N( 657),N( 658),
4 N( 659),N( 660),N( 661),N( 662),N( 663),N( 664),N( 665),
5 N( 666),N( 667),N( 668),N( 669),N( 670),N( 671),N( 672),
6 N( 673),N( 674),N( 675),N( 676),N( 677),N( 678),N( 679),
7 N( 680),N( 681),N( 682),N( 683),N( 684),N( 685),N( 686),
8 N( 687),N( 688),N( 689),N( 690),N( 691),N( 692),N( 693)/
1 20318, 20319, 20325, 20327, 20328, 20329, 20333,
1 20335, 20336, 20337, 20390, 20392, 20394, 20410,
2 20411, 20412, 20413, 20414, 20450, 20466, 20467,
3 20468, 20469, 20471, 20472, 20485, 20486, 20487,
4 20488, 20489, 20490, 20491, 20496, 20498, 20499,
5 20500, 20504, 20506, 20507, 20508, 20510, 20734,
6 20736, 20753, 20754, 20755, 20756, 20758, 20792,
7 20810, 20811, 20813, 20814, 20829, 20830, 20831,
8 20832, 20833, 20834, 20835, 20840, 20841, 20842/
DATA N( 694),N( 695),N( 696),N( 697),N( 698),N( 699),N( 700),
1 N( 701),N( 702),N( 703),N( 704),N( 705),N( 706),N( 707),
2 N( 708),N( 709),N( 710),N( 711),N( 712),N( 713),N( 714),
3 N( 715),N( 716),N( 717),N( 718),N( 719),N( 720),N( 721),
4 N( 722),N( 723),N( 724),N( 725),N( 726),N( 727),N( 728),
5 N( 729),N( 730),N( 731),N( 732),N( 733),N( 734),N( 735),
6 N( 736),N( 737),N( 738),N( 739),N( 740),N( 741),N( 742),
7 N( 743),N( 744),N( 745),N( 746),N( 747),N( 748),N( 749),
8 N( 750),N( 751),N( 752),N( 753),N( 754),N( 755),N( 756)/
1 20848, 20849, 20850, 20852, 20854, 20907, 20925,
1 20926, 20927, 20929, 20963, 20982, 20984, 20985,
2 21001, 21002, 21003, 21004, 21005, 21006, 21007,
3 21011, 21012, 21013, 21020, 21021, 21023, 21025,
4 22973, 22975, 22976, 22991, 22993, 22994, 22995,
5 23005, 23031, 23032, 23033, 23049, 23050, 23051,
6 23052, 23061, 23067, 23069, 23071, 23144, 23146,
7 23147, 23148, 23162, 23164, 23165, 23166, 23167,
8 23176, 23202, 23203, 23204, 23205, 23220, 23221/
DATA N( 757),N( 758),N( 759),N( 760),N( 761),N( 762),N( 763),
1 N( 764),N( 765),N( 766),N( 767),N( 768),N( 769),N( 770),
2 N( 771),N( 772),N( 773),N( 774),N( 775),N( 776),N( 777),
3 N( 778),N( 779),N( 780),N( 781),N( 782),N( 783),N( 784),
4 N( 785),N( 786),N( 787),N( 788),N( 789),N( 790),N( 791),
5 N( 792),N( 793),N( 794),N( 795),N( 796),N( 797),N( 798),
6 N( 799),N( 800),N( 801),N( 802),N( 803),N( 804),N( 805),
7 N( 806),N( 807),N( 808),N( 809),N( 810),N( 811),N( 812),
8 N( 813),N( 814),N( 815),N( 816),N( 817),N( 818),N( 819)/
1 23222, 23223, 23224, 23232, 23234, 23238, 23240,
1 23242, 23243, 23315, 23317, 23318, 23319, 23320,
2 23333, 23335, 23336, 23337, 23338, 23339, 23347,
3 23349, 23373, 23374, 23375, 23376, 23391, 23392,
4 23393, 23394, 23395, 23396, 23403, 23405, 23406,
5 23409, 23411, 23413, 23414, 23415, 23486, 23488,
6 23489, 23490, 23491, 23492, 23506, 23507, 23508,
7 23509, 23510, 23511, 23518, 23520, 23544, 23545,
8 23546, 23547, 23549, 23562, 23563, 23564, 23565/
DATA N( 820),N( 821),N( 822),N( 823),N( 824),N( 825),N( 826),
1 N( 827),N( 828),N( 829),N( 830),N( 831),N( 832),N( 833),
2 N( 834),N( 835),N( 836),N( 837),N( 838),N( 839),N( 840),
3 N( 841),N( 842),N( 843),N( 844),N( 845),N( 846),N( 847),
4 N( 848),N( 849),N( 850),N( 851),N( 852),N( 853),N( 854),
5 N( 855),N( 856),N( 857),N( 858),N( 859),N( 860),N( 861),
6 N( 862),N( 863),N( 864),N( 865),N( 866),N( 867),N( 868),
7 N( 869),N( 870),N( 871),N( 872),N( 873),N( 874),N( 875),
8 N( 876),N( 877),N( 878),N( 879),N( 880),N( 881),N( 882)/
1 23566, 23567, 23568, 23574, 23576, 23577, 23578,
1 23582, 23584, 23585, 23586, 23659, 23660, 23661,
2 23662, 23663, 23677, 23678, 23679, 23680, 23681,
3 23682, 23683, 23689, 23691, 23693, 23715, 23716,
4 23717, 23718, 23720, 23721, 23734, 23735, 23736,
5 23737, 23738, 23739, 23740, 23745, 23747, 23748,
6 23749, 23753, 23755, 23756, 23757, 23759, 23830,
7 23831, 23832, 23833, 23834, 23836, 23849, 23850,
8 23851, 23852, 23853, 23854, 23855, 23860, 23862/
DATA N( 883),N( 884),N( 885),N( 886),N( 887),N( 888),N( 889),
1 N( 890),N( 891),N( 892),N( 893),N( 894),N( 895),N( 896),
2 N( 897),N( 898),N( 899),N( 900),N( 901),N( 902),N( 903),
3 N( 904),N( 905),N( 906),N( 907),N( 908),N( 909),N( 910),
4 N( 911),N( 912),N( 913),N( 914),N( 915),N( 916),N( 917),
5 N( 918),N( 919),N( 920),N( 921),N( 922),N( 923),N( 924),
6 N( 925),N( 926),N( 927),N( 928),N( 929),N( 930),N( 931),
7 N( 932),N( 933),N( 934),N( 935),N( 936),N( 937),N( 938),
8 N( 939),N( 940),N( 941),N( 942),N( 943),N( 944),N( 945)/
1 23864, 23887, 23888, 23889, 23891, 23892, 23906,
1 23907, 23908, 23909, 23910, 23911, 23912, 23916,
2 23918, 23919, 23920, 23926, 23927, 23928, 23930,
3 24002, 24003, 24004, 24005, 24007, 24021, 24022,
4 24023, 24024, 24025, 24026, 24027, 24031, 24033,
5 24035, 24059, 24060, 24062, 24063, 24078, 24079,
6 24080, 24081, 24082, 24083, 24084, 24089, 24090,
7 24091, 24097, 24098, 24099, 24101, 24103, 24174,
8 24175, 24176, 24178, 24193, 24194, 24195, 24196/
DATA N( 946),N( 947),N( 948),N( 949),N( 950),N( 951),N( 952),
1 N( 953),N( 954),N( 955),N( 956),N( 957),N( 958),N( 959),
2 N( 960),N( 961),N( 962),N( 963),N( 964),N( 965),N( 966),
3 N( 967),N( 968),N( 969),N( 970),N( 971),N( 972),N( 973),
4 N( 974),N( 975),N( 976),N( 977),N( 978),N( 979),N( 980),
5 N( 981),N( 982),N( 983),N( 984),N( 985),N( 986),N( 987),
6 N( 988),N( 989),N( 990),N( 991),N( 992),N( 993),N( 994),
7 N( 995),N( 996),N( 997),N( 998),N( 999),N(1000),N(1001),
8 N(1002),N(1003),N(1004),N(1005),N(1006),N(1007),N(1008)/
1 24197, 24198, 24204, 24206, 24231, 24233, 24234,
1 24250, 24251, 24252, 24253, 24254, 24255, 24256,
2 24260, 24261, 24262, 24269, 24270, 24272, 24274,
3 24346, 24347, 24349, 24365, 24366, 24367, 24368,
4 24369, 24371, 24375, 24377, 24404, 24405, 24422,
5 24423, 24424, 24425, 24426, 24427, 24432, 24433,
6 24441, 24443, 24445, 24518, 24520, 24537, 24538,
7 24539, 24540, 24542, 24548, 24575, 24576, 24594,
8 24595, 24596, 24597, 24598, 24604, 24614, 24616/
DATA N(1009),N(1010),N(1011),N(1012),N(1013),N(1014),N(1015),
1 N(1016),N(1017),N(1018),N(1019),N(1020),N(1021),N(1022),
2 N(1023),N(1024),N(1025),N(1026),N(1027),N(1028),N(1029),
3 N(1030),N(1031),N(1032),N(1033),N(1034),N(1035),N(1036),
4 N(1037),N(1038),N(1039),N(1040),N(1041),N(1042),N(1043),
5 N(1044),N(1045),N(1046),N(1047),N(1048),N(1049),N(1050),
6 N(1051),N(1052),N(1053),N(1054),N(1055),N(1056),N(1057),
7 N(1058),N(1059),N(1060),N(1061),N(1062),N(1063),N(1064),
8 N(1065),N(1066),N(1067),N(1068),N(1069),N(1070),N(1071)/
1 24691, 24709, 24710, 24711, 24713, 24719, 24747,
1 24766, 24767, 24768, 24769, 24785, 24787, 25025,
2 25027, 25028, 25029, 25030, 25043, 25045, 25046,
3 25047, 25048, 25049, 25057, 25059, 25083, 25084,
4 25085, 25086, 25101, 25102, 25103, 25104, 25105,
5 25106, 25113, 25115, 25116, 25119, 25121, 25123,
6 25124, 25125, 25369, 25370, 25371, 25372, 25373,
7 25387, 25388, 25389, 25390, 25391, 25392, 25393,
8 25399, 25401, 25403, 25425, 25426, 25427, 25428/
DATA N(1072),N(1073),N(1074),N(1075),N(1076),N(1077),N(1078),
1 N(1079),N(1080),N(1081),N(1082),N(1083),N(1084),N(1085),
2 N(1086),N(1087),N(1088),N(1089),N(1090),N(1091),N(1092),
3 N(1093),N(1094),N(1095),N(1096),N(1097),N(1098),N(1099),
4 N(1100),N(1101),N(1102),N(1103),N(1104),N(1105),N(1106),
5 N(1107),N(1108),N(1109),N(1110),N(1111),N(1112),N(1113),
6 N(1114),N(1115),N(1116),N(1117),N(1118),N(1119),N(1120),
7 N(1121),N(1122),N(1123),N(1124),N(1125),N(1126),N(1127),
8 N(1128),N(1129),N(1130),N(1131),N(1132),N(1133),N(1134)/
1 25430, 25431, 25444, 25445, 25446, 25447, 25448,
1 25449, 25450, 25455, 25457, 25458, 25459, 25463,
2 25465, 25466, 25467, 25469, 25540, 25541, 25542,
3 25543, 25544, 25546, 25559, 25560, 25561, 25562,
4 25563, 25564, 25565, 25570, 25572, 25574, 25597,
5 25598, 25599, 25601, 25602, 25616, 25617, 25618,
6 25619, 25620, 25621, 25622, 25626, 25628, 25629,
7 25630, 25636, 25637, 25638, 25640, 25712, 25713,
8 25714, 25715, 25717, 25731, 25732, 25733, 25734/
DATA N(1135),N(1136),N(1137),N(1138),N(1139),N(1140),N(1141),
1 N(1142),N(1143),N(1144),N(1145),N(1146),N(1147),N(1148),
2 N(1149),N(1150),N(1151),N(1152),N(1153),N(1154),N(1155),
3 N(1156),N(1157),N(1158),N(1159),N(1160),N(1161),N(1162),
4 N(1163),N(1164),N(1165),N(1166),N(1167),N(1168),N(1169),
5 N(1170),N(1171),N(1172),N(1173),N(1174),N(1175),N(1176),
6 N(1177),N(1178),N(1179),N(1180),N(1181),N(1182),N(1183),
7 N(1184),N(1185),N(1186),N(1187),N(1188),N(1189),N(1190),
8 N(1191),N(1192),N(1193),N(1194),N(1195),N(1196),N(1197)/
1 25735, 25736, 25737, 25741, 25743, 25745, 25769,
1 25770, 25772, 25773, 25788, 25789, 25790, 25791,
2 25792, 25793, 25794, 25799, 25800, 25801, 25807,
3 25808, 25809, 25811, 25813, 26109, 26110, 26127,
4 26128, 26129, 26139, 26451, 26452, 26453, 26454,
5 26469, 26470, 26471, 26472, 26473, 26481, 26483,
6 26793, 26794, 26795, 26796, 26798, 26811, 26812,
7 26813, 26814, 26815, 26816, 26817, 26823, 26825,
8 26826, 26827, 26964, 26965, 26966, 26967, 26969/
DATA N(1198),N(1199),N(1200),N(1201),N(1202),N(1203),N(1204),
1 N(1205),N(1206),N(1207),N(1208),N(1209),N(1210),N(1211),
2 N(1212),N(1213),N(1214),N(1215),N(1216),N(1217),N(1218),
3 N(1219),N(1220),N(1221),N(1222),N(1223),N(1224),N(1225),
4 N(1226),N(1227),N(1228),N(1229),N(1230),N(1231),N(1232),
5 N(1233),N(1234),N(1235),N(1236),N(1237),N(1238),N(1239),
6 N(1240),N(1241),N(1242),N(1243),N(1244),N(1245),N(1246)/
1 26970, 26983, 26984, 26985, 26986, 26987, 26988,
1 26989, 26994, 26996, 26997, 26998, 27136, 27137,
2 27138, 27140, 27141, 27155, 27156, 27157, 27158,
3 27159, 27160, 27161, 27165, 27167, 27168, 27169,
4 27480, 27482, 27483, 27499, 27500, 27501, 27502,
5 27503, 27504, 27505, 27509, 27510, 27511, 27824,
6 27825, 27843, 27844, 27845, 27846, 27847, 27853/
DATA C( 1),C( 2),C( 3),C( 4),C( 5),
1 C( 6),C( 7),C( 8),C( 9),C( 10),
2 C( 11),C( 12),C( 13),C( 14),C( 15),
3 C( 16),C( 17),C( 18),C( 19),C( 20),
4 C( 21),C( 22),C( 23),C( 24),C( 25),
5 C( 26),C( 27),C( 28),C( 29),C( 30),
6 C( 31),C( 32),C( 33),C( 34),C( 35),
7 C( 36),C( 37),C( 38),C( 39),C( 40),
8 C( 41),C( 42),C( 43),C( 44),C( 45)/
1 -1.00000000, 1.00000000, 1.00000000,-0.43033148,-0.57735027,
1 -0.69388867, 0.46291005, 0.88640526, 1.00000000,-0.57142857,
2 0.82065181,-0.33197000,-0.43094580, 0.62105900,-0.56424050,
3 -0.74230749,-0.67005939, 0.53302898, 0.50775240, 0.10579509,
4 -0.66848710, 1.00000000, 0.61167774,-0.48157133, 0.62764591,
5 -0.23592081, 0.39176891, 0.14577886,-0.31652098, 0.60692579,
6 -0.54869169, 0.58028846,-0.81441102, 0.27664167, 0.18463724,
7 0.54632352, 0.50000000,-0.58387421, 1.00000000, 0.52223297,
8 0.85280287,-0.10547625,-0.28229955,-0.32387514,-0.30924366/
DATA C( 46),C( 47),C( 48),C( 49),C( 50),
1 C( 51),C( 52),C( 53),C( 54),C( 55),
2 C( 56),C( 57),C( 58),C( 59),C( 60),
3 C( 61),C( 62),C( 63),C( 64),C( 65),
4 C( 66),C( 67),C( 68),C( 69),C( 70),
5 C( 71),C( 72),C( 73),C( 74),C( 75),
6 C( 76),C( 77),C( 78),C( 79),C( 80),
7 C( 81),C( 82),C( 83),C( 84),C( 85),
8 C( 86),C( 87),C( 88),C( 89),C( 90)/
1 -0.44290797,-0.71588233, 1.00000000,-0.32311516, 0.28483295,
1 0.10963225, 0.50076428, 0.74275345, 0.72374686, 0.69006556,
2 0.00000000, 0.90138782, 0.43301270, 0.00000000,-0.51176632,
3 -0.47871355,-0.52231931,-0.48591266, 0.65578924,-0.30190368,
4 0.69194988, 0.00000000, 0.45425676,-0.19245009, 0.65237661,
5 0.57534209, 0.61506656,-0.75018035, 0.24273969, 0.59009684,
6 -0.25000000, 0.47073444,-0.16366342,-0.58387421, 0.24584459,
7 0.15054845, 0.39831375, 0.07862136, 0.56330071, 0.35536602,
8 -0.36570652,-0.41800297,-0.59009684, 0.00000000, 0.46291005/
DATA C( 91),C( 92),C( 93),C( 94),C( 95),
1 C( 96),C( 97),C( 98),C( 99),C( 100),
2 C( 101),C( 102),C( 103),C( 104),C( 105),
3 C( 106),C( 107),C( 108),C( 109),C( 110),
4 C( 111),C( 112),C( 113),C( 114),C( 115),
5 C( 116),C( 117),C( 118),C( 119),C( 120),
6 C( 121),C( 122),C( 123),C( 124),C( 125),
7 C( 126),C( 127),C( 128),C( 129),C( 130),
8 C( 131),C( 132),C( 133),C( 134),C( 135)/
1 0.66143783,-0.18093672, 0.31180478, 0.00000000,-0.38188131,
1 -0.17583888, 0.52174919, 0.47871355, 0.38036289,-0.21730675,
2 0.78173596, 0.24618298,-0.57295971,-0.25000000,-0.41514875,
3 0.36045006, 0.70808819, 0.15312992,-0.33224932, 0.27638540,
4 -0.22047928, 0.48448140, 0.12826921, 0.13048023,-0.61124985,
5 -0.17335081, 0.45069149, 0.41666667, 0.55618651,-0.32914029,
6 0.45184806, 0.45226702,-0.33217391,-0.08177556,-0.29545335,
7 0.23273733, 0.44044302, 0.48870247,-0.43619213, 0.08832770,
8 -0.12125742, 0.28496006, 0.12133753, 0.64241607, 0.48349378/
DATA C( 136),C( 137),C( 138),C( 139),C( 140),
1 C( 141),C( 142),C( 143),C( 144),C( 145),
2 C( 146),C( 147),C( 148),C( 149),C( 150),
3 C( 151),C( 152),C( 153),C( 154),C( 155),
4 C( 156),C( 157),C( 158),C( 159),C( 160),
5 C( 161),C( 162),C( 163),C( 164),C( 165),
6 C( 166),C( 167),C( 168),C( 169),C( 170),
7 C( 171),C( 172),C( 173),C( 174),C( 175),
8 C( 176),C( 177),C( 178),C( 179),C( 180)/
1 0.59458839,-0.13055824,-0.64048987, 0.32816506, 0.47673129,
1 0.48760869,-0.20965697, 0.06933752, 0.10697366,-0.32271041,
2 0.40621719, 0.33640107,-0.62433396,-0.34045424, 0.22753200,
3 0.00000000,-0.25680669,-0.56846584, 0.07873048, 0.63944838,
4 0.02765610, 0.44163258,-0.24812912,-0.36237154,-0.08985472,
5 -0.35257835,-0.06085806,-0.59091234, 0.43385301,-0.08333333,
6 -0.02179068,-0.35486043, 0.01669451, 0.85280287,-0.52223297,
7 0.42844654, 0.12741180,-0.43852901,-0.24425211, 0.69965026,
8 -0.24232731, 0.22754153, 0.14896090, 0.10780998, 0.44598081/
DATA C( 181),C( 182),C( 183),C( 184),C( 185),
1 C( 186),C( 187),C( 188),C( 189),C( 190),
2 C( 191),C( 192),C( 193),C( 194),C( 195),
3 C( 196),C( 197),C( 198),C( 199),C( 200),
4 C( 201),C( 202),C( 203),C( 204),C( 205),
5 C( 206),C( 207),C( 208),C( 209),C( 210),
6 C( 211),C( 212),C( 213),C( 214),C( 215),
7 C( 216),C( 217),C( 218),C( 219),C( 220),
8 C( 221),C( 222),C( 223),C( 224),C( 225)/
1 -0.10343324, 0.14666939,-0.55104508, 0.19796863,-0.03700808,
1 0.58231558, 0.37310125, 0.54816126, 0.37977726, 0.48186065,
2 -0.42882891,-0.19819613,-0.10336228, 0.00000000,-0.28953301,
3 0.19682848, 0.35106240, 0.52831170,-0.09115696,-0.45425676,
4 0.25973124, 0.37813561, 0.71774056, 0.69631062, 0.25735922,
5 0.41756314,-0.65133895, 0.12584556, 0.56509091,-0.16715904,
6 0.25663909,-0.03964274, 0.03307459,-0.24809145, 0.38549995,
7 -0.63299189,-0.08494120, 0.32871885, 0.42121177,-0.44289259,
8 -0.36162029, 0.76271277, 0.30223526,-0.20878157,-0.27709317/
DATA C( 226),C( 227),C( 228),C( 229),C( 230),
1 C( 231),C( 232),C( 233),C( 234),C( 235),
2 C( 236),C( 237),C( 238),C( 239),C( 240),
3 C( 241),C( 242),C( 243),C( 244),C( 245),
4 C( 246),C( 247),C( 248),C( 249),C( 250),
5 C( 251),C( 252),C( 253),C( 254),C( 255),
6 C( 256),C( 257),C( 258),C( 259),C( 260),
7 C( 261),C( 262),C( 263),C( 264),C( 265),
8 C( 266),C( 267),C( 268),C( 269),C( 270)/
1 -0.07126966, 0.05991343,-0.44797135, 0.49279485, 0.42957140,
1 -0.20795142,-0.01833397,-0.44645719, 1.00000000, 0.20044593,
2 0.50209645, 0.84126131, 0.04494675,-0.28866347,-0.29927020,
3 -0.31303687,-0.38895504,-0.74611002,-0.11255042,-0.08040319,
4 -0.48412292,-0.87500000, 0.04264719,-0.00400309,-0.11310348,
5 -0.15720704,-0.55191445,-0.70226590, 0.32181306,-0.24353263,
6 0.00000000,-1.00000000, 0.00000000, 0.00000000,-1.00000000,
7 0.00000000, 0.00000000, 0.00000000,-1.00000000, 0.60944940,
8 -0.27386128, 0.57008771, 0.47809144, 0.00000000, 0.53452248/
DATA C( 271),C( 272),C( 273),C( 274),C( 275),
1 C( 276),C( 277),C( 278),C( 279),C( 280),
2 C( 281),C( 282),C( 283),C( 284),C( 285),
3 C( 286),C( 287),C( 288),C( 289),C( 290),
4 C( 291),C( 292),C( 293),C( 294),C( 295),
5 C( 296),C( 297),C( 298),C( 299),C( 300),
6 C( 301),C( 302),C( 303),C( 304),C( 305),
7 C( 306),C( 307),C( 308),C( 309),C( 310),
8 C( 311),C( 312),C( 313),C( 314),C( 315)/
1 -0.45643546, 0.35192842,-0.51639778,-0.33975300,-0.03253000,
1 -0.48249791,-0.48517105,-0.26452513,-0.53649854, 0.41586342,
2 0.00000000,-0.48181206, 0.61237244, 0.38435306, 0.13363062,
3 -0.47673129, 0.37796447, 0.38575837,-0.20412415,-0.48797057,
4 0.28867513,-0.47349818,-0.22906142, 0.26181747,-0.28288947,
5 -0.34821287, 0.00000000, 0.28689930,-0.27491915, 0.24366266,
6 -0.47628967, 0.59468669, 0.03088664, 0.46362387,-0.10660036,
7 0.74484762,-0.18182026, 0.27524094, 0.33177569, 0.26231196,
8 0.43034959,-0.11011458, 0.01148470, 0.17991300, 0.22986094/
DATA C( 316),C( 317),C( 318),C( 319),C( 320),
1 C( 321),C( 322),C( 323),C( 324),C( 325),
2 C( 326),C( 327),C( 328),C( 329),C( 330),
3 C( 331),C( 332),C( 333),C( 334),C( 335),
4 C( 336),C( 337),C( 338),C( 339),C( 340),
5 C( 341),C( 342),C( 343),C( 344),C( 345),
6 C( 346),C( 347),C( 348),C( 349),C( 350),
7 C( 351),C( 352),C( 353),C( 354),C( 355),
8 C( 356),C( 357),C( 358),C( 359),C( 360)/
1 0.51219691, 0.62143714,-0.44048612, 0.01340272, 0.25180343,
1 -0.50744155,-0.15093650, 0.40572554, 0.19247393,-0.24346995,
2 -0.21861018, 0.13671513,-0.36700156, 0.69084928,-0.17837652,
3 -0.49613894,-0.18018749, 0.46074691, 0.34815531, 0.23028309,
4 -0.01038830, 0.00000000,-0.28909810,-0.34581606,-0.03344406,
5 -0.53153186, 0.39583081,-0.42679802, 0.31426968, 0.00000000,
6 -0.34906543,-0.37116723,-0.50852915, 0.26729435, 0.31399976,
7 0.38380516,-0.12616750, 0.18678482, 0.12192444,-0.40090693,
8 0.16691087,-0.57447786, 0.68565635, 0.06546783,-0.08353986/
DATA C( 361),C( 362),C( 363),C( 364),C( 365),
1 C( 366),C( 367),C( 368),C( 369),C( 370),
2 C( 371),C( 372),C( 373),C( 374),C( 375),
3 C( 376),C( 377),C( 378),C( 379),C( 380),
4 C( 381),C( 382),C( 383),C( 384),C( 385),
5 C( 386),C( 387),C( 388),C( 389),C( 390),
6 C( 391),C( 392),C( 393),C( 394),C( 395),
7 C( 396),C( 397),C( 398),C( 399),C( 400),
8 C( 401),C( 402),C( 403),C( 404),C( 405)/
1 0.34745268, 0.14969667, 0.26593158,-0.35382921,-0.00944947,
1 -0.20099160, 0.31000347,-0.39789293,-0.33471790, 0.50399297,
2 -0.49717108,-0.11785556, 0.00000000, 0.37076232, 0.33182551,
3 0.50984022,-0.14584195,-0.06830266, 0.43826697,-0.05923006,
4 0.09949780, 0.72792179, 0.44289259, 0.14803913, 0.05084928,
5 -0.49947451,-0.17804952,-0.29613918, 0.00879698, 0.66789103,
6 0.48324358, 0.02851496,-0.28092983,-0.15311180,-0.29757612,
7 0.09586622,-0.10279694,-0.42878392,-0.43753788, 0.41299065,
8 -0.16221849,-0.08340592,-0.37013609, 0.11262702,-0.49573400/
DATA C( 406),C( 407),C( 408),C( 409),C( 410),
1 C( 411),C( 412),C( 413),C( 414),C( 415),
2 C( 416),C( 417),C( 418),C( 419),C( 420),
3 C( 421),C( 422),C( 423),C( 424),C( 425),
4 C( 426),C( 427),C( 428),C( 429),C( 430),
5 C( 431),C( 432),C( 433),C( 434),C( 435),
6 C( 436),C( 437),C( 438),C( 439),C( 440),
7 C( 441),C( 442),C( 443),C( 444),C( 445),
8 C( 446),C( 447),C( 448),C( 449),C( 450)/
1 0.12193159, 0.77211000, 0.19718643, 0.35828061, 0.48641409,
1 0.02690239,-0.17576205,-0.45392831, 0.53696194, 0.41654015,
2 0.37419532,-0.37371840, 0.14426245, 0.26305473, 0.02483088,
3 0.53968147,-0.47760925, 0.04746916,-0.01920846,-0.35960169,
4 0.01900128, 0.51802931,-0.10083588, 0.70076489, 0.52660319,
5 -0.48126671,-0.25642563, 0.02533621,-0.39400753, 0.25394004,
6 0.57415378,-0.26789986, 0.30184717,-0.47046986, 0.04671766,
7 -0.09647360,-0.45429508,-0.50619797,-0.12824679, 0.34967897,
8 -0.28843245,-0.55133838, 0.82247832, 0.56879646, 0.23742904/
DATA C( 451),C( 452),C( 453),C( 454),C( 455),
1 C( 456),C( 457),C( 458),C( 459),C( 460),
2 C( 461),C( 462),C( 463),C( 464),C( 465),
3 C( 466),C( 467),C( 468),C( 469),C( 470),
4 C( 471),C( 472),C( 473),C( 474),C( 475),
5 C( 476),C( 477),C( 478),C( 479),C( 480),
6 C( 481),C( 482),C( 483),C( 484),C( 485),
7 C( 486),C( 487),C( 488),C( 489),C( 490),
8 C( 491),C( 492),C( 493),C( 494),C( 495)/
1 0.33667678,-0.54612918, 0.34759718, 0.51879778,-0.37688749,
1 -0.02511298, 0.38819208,-0.51191496,-0.63838653,-0.16687539,
2 0.38888889, 1.00000000, 0.23354968, 0.47548602, 0.84815540,
3 0.09759001, 0.56138357, 0.82178140, 0.43130840, 0.49585055,
4 -0.26651166, 0.57866094, 0.36579446, 0.16859050,-0.25323693,
5 0.20201319, 0.51219691, 0.58763058,-0.47820778, 0.19766648,
6 0.14014583,-0.00328254, 0.25323693,-0.43639836,-0.29281532,
7 -0.41400384, 0.06643721,-0.29805475,-0.44388359,-0.33668865,
8 -0.01320602, 0.14056891,-0.25438376, 0.47157095, 0.57652649/
DATA C( 496),C( 497),C( 498),C( 499),C( 500),
1 C( 501),C( 502),C( 503),C( 504),C( 505),
2 C( 506),C( 507),C( 508),C( 509),C( 510),
3 C( 511),C( 512),C( 513),C( 514),C( 515),
4 C( 516),C( 517),C( 518),C( 519),C( 520),
5 C( 521),C( 522),C( 523),C( 524),C( 525),
6 C( 526),C( 527),C( 528),C( 529),C( 530),
7 C( 531),C( 532),C( 533),C( 534),C( 535),
8 C( 536),C( 537),C( 538),C( 539),C( 540)/
1 -0.32177884,-0.05689668,-0.54286131, 0.20919081,-0.19212150,
1 0.51706696,-0.36411138,-0.33471790, 0.31964803,-0.42736334,
2 -0.36491543,-0.00273124, 0.15439820, 0.09640588,-0.27847745,
3 0.41148557, 0.40239077,-0.29206961, 0.42338486,-0.07737470,
4 -0.29110181,-0.06404050,-0.17729389, 0.22898069,-0.38465391,
5 0.00000000, 0.78288136,-0.60829185, 0.13068205, 0.34331619,
6 0.44072907,-0.09005063, 0.14426245, 0.49737522,-0.41888702,
7 0.08430450,-0.47855556,-0.22030220,-0.26096045, 0.07286393,
8 0.16633621,-0.60223739, 0.28813487,-0.09661210,-0.50922020/
DATA C( 541),C( 542),C( 543),C( 544),C( 545),
1 C( 546),C( 547),C( 548),C( 549),C( 550),
2 C( 551),C( 552),C( 553),C( 554),C( 555),
3 C( 556),C( 557),C( 558),C( 559),C( 560),
4 C( 561),C( 562),C( 563),C( 564),C( 565),
5 C( 566),C( 567),C( 568),C( 569),C( 570),
6 C( 571),C( 572),C( 573),C( 574),C( 575),
7 C( 576),C( 577),C( 578),C( 579),C( 580),
8 C( 581),C( 582),C( 583),C( 584),C( 585)/
1 0.26852609, 0.25284925, 1.00000000, 0.69006556,-0.72374686,
1 0.40458680,-0.63327851,-0.65974833, 1.00000000, 0.32530002,
2 0.53045762,-0.78281199,-0.23407042, 0.17271232,-0.24549513,
3 0.46770717, 0.54616431,-0.58143631, 0.82065181, 0.57142857,
4 -0.46311040, 0.63654914, 0.50964719, 0.34726602,-0.67005939,
5 0.74230749, 0.26376748, 0.60302269,-0.46070044, 0.59543720,
6 -0.28729720, 0.38739147,-0.23971551, 0.40629960,-0.59227836,
7 -0.35832257, 0.25623537, 0.00000000,-0.41089070, 0.73502363,
8 -0.53935989,-0.66068747,-0.32232919, 0.67793507,-0.18018749/
DATA C( 586),C( 587),C( 588),C( 589),C( 590),
1 C( 591),C( 592),C( 593),C( 594),C( 595),
2 C( 596),C( 597),C( 598),C( 599),C( 600),
3 C( 601),C( 602),C( 603),C( 604),C( 605),
4 C( 606),C( 607),C( 608),C( 609),C( 610),
5 C( 611),C( 612),C( 613),C( 614),C( 615),
6 C( 616),C( 617),C( 618),C( 619),C( 620),
7 C( 621),C( 622),C( 623),C( 624),C( 625),
8 C( 626),C( 627),C( 628),C( 629),C( 630)/
1 0.00000000,-0.57495957,-0.64967524,-0.46354723,-0.88640526,
1 0.46291005,-0.50964719, 0.56407607,-0.64967524, 0.00000000,
2 0.27147034, 0.13366276, 0.48049998, 0.32740555, 0.26382175,
3 -0.11183028, 0.00000000, 0.25109987,-0.65207701,-0.34458439,
4 -0.42531228,-0.29614946,-0.72074997,-0.30526388, 0.12140523,
5 0.84112008, 0.52704628,-0.36421568,-0.37219368,-0.30007214,
6 -0.07935287, 0.60062498, 0.52127562, 0.81441102, 0.58028846,
7 -0.34338584, 0.57295971, 0.59988661,-0.28644595, 0.33449680,
8 0.09848947, 0.24246432,-0.22776477, 0.27602622,-0.13059124/
DATA C( 631),C( 632),C( 633),C( 634),C( 635),
1 C( 636),C( 637),C( 638),C( 639),C( 640),
2 C( 641),C( 642),C( 643),C( 644),C( 645),
3 C( 646),C( 647),C( 648),C( 649),C( 650),
4 C( 651),C( 652),C( 653),C( 654),C( 655),
5 C( 656),C( 657),C( 658),C( 659),C( 660),
6 C( 661),C( 662),C( 663),C( 664),C( 665),
7 C( 666),C( 667),C( 668),C( 669),C( 670),
8 C( 671),C( 672),C( 673),C( 674),C( 675)/
1 -0.04057204,-0.13927937, 0.20951312,-0.51874741,-0.23657362,
1 -0.62958955, 0.46291005,-0.08322504,-0.42163702, 0.77524841,
2 0.69388867,-0.69631062,-0.18349396, 0.48104569,-0.37261639,
3 0.58297525,-0.37639940,-0.38498756, 1.00000000,-0.40144368,
4 0.00000000, 0.25910011,-0.44955300, 0.67936622, 0.32874571,
5 -0.16197651, 0.00000000, 0.01632177, 0.18412804,-0.52667457,
6 -0.48493328,-0.51787965, 0.34815531, 0.12842931, 0.10589704,
7 0.09963915,-0.10308122, 0.56101676,-0.13345696, 0.34702310,
8 -0.73239243, 0.69631062,-0.71774056,-0.31938548, 0.02159168/
DATA C( 676),C( 677),C( 678),C( 679),C( 680),
1 C( 681),C( 682),C( 683),C( 684),C( 685),
2 C( 686),C( 687),C( 688),C( 689),C( 690),
3 C( 691),C( 692),C( 693),C( 694),C( 695),
4 C( 696),C( 697),C( 698),C( 699),C( 700),
5 C( 701),C( 702),C( 703),C( 704),C( 705),
6 C( 706),C( 707),C( 708),C( 709),C( 710),
7 C( 711),C( 712),C( 713),C( 714),C( 715),
8 C( 716),C( 717),C( 718),C( 719),C( 720)/
1 -0.40897064, 0.69535350,-0.49674264, 1.00000000,-0.25910011,
1 0.58177447,-0.17239571, 0.75145546,-0.22850482, 0.18412804,
2 0.24863262,-0.25335158,-0.19383577, 0.57305764,-0.57089923,
3 -0.12517794,-0.11370705, 0.25958642, 0.20669039, 0.15569979,
4 0.43471912, 0.61678163, 0.60302269, 1.00000000,-0.32387514,
5 -0.34188173,-0.25882780, 0.84334450, 1.00000000,-0.26444294,
6 -0.70586950, 0.65712874,-0.16246591, 0.13746435,-0.28234396,
7 0.36322384, 0.29782906, 0.36155076,-0.67685952, 0.08291006,
8 0.18859953,-0.15183850, 0.33364240, 0.18541140,-0.38525706/
DATA C( 721),C( 722),C( 723),C( 724),C( 725),
1 C( 726),C( 727),C( 728),C( 729),C( 730),
2 C( 731),C( 732),C( 733),C( 734),C( 735),
3 C( 736),C( 737),C( 738),C( 739),C( 740),
4 C( 741),C( 742),C( 743),C( 744),C( 745),
5 C( 746),C( 747),C( 748),C( 749),C( 750),
6 C( 751),C( 752),C( 753),C( 754),C( 755),
7 C( 756),C( 757),C( 758),C( 759),C( 760),
8 C( 761),C( 762),C( 763),C( 764),C( 765)/
1 0.84016805, 0.00000000,-0.43301270, 0.90138782, 0.00000000,
1 0.04279605,-0.44035242, 0.77747792,-0.44697464, 0.63737744,
2 0.71260964,-0.29315098, 0.00000000, 0.51426536, 0.74535599,
3 -0.34984298, 0.23996973, 0.00000000, 0.87831007,-0.47809144,
4 -0.55126772,-0.57800598,-0.17188791, 0.57659998, 0.00000000,
5 -0.49168917, 0.41985956, 0.01832417,-0.47501687,-0.59664303,
6 0.66571902,-0.27177865, 0.55901699, 0.41286141,-0.39834824,
7 -0.08481042, 0.02842676, 0.48181206, 0.28814594, 0.58181120,
8 0.42384264, 0.00000000,-0.61157663,-0.66097134,-0.43484585/
DATA C( 766),C( 767),C( 768),C( 769),C( 770),
1 C( 771),C( 772),C( 773),C( 774),C( 775),
2 C( 776),C( 777),C( 778),C( 779),C( 780),
3 C( 781),C( 782),C( 783),C( 784),C( 785),
4 C( 786),C( 787),C( 788),C( 789),C( 790),
5 C( 791),C( 792),C( 793),C( 794),C( 795),
6 C( 796),C( 797),C( 798),C( 799),C( 800),
7 C( 801),C( 802),C( 803),C( 804),C( 805),
8 C( 806),C( 807),C( 808),C( 809),C( 810)/
1 -0.19738551, 0.00000000, 0.52486388,-0.71168357, 0.42315879,
1 0.00000000, 0.41785545, 0.00000000,-0.29095719, 0.00000000,
2 0.69043646, 0.33834615, 0.38673003, 0.34815531, 0.82572282,
3 0.44381268, 0.00000000, 0.48795004,-0.02402500,-0.56138357,
4 -0.05884899, 0.47420220, 0.02010076, 0.00000000, 0.45133547,
5 0.11720654, 0.59215653,-0.51974019,-0.36190062, 0.33028913,
6 -0.37303862,-0.59009684, 0.52764485, 0.36462933, 0.15563294,
7 -0.19462474, 0.42228152,-0.20092126,-0.25784129,-0.51710797,
8 0.39325761,-0.14434299, 0.13523832,-0.42189033, 0.50396484/
DATA C( 811),C( 812),C( 813),C( 814),C( 815),
1 C( 816),C( 817),C( 818),C( 819),C( 820),
2 C( 821),C( 822),C( 823),C( 824),C( 825),
3 C( 826),C( 827),C( 828),C( 829),C( 830),
4 C( 831),C( 832),C( 833),C( 834),C( 835),
5 C( 836),C( 837),C( 838),C( 839),C( 840),
6 C( 841),C( 842),C( 843),C( 844),C( 845),
7 C( 846),C( 847),C( 848),C( 849),C( 850),
8 C( 851),C( 852),C( 853),C( 854),C( 855)/
1 0.52041650,-0.49619766, 0.47434165,-0.03100868, 0.50694478,
1 0.20198194, 0.35912150, 0.05189993,-0.28827833, 0.33815169,
2 0.12018504,-0.14281688,-0.31628407,-0.33823038,-0.51211811,
3 0.34430947, 0.35856858,-0.29009627,-0.65319726,-0.60050484,
4 -0.21976227,-0.62416611,-0.55238411, 0.00000000,-0.50694478,
5 0.36859753,-0.22348732, 0.13912795,-0.37823772, 0.00000000,
6 -0.51024997,-0.33324945,-0.06123948,-0.44577791, 0.27908865,
7 0.68620746, 0.36166309, 0.20299244, 0.31641775, 0.36949633,
8 0.34708136,-0.19426795, 0.37828249,-0.30586972, 0.45466149/
DATA C( 856),C( 857),C( 858),C( 859),C( 860),
1 C( 861),C( 862),C( 863),C( 864),C( 865),
2 C( 866),C( 867),C( 868),C( 869),C( 870),
3 C( 871),C( 872),C( 873),C( 874),C( 875),
4 C( 876),C( 877),C( 878),C( 879),C( 880),
5 C( 881),C( 882),C( 883),C( 884),C( 885),
6 C( 886),C( 887),C( 888),C( 889),C( 890),
7 C( 891),C( 892),C( 893),C( 894),C( 895),
8 C( 896),C( 897),C( 898),C( 899),C( 900)/
1 0.15247250,-0.29119327, 0.38363511, 0.12178925,-0.39580587,
1 0.30071141, 0.04182608, 0.21013292, 0.64706103,-0.47609523,
2 -0.43693145, 0.34580402,-0.59982515, 0.63705899, 0.08770580,
3 -0.45361105, 0.11994004,-0.08077577,-0.18220552, 0.34401480,
4 0.47668965, 0.37782510, 0.47894409, 0.02893611,-0.05755478,
5 -0.25272071,-0.29763334,-0.30410439, 0.14101902,-0.05801194,
6 0.83254542,-0.45895804, 0.27013682,-0.01474992, 0.10000000,
7 -0.14025430,-0.34641413,-0.50592426, 0.33964267,-0.43249141,
8 -0.45452651, 0.08234836, 0.25128243, 0.12338821, 0.47304992/
DATA C( 901),C( 902),C( 903),C( 904),C( 905),
1 C( 906),C( 907),C( 908),C( 909),C( 910),
2 C( 911),C( 912),C( 913),C( 914),C( 915),
3 C( 916),C( 917),C( 918),C( 919),C( 920),
4 C( 921),C( 922),C( 923),C( 924),C( 925),
5 C( 926),C( 927),C( 928),C( 929),C( 930),
6 C( 931),C( 932),C( 933),C( 934),C( 935),
7 C( 936),C( 937),C( 938),C( 939),C( 940),
8 C( 941),C( 942),C( 943),C( 944),C( 945)/
1 -0.15118579,-0.43064434,-0.75359942, 0.52934521,-0.79279210,
1 -0.28707775, 0.09386630,-0.00705849,-0.15192972, 0.23325754,
2 -0.31479732, 0.42085784,-0.58547930,-0.11064578, 0.03028011,
3 0.35038050,-0.40165815,-0.07904722, 0.18539727,-0.71363085,
4 -0.43537604, 0.51653322, 0.11062548,-0.24936302, 0.47098986,
5 -0.09483254,-0.66783194,-0.40655815, 0.05989834, 0.02693426,
6 0.01547121, 0.28091598, 0.47243600,-0.42706303, 0.06412771,
7 0.48604988,-0.59503322,-0.54676416, 0.48096899, 0.65926034,
8 0.18733281,-0.25739281, 0.45433533, 0.15528043,-0.48670739/
DATA C( 946),C( 947),C( 948),C( 949),C( 950),
1 C( 951),C( 952),C( 953),C( 954),C( 955),
2 C( 956),C( 957),C( 958),C( 959),C( 960),
3 C( 961),C( 962),C( 963),C( 964),C( 965),
4 C( 966),C( 967),C( 968),C( 969),C( 970),
5 C( 971),C( 972),C( 973),C( 974),C( 975),
6 C( 976),C( 977),C( 978),C( 979),C( 980),
7 C( 981),C( 982),C( 983),C( 984),C( 985),
8 C( 986),C( 987),C( 988),C( 989),C( 990)/
1 0.48942435, 0.43967023,-0.06895114, 0.16950481, 0.71588233,
1 0.31289311, 0.62418778,-0.30859596, 0.29700890, 0.62731887,
2 0.20519994, 0.20407796, 0.47966922, 0.29604039, 0.08105771,
3 -0.10970961, 0.05423494,-0.23562572, 0.34917780,-0.83055129,
4 -0.36433493,-0.68465320, 0.68599434,-0.24629609, 0.12293415,
5 -0.07551982,-0.04575667,-0.51584070, 0.54843590,-0.11407586,
6 0.24537764, 0.58051118, 0.87500000,-0.48412292, 0.35774400,
7 -0.36123639,-0.19303842,-0.40532207, 0.58121885,-0.38252759,
8 0.02231003, 0.23523868,-0.49705012,-0.35540933, 0.79159673/
DATA C( 991),C( 992),C( 993),C( 994),C( 995),
1 C( 996),C( 997),C( 998),C( 999),C(1000),
2 C(1001),C(1002),C(1003),C(1004),C(1005),
3 C(1006),C(1007),C(1008),C(1009),C(1010),
4 C(1011),C(1012),C(1013),C(1014),C(1015),
5 C(1016),C(1017),C(1018),C(1019),C(1020),
6 C(1021),C(1022),C(1023),C(1024),C(1025),
7 C(1026),C(1027),C(1028),C(1029),C(1030),
8 C(1031),C(1032),C(1033),C(1034),C(1035)/
1 -0.56879646, 0.82247832, 0.31878114,-0.01761175, 0.12431080,
1 -0.65054737, 0.62418778, 0.26418359, 0.82915620, 0.55901699,
2 -0.05062333, 0.43157538,-0.55284940, 0.42283026, 0.51580010,
3 -0.24637845, 0.71818485, 0.69585237,-1.00000000, 0.31504854,
4 0.32387514, 0.16249247,-0.87308716, 0.08464226, 1.00000000,
5 -0.25451391,-0.34767675,-0.49286406, 0.75592895,-0.22941573,
6 0.97332853, 0.59009684, 0.75000000,-0.15691148,-0.16366342,
7 0.19462474, 0.38516444,-0.35816399,-0.48536267, 0.28132791,
8 0.49029034, 0.09485397, 0.38904148, 0.08893497, 0.52041650/
DATA C(1036),C(1037),C(1038),C(1039),C(1040),
1 C(1041),C(1042),C(1043),C(1044),C(1045),
2 C(1046),C(1047),C(1048),C(1049),C(1050),
3 C(1051),C(1052),C(1053),C(1054),C(1055),
4 C(1056),C(1057),C(1058),C(1059),C(1060),
5 C(1061),C(1062),C(1063),C(1064),C(1065),
6 C(1066),C(1067),C(1068),C(1069),C(1070),
7 C(1071),C(1072),C(1073),C(1074),C(1075),
8 C(1076),C(1077),C(1078),C(1079),C(1080)/
1 0.00000000,-0.40824829, 0.75000000, 0.15709706,-0.49172021,
1 0.00000000, 0.35863242, 0.15267090, 0.61941522, 0.29688554,
2 -0.33024747,-0.02695358, 0.00000000, 0.11952286,-0.79063786,
3 0.00000000, 0.60050484, 0.47537502, 0.17183782,-0.03413944,
4 0.77368161,-0.38044924, 0.00000000, 0.48343279, 0.20150717,
5 -0.12857091,-0.48552241, 0.13402539,-0.02407167, 0.01217284,
6 0.19641032, 0.64510283,-0.29687160, 0.34422316, 0.80634661,
7 0.22070139,-0.25119905,-0.17712353,-0.28575465, 0.36004115,
8 0.30594089,-0.39580587,-0.08952211, 0.03145244,-0.10076796/
DATA C(1081),C(1082),C(1083),C(1084),C(1085),
1 C(1086),C(1087),C(1088),C(1089),C(1090),
2 C(1091),C(1092),C(1093),C(1094),C(1095),
3 C(1096),C(1097),C(1098),C(1099),C(1100),
4 C(1101),C(1102),C(1103),C(1104),C(1105),
5 C(1106),C(1107),C(1108),C(1109),C(1110),
6 C(1111),C(1112),C(1113),C(1114),C(1115),
7 C(1116),C(1117),C(1118),C(1119),C(1120),
8 C(1121),C(1122),C(1123),C(1124),C(1125)/
1 -0.26344634,-0.30788765, 0.09615773, 0.58808996, 0.63636364,
1 0.04557095, 0.50021640,-0.45906841,-0.36332404, 0.24982511,
2 0.37146603, 0.51140831, 0.40692065, 0.03085432,-0.60952894,
3 -0.02309634, 0.11592080,-0.17509004,-0.06035836, 0.54264758,
4 0.60367380, 0.35534029, 0.11918842, 0.23334262, 0.31292084,
5 0.82227511,-0.33826480,-0.16739766, 0.20989508, 0.37062466,
6 -0.08600609,-0.42610802,-0.27661426, 0.25128243,-0.01661874,
7 -0.12545774,-0.02697151, 0.01977852,-0.08845225, 0.70277316,
8 -0.39054860,-0.34479141,-0.88155706,-0.29541958, 0.12924123/
DATA C(1126),C(1127),C(1128),C(1129),C(1130),
1 C(1131),C(1132),C(1133),C(1134),C(1135),
2 C(1136),C(1137),C(1138),C(1139),C(1140),
3 C(1141),C(1142),C(1143),C(1144),C(1145),
4 C(1146),C(1147),C(1148),C(1149),C(1150),
5 C(1151),C(1152),C(1153),C(1154),C(1155),
6 C(1156),C(1157),C(1158),C(1159),C(1160),
7 C(1161),C(1162),C(1163),C(1164),C(1165),
8 C(1166),C(1167),C(1168),C(1169),C(1170)/
1 -0.14725035, 0.02239804,-0.55151734,-0.69946400,-0.42941170,
1 0.28969349, 0.10639879,-0.09439190, 0.12425430, 0.10939290,
2 -0.63233119,-0.46890489, 0.20079839, 0.36491474,-0.27430625,
3 0.83805796, 0.14662960, 0.44609041, 0.27778043,-0.26670097,
4 0.03581772,-0.11486817, 0.28091598,-0.05773750, 0.26475240,
5 0.29151891, 0.50361016, 0.36358096, 0.53967969,-0.22209922,
6 -0.37644133, 0.83158974,-0.33138145,-0.08722784, 0.00000000,
7 1.00000000, 0.00000000, 0.00000000,-1.00000000, 0.00000000,
8 -0.45069391, 0.55198505, 0.68122133, 0.16770510,-0.43424812/
DATA C(1171),C(1172),C(1173),C(1174),C(1175),
1 C(1176),C(1177),C(1178),C(1179),C(1180),
2 C(1181),C(1182),C(1183),C(1184),C(1185),
3 C(1186),C(1187),C(1188),C(1189),C(1190),
4 C(1191),C(1192),C(1193),C(1194),C(1195),
5 C(1196),C(1197),C(1198),C(1199),C(1200),
6 C(1201),C(1202),C(1203),C(1204),C(1205),
7 C(1206),C(1207),C(1208),C(1209),C(1210),
8 C(1211),C(1212),C(1213),C(1214),C(1215)/
1 -0.39036003, 0.39252271, 0.30705979,-0.19893898,-0.09026709,
1 -0.60246408, 0.60092521, 0.28647985,-0.09128709,-0.68030913,
2 -0.29268470, 0.17618333,-0.31445669, 0.20371901,-0.18516402,
3 -0.45659883, 0.36288737,-0.38929769, 0.44506130,-0.03215715,
4 -0.26449735, 0.18301466, 0.39886202,-0.63065622, 0.41833001,
5 -0.14638501, 0.19943101,-0.45495112, 0.18712786, 0.16817499,
6 0.37712362,-0.30388432, 0.10490611,-0.31831399, 0.18696714,
7 0.00000000, 0.31928050, 0.61170246,-0.28058280, 0.24570169,
8 0.70753160,-0.35013734,-0.51219823, 0.23256513, 0.17472120/
DATA C(1216),C(1217),C(1218),C(1219),C(1220),
1 C(1221),C(1222),C(1223),C(1224),C(1225),
2 C(1226),C(1227),C(1228),C(1229),C(1230),
3 C(1231),C(1232),C(1233),C(1234),C(1235),
4 C(1236),C(1237),C(1238),C(1239),C(1240),
5 C(1241),C(1242),C(1243),C(1244),C(1245),
6 C(1246)/
1 -0.31891911, 0.25653843,-0.27487371,-0.04396774, 0.25486715,
1 0.38354804,-0.28126022, 0.26953585,-0.18856181,-0.57016104,
2 0.64620617,-0.63548891,-0.42257713,-0.17754824,-0.42063193,
3 -0.29141807,-0.53012821, 0.23982564, 0.50949026, 0.17032450,
4 0.18654365, 0.07213778, 0.19868442,-0.55901699, 0.82915620,
5 0.32099012,-0.20923295,-0.48060204, 0.44415195,-0.65017188,
6 0.04705497/
END
FINISH
****
1 1 7 17 47 73 119 119 119 73 47 17 7 1
SPDFGHIKLMNOQ
AB
1 2 3 1
2 1 6 1
3 2 2 2
4 5 4 1
5 2 7 3
6 3 3 5
7 4 2 4
8 1 9 2
9 6 5 1
10 1 10 1
11 2 5 2
12 3 1 1
13 2 3 1
14 1 0 1
****
AAHDA NEW VERSION OF NJSYM. FORTRAN IV A GENERAL PROGRAM TO CALCULATE
1 ATOMIC CONTINUUM PROCESSES USING THE R-MATRIX METHOD.
2 BERRINGTON, K.A., BURKE, P.G., CHANG, J.J., CHIVERS, A.T.,
3 ROBB, W.D., TAYLOR, K.T.
REF. IN COMP. PHYS. COMMUN. 8 (1974) 149
IN $SPQU01,$ONE.AH.NJSMS
LIST
PROGRAM(NYSM)
INPUT 1=CR0
OUTPUT 2=LP0
TRACE1
COMPRESS INTEGER AND LOGICAL
END
C
C A PROGRAM TO CALCULATE A GENERAL RECOUPLING COEFFICIENT.
C P.G.BURKE,
C QUEENS UNIVERSITY BELFAST.
C
C
C DESCRIPTION OF COMMON BLOCKS
C
C C O M M O N B L O C K C O U P L E
C
C M THE TOTAL NUMBER OF ANGULAR MOMENTUM VALUES IN THE
C INITIAL AND FINAL STATES
C N THE NUMBER OF BASIC ANGULAR MOMENTUM VALUES THAT
C ARE COUPLED
C J1(I),I=1,M THE ANGULAR MOMENTUM VALUES STORED AS 2J+1
C J2(I,J),I=1,(N-1),J=1,3 THE POSITION IN THE J1 ARRAY OF THE
C INITIAL STATE TRIADS
C J3(I,J),I=1,(N-1),J=1,3 THE POSITION IN THE J1 ARRAY OF THE
C FINAL STATE TRIADS
C
C
C
C C O M M O N B L O C K D E B U G
C
C IBUG1 NOT USED
C IBUG2 NOT USED
C IBUG3 DEBUG PRINTS IN NJSYM AND GENSUM IF IBUG3 EQUALS 1
C IBUG4 NOT USED
C IBUG5 NOT USED
C IBUG6 NOT USED
C
C
C
C C O M M O N B L O C K D E P T H S
C
C J4(J),J=1,M THE LEVEL OF J IN THE J2 COUPLING TREE EVALUATED
C BY SUBROUTINE GENJ45
C J5(J),J=1,M THE LEVEL OF J IN THE J3 COUPLING TREE ELALUATED
C BY SUBROUTINE GENJ45
C
C
C C O M M O N B L O C K D I M E N
C
C KFL1 NOT USED
C KFL2 TEST ON DIMENSIONS OF J2 AND J3 ARRAYS
C KFL3 TEST ON DIMENSION OF KW ARRAY
C KFL4 TEST ON DIMENSIONS OF K6 AND K8 ARRAYS
C KFL5 TEST ON DIMENSIONS OF K7 ARRAY
C KFL6 TEST ON DIMENSIONS OF JSUM1,JSUM2 ETC ARRAYS USED
C IN GENSUM
C KFL7 TEST ON DIMENSION OF J1 ARRAY
C
C
C C O M M O N B L O C K I N F O R M
C
C IREAD INPUT CHANNEL NUMBER
C IWRITE OUTPUT CHANNEL NUMBER
C
C
C
C C O M M O N B L O C K W C O M I 9
C
C I3 CONTAINS THE COLUMN OF THE J2 ARRAY WHICH CONTAINS
C THE FIRST ELEMENT TO BE BROUGHT INTO THE SAME
C TRIAD BY RECOUPLING. INPUT TO SUBROUTINE GENI9
C I4 CONTAINS THE COLUMN OF THE J2 ARRAY WHICH CONTAINS
C THE SECOND ELEMENT TO BE BROUGHT INTO THE SAME
C TRIAD BY RECOUPLING. INPUT TO SUBROUTINE GENI9
C I5 CONTAINS THE ROW OF THE J2 ARRAY WHICH CONTAINS
C THE FIRST ELEMENT,INPUT TO SUBROUTINE GENI9
C I6 CONTAINS THE ROW OF THE J2 ARRAY WHICH CONTAINS
C THE SECOND ELEMENT,INPUT TO SUBROUTINE GENI9
C I7 CONTAINS THE LEVEL OF THE I5 TRIAD BELOW THE
C COMMON TRIAD IN COUPLING SCHEME OF J2,EVALUATED BY
C SUBROUTINE GENI9
C I8 CONTAINS THE LEVEL OF THE I6 TRIAD BELOW THE
C COMMON TRIAD IN COUPLING SCHEME OF J2,EVALUATED BY
C SUBROUTINE GENI9
C I9 CONTAINS THE NUMBER OF RECOUPLINGS PLUS TWO.
C EVALUATED BY SUBROUTINE GENI9
C I17 CONTAINS THE ROW OF THE J2 ARRAY CONTAINING THE
C HIGHEST ELEMENT,EVALUATED BY SUBROUTINE GENI9
C I18 CONTAINS THE ROW OF THE J2 ARRAY CONTAINING THE
C LOWEST ELEMENT,EVALUATED BY SUBROUTINE GENI9
C I19 CONTAINS THE COLUMN OF THE J2 ARRAY CONTAINING THE
C HIGHEST ELEMENT,EVALUATED BY SUBROUTINE GENI9
C I20 CONTAINS THE COLUMN OF THE J2 ARRAY CONTAINING
C THE LOWEST ELEMENT,EVALUATED BY SUBROUTINE GENI9
C
C
C
C
C
MASTER TESTNJSYM
C
C READS AND WRITES RECOUPLING MATRICES J1,J2,AND J3
C CALLS NJSYM AND GENSUM AND WRITES OUT RESULT
C
DIMENSION K6(40),K7(80),K8(40),KW(6,20)
COMMON/COUPLE/M,N,J1(40),J2(12,3),J3(12,3)
COMMON/DEBUG/IBUG1,IBUG2,IBUG3,IBUG4,IBUG5,IBUG6,IBUG7,IBUG8,IBUG9
COMMON/DIMEN/KFL1,KFL2,KFL3,KFL4,KFL5,KFL6,KFL7
COMMON/INFORM/IREAD,IWRITE,IPUNCH
C
C FORMAT STATEMENTS
C
1 FORMAT(12I5)
2 FORMAT(7H RECUP=,E15.7///)
3 FORMAT(3H M=,I3,3H N=,I3//)
4 FORMAT(4H J1=,25I4)
5 FORMAT(19H J2 J3)
6 FORMAT(4X,3I4,4X,3I4)
9 FORMAT(23H1TEST OUTPUT FROM NJSYM////)
C
C SET INPUT AND OUTPUT CHANNEL NUMBERS
C
IREAD=1
IWRITE=2
C
C SET DEBUG PRINTS ZERO
C
IBUG1 = 0
IBUG2 = 0
IBUG3 = 0
IBUG4 = 0
IBUG5 = 0
IBUG6 = 0
C
C READ AND WRITE INPUT DATA
C
WRITE(IWRITE,9)
8 READ(IREAD,1) M,N
K=N-1
READ(IREAD,1) (J1(J),J=1,M)
READ(IREAD,1) ((J2(I,J),J=1,3),I=1,K)
READ(IREAD,1) ((J3(I,J),J=1,3),I=1,K)
WRITE(IWRITE,3) M,N
WRITE(IWRITE,4) (J1(J),J=1,M)
WRITE(IWRITE,5)
DO 7 I=1,K
WRITE(IWRITE,6) (J2(I,J),J=1,3),(J3(I,J),J=1,3)
7 CONTINUE
C
C CALLS NJSYM AND GENSUM AND WRITES OUT RESULT
C
CALL NJSYM (J6C,J7C,J8C,JWC,K6,K7,K8,KW,RECUP)
WRITE(IWRITE,2) RECUP
READ(IREAD,1) (J1(J),J=1,M)
WRITE(IWRITE,4) (J1(J),J=1,M)
CALL GENSUM(J6C,J7C,J8C,JWC,K6,K7,K8,KW,RECUP)
WRITE(IWRITE,2) RECUP
GO TO 8
END
SUBROUTINE NJSYM (J6C,J7C,J8C,JWC,K6,K7,K8,KW,RECUP)
C
C GENERAL RECOUPLING PROGRAMME
C EVALUATES THE RECOUPLING COEFFICIENT RECUP BETWEEN TWO COUPLING
C SCHEMES
C
C
C J6C THE NUMBER OF ELEMENTS IN THE K6 ARRAY
C J7C THE NUMBER OF ELEMENTS IN THE K7 ARRAY
C J8C THE NUMBER OF ELEMENTS IN THE K8 ARRAY
C JWC THE NUMBER OF COLUMNS IN THE KW ARRAY
C K6(I),I=1,J6C. EACH ENTRY CORRESPONDS TO A FACTOR SQRT(2J+1) IN
C RECUP. THE VALUE OF K6 GIVES POSITION IN J1 ARRAY
C WHERE J VALUE IS FOUND
C K7(I),I=1,J7C. EACH ENTRY CORRESPONDS TO A FACTOR (-1)**J IN
C RECUP
C K8(I),I=1,J8C. EACH ENTRY CORRESPONDS TO A FACTOR (-1)**(-J) IN
C RECUP
C KW(I,J),I=1,6,J=1,JWC. EACH COLUMN CORRESPONDS TO A RACAH
C COEFFICIENT IN RECUP
C RECUP THE RESULTANT RECOUPLING COEFFICIENT EVALUATED
C AND STORED IN RECUP
C
C
C THE ARRAYS K6,K7,K8 AND KW ARE EVALUATED BY NJSYM. THE ENTRY IN
C EACH CASE CORRESPONDS TO A POSITION IN THE J1 ARRAY WHERE THE
C 2J+1 VALUE IS FOUND IF LESS THAN OR EQUAL TO M,OR TO A SUMMATION
C VARIABLE IF GREATER THAN M
C
C THE SUMMATION OVER THE VARIABLES IN K6,K7,K8 AND KW AND THE
C EVALUATION OF RECUP IS CARRIED OUT IN GENSUM
C
C GENSUM CAN BE RE-ENTERED DIRECTLY TO EVALUATE DIFFERENT
C RECOUPLING COEFFICIENTS WITH THE SAME STRUCTURE BY JUST ALTERING
C THE NUMBERS IN THE J1 ARRAY
C
DIMENSION K6(40),K7(80),K8(40),KW(6,20)
COMMON/COUPLE/M,N,J1(40),J2(12,3),J3(12,3)
COMMON/DEBUG/IBUG1,IBUG2,IBUG3,IBUG4,IBUG5,IBUG6,IBUG7,IBUG8,IBUG9
COMMON/DEPTHS/J4(40),J5(40)
COMMON/DIMEN/KFL1,KFL2,KFL3,KFL4,KFL5,KFL6,KFL7
COMMON/INFORM/IREAD,IWRITE,IPUNCH
COMMON/WCOMI9/I3,I4,I5,I6,I7,I8,I9,I17,I18,I19,I20
DATA ZERO/0.0E0/
C
C FORMAT STATEMENTS USED IN NJSYM
C
50 FORMAT(59H RECOUPLING COEFFICIENT SET ZERO AS TRIANGLE DOES NOT MA
1TCH)
65 FORMAT(29H FAIL IN RECOUPLING PROGRAMME)
107 FORMAT(4H J1=,20I5)
108 FORMAT(23H J2 J3)
110 FORMAT(3I5,I10,2I5)
111 FORMAT(3H KW)
112 FORMAT(6I5)
113 FORMAT(4H K6=,38I3)
114 FORMAT(4H K7=,38I3)
115 FORMAT(4H K8=,38I3)
145 FORMAT(8H JWC = 0,8H J6C = 0,8H J7C = 0,8H J8C = 0)
204 FORMAT(23H KFL2 DIMENSION FAILURE)
207 FORMAT(23H KFL3 DIMENSION FAILURE)
208 FORMAT(23H KFL4 DIMENSION FAILURE)
209 FORMAT(23H KFL5 DIMENSION FAILURE)
221 FORMAT(17H NO KW ARRAYS SET)
226 FORMAT(17H NO K6 ARRAYS SET)
230 FORMAT(17H NO K7 ARRAYS SET)
233 FORMAT(17H NO K8 ARRAYS SET)
1208 FORMAT(23H KFL7 DIMENSION FAILURE)
C
C SET DIMENSIONVARIABLES AND TEST SOME OF DIMENSIONS
C
IF(KFL2-12) 200,201,200
200 KFL2=12
KFL3=20
KFL4=40
KFL5=80
KFL6=12
KFL7=40
C
C
201 IF(KFL2-N+1) 202,203,203
202 WRITE(IWRITE,204)
CALL EXIT
203 IF(KFL7-M)205,206,206
205 WRITE(IWRITE,1208)
CALL EXIT
C
C IP IS THE NUMBER OF INEQUIVALENT TRIADS WHICH HAVE TO BE
C RECOUPLED. IT IS SET INITIALLY TO THE TOTAL NUMBER OF TRIADS AND
C THEN DECREASED IN SECTION 1 BELOW AS THE RECOUPLING PROCEEDS
C UNTIL EVENTUALLY IT REACHES ZERO
C
206 IP=N-1
C
C DEBUG PRINTS
C
IF(IBUG3-1)124,123,124
123 WRITE(IWRITE,108)
DO 125 I=1,IP
WRITE(IWRITE,110) ((J2(I,J),J=1,3),(J3(I,J),J=1,3))
125 CONTINUE
C
C SET COUNTS ZERO. MP IS COUNT ON THE J VALUES WHICH ARE SUMMED
C OVER.
C
124 J6C=0
J7C=0
J8C=0
JWC=0
MP=M
C
C
C
C
C
C S E C T I O N 1
C
C THE FOLLOWING SECTION SEARCHES THE J2 AND J3 ARRAYS TO SEE IF
C ANY TRIADS ARE EQUIVALENT. IF SO IT PUTS THEM AT END OF J2 AND J3
C ARRAYS AND SETS IP EQUAL TO THE NUMBER OF INEQUIVALENT TRIADS
C REMAINING. IF IP=0 THEN THE RECOUPING HAS BEEN COMPLETED AND EXIT
C IS MADE TO GENSUM TO CARRY OUT THE SUMMATIONS
C
117 I1=1
16 DO 1 I2=1,IP
IF(J2(I2,1)-J3(I1,1)) 2,3,2
2 IF(J2(I2,2)-J3(I1,1))1,4,1
1 CONTINUE
C
C NO EQUIVALENT TRIADS WITH THIS VALUE OF I1. INCREASE I1 AND TRY
C AGAIN
C
GO TO 5
3 IF(J2(I2,2)-J3(I1,2))5,6,5
4 IF(J2(I2,1)-J3(I1,2))5,6,5
6 IF(I2-IP)7,8,8
C
C REARRANGE SO THAT EQUIVALENT TRIADS OCCUR AT THE END OF J2 AND
C J3 ARRAYS
C
7 I3=J2(I2,1)
I4=J2(I2,2)
I5=J2(I2,3)
I6=I2+1
DO 9 I7=I6,IP
DO 10 I8=1,3
J2(I7-1,I8)=J2(I7,I8)
10 CONTINUE
9 CONTINUE
J2(IP,1)=I3
J2(IP,2)=I4
J2(IP,3)=I5
8 IF(I1-IP)11,14,14
11 I3=J3(I1,1)
I4=J3(I1,2)
I5=J3(I1,3)
I6=I1+1
DO 12 I7=I6,IP
DO 13 I8=1,3
J3(I7-1,I8)=J3(I7,I8)
13 CONTINUE
12 CONTINUE
J3(IP,1)=I3
J3(IP,2)=I4
J3(IP,3)=I5
C
C IS THE THIRD ELEMENT IN J2 SUMMED OVER. IF SO REPLACE BY THIRD
C ELEMENT IN J3 ARRAY
C
14 IF(J2(IP,3)-M)47,47,44
44 J=J3(IP,3)
JP=J2(IP,3)
J2(IP,3)=J
IF(IP-2)101,18,18
C
C NOW REPLACE ALL OTHER ELEMENTS IN J2,KW,K7,K8 AND K6 WHICH ARE
C SUMMED OVER AT THE SAME TIME BY THE SAME QUANTITY J
C
18 IQ=IP-1
DO 19 I3=1,IQ
DO 20 I4=1,3
IF(J2(I3,I4)-JP) 20,21,20
21 J2(I3,I4)=J
20 CONTINUE
19 CONTINUE
101 IF(JWC)38,38,39
39 DO 23 I=1,6
DO 22 I3=1,JWC
IF(KW(I,I3)-JP) 22,25,22
25 KW(I,I3)=J
22 CONTINUE
23 CONTINUE
38 IF(J7C)87,87,41
41 DO 34 I3=1,J7C
IF(K7(I3)-JP)34,35,34
35 K7(I3)=J
34 CONTINUE
87 IF(J8C)40,40,86
86 DO 88 I3=1,J8C
IF(K8(I3)-JP)88,89,88
89 K8(I3)=J
88 CONTINUE
40 IF(J6C)42,42,43
43 DO 36 I3=1,J6C
IF(K6(I3)-JP)36,37,36
37 K6(I3)=J
36 CONTINUE
C
C SET I1 BACK TO 1 IN ORDER TO START SEARCH FOR EQUIVALENT TRIADS
C AGAIN SINCE SOME ELEMENTS MAY HAVE BEEN ALTERED
C
42 I1=1
C
C TEST WHETHER TRIANGLE MATCHES
C
47 JJ2=J2(IP,3)
JJ3=J3(IP,3)
IF(JJ2-JJ3) 148,49,148
148 IF(J1(JJ2)-J1(JJ3)) 48,44,48
C
C RECOUPLING COEFFICIENT SET ZE▶EOF◀