|
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: 84480 (0x14a00)
Types: TextFile
Names: »per9«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »per9«
c program 9
c
c aahda new version of njsym. a general program to calculate
c atomic continuum processes using the r-matrix method.
c berrington, k.a., burke, p.g., chang, j.j., chivers, a.t.,
c robb, w.d., taylor, k.t.
c ref. in comp. phys. commun. 8 (1974) 149
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
c
c------------------------------------------------------------------------
c t e s t n j s y m
c------------------------------------------------------------------------
c
program 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=7
zone readf(250,1,stderror)
zone writef(250,1,stderror)
call zassign(readf,1)
call zassign(writef,7)
call open(readf,4,'readfile',0)
call open(writef,'writefile',0)
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
c
c----------------------------------------------------------------------
c n j s y m
c----------------------------------------------------------------------
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 ZERO WHEN TRIAD IN INITIAL AND FINAL
C STATES DO NOT MATCH. IN THIS CASE, GENSUM IS NOT CALLED AND THE
C ARRAYS K6,K7,K8,KW ARE NOT SET UP, READY FOR FURTHER DIRECT
C ENTRIES TO GENSUM.
C
48 IF(IBUG3-1) 150,151,150
151 WRITE(IWRITE,50)
150 RECUP=ZERO
RETURN
C
C IF J2 ANGULAR MOMENTA ARE IN OPPOSITE ORDER TO J3 ANGULAR
C MOMENTA INTERCHANGE THEM AND STORE SIGN CHANGES IN K7 AND K8.
C CHECK DIMENSIONS
C
49 IF(J2(IP,1)-J3(IP,1))100,99,100
100 J=J2(IP,1)
J2(IP,1)=J2(IP,2)
J2(IP,2)=J
K7(J7C+1)=J2(IP,1)
K7(J7C+2)=J2(IP,2)
J7C=J7C+2
K8(J8C+1)=J2(IP,3)
J8C=J8C+1
IF(KFL5-J7C) 210,220,220
220 IF(KFL4-J8C) 212,99,99
C
C DECREASE IP AND RETURN TO LOOK FOR FURTHER EQUIVALENT TRIADS
C
99 IP=IP-1
GO TO 15
5 I1=I1+1
15 IF(I1-IP)16,16,17
C
C IF IP = 0 THIS MEANS THAT ALL TRIADS HAVE BEEN TRANSFORMED TO BE
C EQUIVALENT. NOW EXIT TO SUM OVER RACAH COEFFICIENTS
C
17 IF(IP)126,126,46
C
C
C
C
C
C S E C T I O N 2
C
C ITEST = 0 DETERMINES THE MIMIMUM RECOUPLING OF J2 ARRAY TO
C OBTAIN AN EQUIVALENT TRIAD TO ONE IN J3 ARRAY. STORE ROW OF J3
C ARRAY IN ITEST1.
C ITEST = 1 DETERMINE RECOUPLING OF J2 ARRAY TO OBTAIN AN
C EQUIVALENT TRIAD OF ITEST1 ROW OF J3 ARRAY.
C IN BOTH CASES STORE INFORMATION ON RECOUPLING
C
46 I10=9999
ITEST=0
I1=1
C
C GENJ45 DETERMINES THE LEVEL OF EACH J IN THE COUPLING TREE OF J2
C AND J3 AND STORES THE RESULT IN THE J4 AND J5 ARRAYS RESPECTIVELY
C
96 CALL GENJ45(IP)
C
C LOOK FOR J IN J2 ARRAY WHICH IS SAME AS FIRST ELEMENT IN J3 ARRAY
C
95 DO 52 I2=1,IP
IF(J2(I2,1)-J3(I1,1))53,54,53
53 IF(J2(I2,2)-J3(I1,1))52,55,52
52 CONTINUE
GO TO 51
C
C I3 AND I5 DENOTES POSITION IN J2 ARRAY OF COMMON J
C
54 I3=1
GO TO 60
55 I3=2
60 I5=I2
C
C NOW LOOK FOR J IN J2 ARRAY WHICH IS SAME AS OTHER ELEMENT IN J3
C ARRAY
C
DO 56 I2=1,IP
IF(J2(I2,1)-J3(I1,2))57,58,57
57 IF(J2(I2,2)-J3(I1,2))56,59,56
56 CONTINUE
GO TO 51
C
C I4 AND I6 DENOTES POSITION IN J2 ARRAY OF COMMON J
C
58 I4=1
GO TO 61
59 I4=2
61 I6=I2
C
C I7 AND I8 DENOTE THE POSITION IN THE J1 ARRAY OF THE TWO COMMON J
C VALUES IN J2 AND J3
C
I7=J2(I5,I3)
I8=J2(I6,I4)
C
C GENI9 DETERMINES THE NUMBER OF RECOUPLINGS OF TWO ELEMENTS OF J2
C NECESSARY TO OBTAIN IDENTICAL TRIADS IN J2 AND J3 ARRAYS. THIS
C NUMBER PLUS TWO IS STORED IN I9
C
CALL GENI9(IP)
IF(I9-I10)62,51,51
C
C A SMALLER RECOUPLING PAIR FOUND. STORE LOWEST AS J2(I13,I14) AND
C HIGHEST AS J2(I11,I12). I15 AND I16 CONTAIN LEVEL OF THESE BELOW
C COMMON TRIADS. FINALLY ITEST1 DENOTES TRIAD IN J3 FOR NEXT ENTRY
C TO SECTION 2 AND IS REQUIRED IF MORE THAN ONE RECOUPLING
C
62 I10=I9
I11 = I17
I12 = I19
I13 = I18
I14 = I20
I15=I7
I16=I8
ITEST1=I1
51 IF(ITEST) 98,97,98
C
C I1 IS ONLY INCREASED IF SEARCHING FOR SMALLEST RECOUPLING PAIR
C
97 I1=I1+1
IF(I1-IP)95,95,98
98 IF(I10-9999)63,64,64
C
C FAIL BECAUSE NO PAIR IN J2 AND J3 FOUND WHICH COULD BE RECOUPLED
C
64 WRITE(IWRITE,65)
CALL EXIT
C
C
C
C
C
C S E C T I O N 3
C
C THE PAIR OF J VALUES THAT REQUIRE THE SMALLEST NUMBER OF
C RECOUPLINGS OF J2 TO BRING INTO THE SAME ORDER AS J3 HAS NOW
C BEEN FOUND. THIS SECTION NOW CARRIES OUT ONE RECOUPLING
C
63 IF(I15-I16) 67,68,68
C
C I1 AND I2 DENOTES THE LEVEL ABOVE THE GIVEN LEVELS OF THE TRIAD
C OF ELEMENTS TO BE RECOUPLED
C
67 I1=I15-1
I2=I16-2
GO TO 69
68 I1=I16-1
I2=I15-2
69 I3 = I11
I4 = I13
I5 = I12
I6 = I14
IF(I1)70,70,71
C
C FIND FIRST ELEMENT TO BE RECOUPLED
C
71 DO 72 I=1,I1
DO 73 I7=1,IP
IF(J2(I7,1)-J2(I3,3))74,75,74
74 IF(J2(I7,2)-J2(I3,3)) 73,76,73
73 CONTINUE
75 I5=1
GO TO 77
76 I5=2
77 I3=I7
72 CONTINUE
C
C FIRST ELEMENT TO BE RECOUPLED IS J2(I3,I5)
C NOW FIND SECOND ELEMENT TO BE RECOUPLED
C
70 IF(I2)78,78,79
79 DO 80 I=1,I2
DO 81 I7=1,IP
IF(J2(I7,1)-J2(I4,3))82,83,82
82 IF(J2(I7,2)-J2(I4,3))81,84,81
81 CONTINUE
83 I6=1
GO TO 85
84 I6=2
85 I4=I7
80 CONTINUE
C
C SECOND ELEMENT TO BE RECOUPLED IS J2(I4,I6)
C
78 IF(I6-1)90,90,91
C
C INTERCHANGE ELEMENTS OF I4 ROW OF J2 IF NECESSARY AND INCLUDE
C SIGNS IN K7 AND K8 ARRAYS
C
90 K7(J7C+1)=J2(I4,1)
K7(J7C+2)=J2(I4,2)
J7C=J7C+2
K8(J8C+1)=J2(I4,3)
J8C=J8C+1
I=J2(I4,1)
J2(I4,1)=J2(I4,2)
J2(I4,2)=I
91 IF(I5-1) 92,92,93
C
C INTERCHANGE ELEMENTS OF I3 ROW OF J2 IF NECESSARY AND STORE SIGNS
C IN K7 AND K8 ARRAYS
C
92 K7(J7C+1)=J2(I3,1)
K7(J7C+2)=J2(I3,2)
J7C=J7C+2
K8(J8C+1)=J2(I3,3)
J8C=J8C+1
I=J2(I3,1)
J2(I3,1)=J2(I3,2)
J2(I3,2)=I
C
C NOW RECOUPLE THE TWO ELEMENTS OF J2 AND STORE SQUARE ROOTS IN K6
C AND RACAH COEFFICIENT IN KW ARRAYS. MP DENOTES A J WHICH WILL BE
C SUMMED OVER
C
93 K6(J6C+1)=J2(I4,3)
MP=MP+1
K6(J6C+2)=MP
J6C=J6C+2
JWC=JWC+1
KW(1,JWC)=J2(I4,1)
KW(2,JWC)=J2(I4,2)
KW(3,JWC)=J2(I3,3)
KW(4,JWC)=J2(I3,2)
KW(5,JWC)=J2(I3,1)
KW(6,JWC)=MP
J2(I3,1)=J2(I4,1)
J2(I4,1)=J2(I4,2)
J2(I4,2)=J2(I3,2)
J2(I4,3)=MP
J2(I3,2)=MP
C
C TEST DIMENSIONS AND EXIT IF FAILURE
C
IF(KFL5-J7C)210,211,211
210 WRITE(IWRITE,209)
CALL EXIT
211 IF(KFL4-J8C) 212,213,213
212 WRITE(IWRITE,208)
CALL EXIT
213 IF(KFL7-MP)212,215,215
215 IF(KFL4-J6C) 212,217,217
217 IF(KFL3-JWC) 218,219,219
218 WRITE(IWRITE,207)
CALL EXIT
219 IF(I1+I2) 117,117,94
C
C MORE THAN ONE RECOUPLING REQUIRED. RETURN TO SECTION 2 TO DECIDE
C WHICH ELEMENTS OF J2 TO RECOUPLE IN NEXT STEP. IF ALL RECOUPLINGS
C OF A PARTICULAR PAIR HAVE BEEN CARRIED OUT THEN IDENTICAL PAIRS
C ARE NOW PRESENT IN J2 AND J3 ARRAYS. RETURN TO SECTION 1 TO SEE
C IF ANY MORE RECOUPLING REQUIRED
C
94 ITEST=1
I1=ITEST1
I10=9999
GO TO 96
C
C DEBUG PRINTS
C
126 IF(IBUG3-1) 105,104,105
104 WRITE(IWRITE,107) (J1(I),I=1,M)
WRITE(IWRITE,111)
IF(JWC) 127,127,128
128 DO 116 J=1,JWC
WRITE(IWRITE,112) (KW(I,J),I=1,6)
116 CONTINUE
GO TO 224
127 WRITE(IWRITE,221)
224 IF(J6C) 222,222,223
223 WRITE(IWRITE,113) (K6(J),J=1,J6C)
GO TO 225
222 WRITE(IWRITE,226)
225 IF(J7C) 227,227,228
228 WRITE(IWRITE,114) (K7(J),J=1,J7C)
GO TO 229
227 WRITE(IWRITE,230)
229 IF(J8C) 231,231,232
232 WRITE(IWRITE,115) (K8(J),J=1,J8C)
GO TO 105
231 WRITE(IWRITE,233)
C
C CARRY OUT SUMMATIONS
C
105 CALL GENSUM(J6C,J7C,J8C,JWC,K6,K7,K8,KW,RECUP)
RETURN
END
SUBROUTINE GENJ45(IP)
C
C FIND THE LEVEL OF EACH J IN THE COUPLING TREES OF J2 AND J3 AND
C STORE IN THE J4 AND J5 ARRAYS RESPECTIVELY. IF AN ELEMENT OF J1
C DOES NOT OCCUR IN J2 THE J4 ENTRY IS -1 AND IF AN ELEMENT DOES
C NOT OCCUR IN J3 THE J5 ENTRY IS -1
C
COMMON/COUPLE/M,N,J1(40),J2(12,3),J3(12,3)
COMMON/DEPTHS/J4(40),J5(40)
C
C
C
DO 1 I=1,M
DO 2 I2=1,IP
C
C STORE LEVEL OF EACH J IN J2 ARRAY IN J4
C
IF (J2(I2,1)-I) 3,4,3
3 IF (J2(I2,2)-I) 2,4,2
2 CONTINUE
DO 17 I2 = 1,IP
IF (J2(I2,3)-I) 17,18,17
17 CONTINUE
J4(I) = -1
GO TO 5
18 J4(I) = 0
GO TO 5
4 I3 = 1
9 DO 6 I4 = 1,IP
IF (J2(I4,1)-J2(I2,3)) 7,8,7
7 IF (J2(I4,2)-J2(I2,3)) 6,8,6
6 CONTINUE
J4(I) = I3
GO TO 5
8 I3 = I3+1
I2 = I4
GO TO 9
C
C STORE LEVEL OF EACH J IN J3 ARRAY IN J5
C
5 DO 10 I2 = 1,IP
IF (J3(I2,1)-I) 11,12,11
11 IF (J3(I2,2)-I) 10,12,10
10 CONTINUE
DO 19 I2 = 1,IP
IF (J3(I2,3)-I) 19,20,19
19 CONTINUE
J5(I) = -1
GO TO 1
20 J5(I) = 0
GO TO 1
12 I3 = 1
16 DO 13 I4 = 1,IP
IF (J3(I4,1)-J3(I2,3)) 14,15,14
14 IF (J3(I4,2)-J3(I2,3)) 13,15,13
13 CONTINUE
J5(I) = I3
GO TO 1
15 I3 = I3+1
I2 = I4
GO TO 16
1 CONTINUE
RETURN
END
SUBROUTINE GENI9(IP)
C
C DETERMINES THE NUMBER OF RECOUPLING NECESSARY TO BRING J2(I5,I3)
C AND J2(I6,I4) INTO THE SAME TRIAD. THIS WILL GIVE A TRIAD
C IDENTICAL WITH ONE IN J3. ON EXIT I9 CONTAINS THE NUMBER OF
C RECOUPLINGS PLUS TWO,I7 CONTAINS THE LEVEL OF THE I5 TRIAD BELOW
C THE COMMON TRIAD AND I8 CONTAINS THE LEVEL OF THE I6 TRIAD BELOW
C THE COMMON TRIADS
C SEE DESCRIPTION OF COMMON BLOCK WCOMI9 FOR FURTHER DETAILS
C
COMMON/COUPLE/M,N,J1(40),J2(12,3),J3(12,3)
COMMON/DEPTHS/J4(40),J5(40)
COMMON/WCOMI9/I3,I4,I5,I6,I7,I8,I9,I17,I18,I19,I20
C
C
C
I1 = J4(I7)
I2 = J4(I8)
C
C DETERMINES WHICH J OF J2(I5,I3) AND J2(I6,I4) LIES LOWEST, STORE
C LOWEST AS J2(I18,I20) AND HIGHEST AS J2(I17,I19)
C
IF (I1-I2) 1,1,3
1 I17 = I5
I18 = I6
I19 = I3
I20 = I4
I3 = I2-I1
I7 = 0
I8 = I3
I4 = I1
IF (I3) 8,8,2
C
C I6 DENOTES THE LOWEST TRIAD,SCAN TRIADS TO FIND NEW TRIAD I6 AT
C SAME LEVEL AS I5
C
2 DO 4 I = 1,I3
DO 5 J = 1,IP
IF (J2(J,1)-J2(I6,3)) 7,6,7
7 IF (J2(J,2)-J2(I6,3)) 5,6,5
5 CONTINUE
J=IP
6 I6 = J
4 CONTINUE
GO TO 8
3 I17 = I6
I18 = I5
I19 = I4
I20 = I3
I3 = I1-I2
I7 = I3
I8 = 0
C
C I5 DENOTES THE LOWEST TRIADS. SCAN TRIADS TO FIND NEW TRIAD I6 AT
C SAME LEVEL I5
C
DO 9 I = 1,I3
DO 12 J = 1,IP
IF (J2(J,1)-J2(I5,3)) 10,11,10
10 IF (J2(J,2)-J2(I5,3)) 12,11,12
12 CONTINUE
J=IP
11 I5 = J
9 CONTINUE
I4 = I2
C
C I5 AND I6 NOW DENOTES TRIADS AT SAME LEVEL. I4 CONTAINS THE
C COMMON LEVEL
C
8 DO 13 I = 1,I4
I1 = I
IF (I5-I6) 14,21,14
C
C I5 AND I6 DENOTE DIFFERENT TRIADS SCAN TO FIND TRIADS AT NEXT
C LEVEL WHICH REPLACE I5 AND I6
C
14 DO 15 J = 1,IP
IF (J2(J,1)-J2(I5,3)) 16,17,16
16 IF (J2(J,2)-J2(I5,3)) 15,17,15
15 CONTINUE
J=IP
17 I5 = J
DO 18 J = 1,IP
IF (J2(J,1)-J2(I6,3)) 19,20,19
19 IF (J2(J,2)-J2(I6,3)) 18,20,18
18 CONTINUE
J=IP
20 I6 = J
13 CONTINUE
C
C I5 AND I6 NOW BOTH DENOTE THE COMMON TRIAD
C
21 I9 = I3+2*I1
I8 = I8+I1
I7 = I7+I1
RETURN
END
SUBROUTINE GENSUM(J6C,J7C,J8C,JWC,J6,J7,J8,JW,RECUP)
C
C CARRIES OUT THE SUMMATION OVER COEFFICIENTS DEFINED BY THE ARRAYS
C J6,J7,J8 AND JW TO GIVE RECUP
C THE ENTRY IS EITHER MADE FROM NJSYM OR DIRECTLY ASSUMING THAT THE
C ARRAYS J6,J7,J8 AND JW HAVE ALREADY BEEN DETERMINED BY A PREVIOUS
C ENTRY TO NJSYM AND THAT THE SUMMATION IS REQUIRED FOR ANOTHER SET
C OF J VALUES DEFINED BY THE ARRAY J1
C THE DEFINITION OF THE ARGUMENT LIST IS GIVEN AT BEGINNING OF
C NJSYM
C
DIMENSION IST(6),JWORD(6,20),J6P(40),J7P(80),J8P(40),JSUM1(12),
1JSUM2(12),JSUM4(12,20),JSUM5(12,20),JSUM3(12),JSUM6(12)
2,JSUM7(12),JSUM8(12),JSUM(2,20),JWTEST(20),WSTOR(20),IPAIR(2,2)
DIMENSION J6(40),J7(80),J8(40),JW(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
DATA ZERO,ONE /0.0E0,1.0E0/
C
C FORMAT STATEMENTS USED IN GENSUM
C
35 FORMAT (21H FAIL IN GENSUM AT 35)
36 FORMAT (21H FAIL IN GENSUM AT 36)
42 FORMAT (21H FAIL IN GENSUM AT 42)
63 FORMAT (21H FAIL IN GENSUM AT 63)
169 FORMAT(22H 169... RECUP =,F12.8,7H STOR =,F12.8,8H STOR1 =,
1F12.8)
170 FORMAT(18H 170... IST ,6I4)
190 FORMAT(8H WSTOR =,10F10.6)
308 FORMAT(23H KFL6 DIMENSION FAILURE)
311 FORMAT(22H FAIL IN GENSUM AT 310)
C
C
C
C
C
C S E C T I O N 1
C
C EVALUATES ALL TERMS IN J6,J7,J8 AND JW WHICH DO NOT INVOLVE A
C SUMMATION AND FORM MODIFIED ARRAYS J6P,J7P,J8P AND JWORD WHICH DO
C THE RESULT OF THE EVALUATION IS STORED IN RECUP AND AISTOR
C
RECUP=ONE
MAXJWE=M
JWRD = 0
IF(JWC)302,302,185
C
C MULTIPLY RECUP BY ALL RACAH COEFFICIENTS WHICH DO NOT INVOLVE A
C SUMMATION
C
185 DO 1 I=1,JWC
DO 2 J=1,6
IF(JW(J,I)-M) 2,2,3
2 CONTINUE
DO 4 J=1,6
I1=JW(J,I)
IST(J) = J1(I1) - 1
4 CONTINUE
CALL DRACAH(IST(1),IST(2),IST(3),IST(4),IST(5),IST(6),X1)
RECUP = RECUP*X1
GO TO 1
C
C JWRD IS THE NUMBER OF RACAH COEFFICIENTS WHICH INVOLVE A
C SUMMATION
C JWORD(I,J),I=1,6,J=1,JWRD CONTAINS THE NUMBER WHICH GIVE THE
C LOCATION OF THE J VALUES FOR THE RACAH COEFFICIENTS EITHER IN THE
C J1 LIST OR IN THE JSUM1 LIST
C
3 JWRD = JWRD+1
DO 5 J=1,6
JWORD(J,JWRD)=JW(J,I)
C
C MAXJWE CONTAINS THE MAXIMUM J IN THE LIST OF VARIABLES TO BE
C SUMMED OVER
C
IF(MAXJWE-JW(J,I)) 215,5,5
215 MAXJWE=JW(J,I)
5 CONTINUE
1 CONTINUE
302 J6CP=0
IF(J6C)300,300,301
C
C J6P(I),I=1,J6CP CONTAINS ALL J6 WHICH INVOLVE A SUMMATION
C MULTIPLY RECUP BY ALL THOSE WHICH DO NOT
C
301 DO 6 I=1,J6C
IF(J6(I)-M) 7,7,21
7 I1=J6(I)
RECUP = RECUP*SQRT(FLOAT(J1(I1)))
GO TO 6
21 J6CP = J6CP+1
J6P(J6CP)=J6(I)
6 CONTINUE
300 IASTOR = 0
J7CP = 0
IF(J7C) 303,303,304
C
C J7P(I),I=1,J7CP CONTAINS ALL J7 WHICH INVOLVE A SUMMATION.
C MULTIPLY RECUP BY ALL THOSE WHICH DO NOT
C
304 DO 8 I=1,J7C
IF(J7(I)-M) 9,9,22
9 I1=J7(I)
IASTOR = IASTOR + J1(I1) -1
GO TO 8
22 J7CP = J7CP+1
J7P(J7CP)=J7(I)
8 CONTINUE
303 J8CP=0
IF(J8C) 305,305,306
C
C J8CP(I),I=1,J8CP CONTAINS ALL J8 WHICH INVOLVE A SUMMATION
C MULTIPLY RECUP BY ALL THOSE WHICH DO NOT
C
306 DO 10 I=1,J8C
IF(J8(I)-M) 11,11,23
11 I1=J8(I)
IASTOR = IASTOR - J1(I1) + 1
GO TO 10
23 J8CP=J8CP+1
J8P(J8CP)=J8(I)
10 CONTINUE
C
C NO RACAH COEFFICIENTS REMAINING AND THUS NO SUMMATIONS TO BE
C CARRIED OUT IF JWRD=0. JUMP TO END TO INCLUDE (-1) FACTORS IN
C RECUP AND THEN EXIT
C
305 IF(JWRD) 12,12,13
C
C
C
C
C
C S E C T I O N 2
C
C SEARCH THROUGH THE JWORD LIST TO FIND ALL THE SUMMATION VARIABLES
C NSUM IS THE NUMBER OF SUMMATION VARIABLES
C JSUM1(I),I=1,NSUM CONTAINS A LIST OF ALL SUMMATION VARIABLES IN
C THE SAME NOTATION AS IN JW LIST
C
13 NSUM=0
MAXSUM=MAXJWE-M
DO 24 I=1,MAXSUM
JSUM6(I)=0
JSUM7(I)=0
24 CONTINUE
C
C FIND SUMMATION VARIABLES
C
DO 14 I=1,JWRD
DO 15 J=1,6
IF(JWORD(J,I)-M) 15,15,16
16 NSUM=NSUM+1
IF(NSUM-1) 17,17,18
C
C HAS THE SUMMATION VARIABLE OCCURED BEFORE. IF NOT INCLUDE IN
C JSUM1 LIST
C
18 NSUM1 = NSUM-1
DO 19 I1=1,NSUM1
IF(JWORD(J,I)-JSUM1(I1)) 19,20,19
19 CONTINUE
17 JSUM1(NSUM)=JWORD(J,I)
I1=NSUM
GO TO 25
20 NSUM =NSUM1
C
C JSUM6(I),I=1,NSUM IS THE NUMBER OF TIMES EACH SUMMATION VARIABLE
C OCCURS IN JWORD
C
25 JSUM6(I1)=JSUM6(I1)+1
I2=JSUM6(I1)
C
C JSUM4(I,J),JSUM5(I,J),I=1,NSUM,J=1,JSUM6(I) IS THE POSITION IN
C THE JWORD LIST WHERE THE JSUM1 ELEMENT OCCURS
C
JSUM4(I1,I2)=J
JSUM5(I1,I2)=I
C
C (JWORD-M) GIVES LOCATION IN JSUM1 LIST IF A SUMMATION VARIABLE
C
JWORD(J,I)=M+I1
15 CONTINUE
14 CONTINUE
IF(KFL6-NSUM) 312,307,307
312 WRITE(IWRITE,308)
CALL EXIT
307 IF(J6CP) 26,26,27
C
C CHECK THAT NO EXTRA SUMMATION VARIABLES OCCUR IN J6P. SET J6P
C EQUAL TO THE LOCATION IN JSUM1 LIST OF SUMMATION VARIABLE
C
27 DO 28 I=1,J6CP
DO 29 J=1,NSUM
IF(J6P(I)-JSUM1(J)) 29,30,29
29 CONTINUE
WRITE(IWRITE,35)
CALL EXIT
30 J6P(I)=J
28 CONTINUE
26 IF(J7CP) 130,130,31
C
C CHECK THAT NO EXTRA SUMMATION VARIABLES OCCUR IN J7P, SET J7P
C EQUAL TO THE LOCATION IN JSUM1 LIST OF SUMMATION VARIABLE
C
31 DO 32 I=1,J7CP
DO 33 J=1,NSUM
IF(J7P(I)-JSUM1(J)) 33,34,33
33 CONTINUE
WRITE(IWRITE,36)
CALL EXIT
34 J7P(I)=J
32 CONTINUE
130 IF(J8CP) 37,37,38
C
C CHECK THAT NO EXTRA SUMMATION VARIABLES OCCUR IN J8P. SET J8P
C EQUAL TO THE LOCATION IN JSUM1 LIST OF SUMMATION VARIABLE
C
38 DO 39 I=1,J8CP
DO 40 J=1,NSUM
IF(J8P(I)-JSUM1(J)) 40,41,40
40 CONTINUE
WRITE(IWRITE,42)
CALL EXIT
41 J8P(I)=J
39 CONTINUE
C
C
C
C
C
C S E C T I O N 3
C
C ORDERS THE SUMMATION VARIABLES SO THAT THE RANGE OF EACH
C SUMMATION HAS BEEN PREVIOUSLY DEFINED
C
37 NCT =0
NCT1 = 0
64 DO 43 I=1,JWRD
DO 44 J=1,6
I1=JWORD(J,I)-M
IF(I1) 44,44,45
C
C JSUM7(I),I=1,NSUM IS THE ORDER OF THE SUMMATIONS OVER THE J
C VARIABLES. INITIALLY THIS ARRAY IS ZERO
C
45 IF(JSUM7(I1)) 46,46,44
46 GO TO (47,48,49,50,51,52),J
C
C THE ROWS OF THE IPAIR ARRAYS GIVE LIMITS OF SUMMATION IMPOSED
C BY THE TRIANGULAR CONDITION
C
47 IPAIR(1,1) = JWORD(2,I)
IPAIR(1,2) = JWORD(5,I)
IPAIR(2,1) = JWORD(3,I)
IPAIR(2,2) = JWORD(6,I)
GO TO 53
48 IPAIR(1,1) = JWORD(1,I)
IPAIR(1,2) = JWORD(5,I)
IPAIR(2,1) = JWORD(4,I)
IPAIR(2,2) = JWORD(6,I)
GO TO 53
49 IPAIR(1,1) = JWORD(1,I)
IPAIR(1,2) = JWORD(6,I)
IPAIR(2,1) = JWORD(4,I)
IPAIR(2,2) = JWORD(5,I)
GO TO 53
50 IPAIR(1,1) = JWORD(2,I)
IPAIR(1,2) = JWORD(6,I)
IPAIR(2,1) = JWORD(3,I)
IPAIR(2,2) = JWORD(5,I)
GO TO 53
51 IPAIR(1,1)= JWORD(1,I)
IPAIR(1,2) = JWORD(2,I)
IPAIR(2,1) = JWORD(3,I)
IPAIR(2,2) = JWORD(4,I)
GO TO 53
52 IPAIR(1,1) = JWORD(1,I)
IPAIR(1,2) = JWORD(3,I)
IPAIR(2,1) = JWORD(2,I)
IPAIR(2,2) = JWORD(4,I)
C
C TEST WHETHER RANGE OF SUMMATION HAS BEEN DEFINED. WE CHOOSE THE
C FIRST PAIR OF J VALUES THAT DEFINE THE RANGE AND STORE IN JSUM
C
53 DO 54 I2=1,2
DO 55 I3=1,2
IF(IPAIR(I2,I3)-M) 55,55,56
56 I4 = IPAIR(I2,I3)-M
C
C JSUM7 GREATER THAN ZERO MEANS THAT LIMIT IS DEFINED PREVIOUSLY
C
IF(JSUM7(I4)) 54,54,55
55 CONTINUE
GO TO 57
54 CONTINUE
GO TO 44
C
C NCT IS COUNT ON ORDER OF SUMMATION
C
57 NCT = NCT+1
JSUM7(I1)=NCT
C
C JSUM(I,J),I=1,2,J=1,NSUM CONTAINS THE POSITION OF THE J VALUES
C THAT DEFINE THE RANGE OF EACH VARIABLE. THE FIRST ROW CORRESPONDS
C TO THE FIRST J AND THE SECOND ROW TO THE SECOND J DEFINING RANGE.
C IF VALUE IN RANGE 1 TO M THEN CORRESPONDS TO AN ELEMENT IN J1.
C IF VALUE GREATER THAN M THEN CORRESPONDS TO A SUMMATION VARIABLE
C IN JSUM1 LIST. NOTE THAT JSUM DOES NOT NECESSARILY CONTAIN THE
C MOST RESTRICTIVE RANGES SINCE ONLY ONE OF TWO POSSIBLE PAIRS FROM
C THE RACAH COEFFICIENT IS TAKEN
C
DO 58 I3=1,2
JSUM(I3,I1)=IPAIR(I2,I3)
58 CONTINUE
44 CONTINUE
43 CONTINUE
C
C CHECK WHETHER THE RANGE OF ALL SUMMATIONS SET. FAIL IF NOT
C POSSIBLE TO SET ALL RANGES
C
IF(NCT-NSUM) 59,60,60
59 IF(NCT-NCT1) 61,61,62
61 WRITE(IWRITE,63)
CALL EXIT
62 NCT1=NCT
GO TO 64
C
C JSUM8(I),I=1,NSUM IS THE POSITION IN THE JSUM7 LIST WHERE THE ITH
C SUMMATION IS FOUND
C
60 DO 65 J=1,NSUM
DO 66 I1=1,NSUM
IF(JSUM7(I1)-J) 66,67,66
66 CONTINUE
I1=NSUM
67 JSUM8(J)=I1
65 CONTINUE
C
C
C
C
C
C S E C T I O N 4
C
C CARRY OUT THE SUMMATIONS.
C I6 DENOTES THE FIRST J THAT REQUIRES TO BE SET TO THE LOWEST
C VALUE IN THE RANGE
C I7 = 0 THE FIRST TIME THE JS ARE SET BUT BUT IS SET EQUAL TO 1
C ON SUBSEQUENT TIMES
C
I6=1
I7=0
100 IF(I6-NSUM) 105,105,104
C
C JSUM2(I),I=1,NSUM CONTAINS CURRENT VALUE OF (2J+1) IN THE SAME
C ORDER AS JSUM1 LIST. SET JSUM2 EQUAL TO LOWEST VALUE IN EACH
C RANGE
C
105 DO 68 J=I6,NSUM
I1=JSUM8(J)
IF(JSUM(1,I1)-M) 69,69,70
C
C FIRST J DEFINING RANGE FIXED
C
69 I2=JSUM(1,I1)
I3=J1(I2)
GO TO 71
C
C FIRST J DEFINING RANGE VARIABLE
C
70 I2=JSUM(1,I1)-M
I3=JSUM2(I2)
71 IF(JSUM(2,I1)-M) 72,72,73
C
C SECOND J DEFINING RANGE FIXED
C
72 I2=JSUM(2,I1)
I4=J1(I2)
GO TO 74
C
C SECOND J DEFINING RANGE VARIABLE
C
73 I2=JSUM(2,I1)-M
I4=JSUM2(I2)
C
C SET LOWER LIMIT OF RANGE IN JSUM2
C
74 JSUM2(I1)=IABS(I3-I4)+1
68 CONTINUE
C
C JSUM3(I),I=1,NSUM IS 1 IF J HAS ALTERED FROM ITS PREVIOUS VALUE
C AND IS 0 IF IT IS STILL THE SAME
C
DO 77 I=I6,NSUM
JSUM3(I)=1
77 CONTINUE
IF(I7) 103,103,104
103 I7=1
C
C JWTEST(I),I=1,JWRD IS 1 IF REQUIRED TO EVALUATE RACAH COEFFICIENT
C AND IS 0 IF VALUE THE SAME AS BEFORE.JWTEST IS SET ZERO THE FIRST
C TIME THROUGH AND LATER SET 1 IF NECESSARY
C
DO 78 I=1,JWRD
JWTEST(I)=0
78 CONTINUE
C
C STOR1 WILL CONTAIN THE PRODUCT OF RACAH COEFFICIENTS TIMES
C (2J+1) FACTORS
C STOR WILL CONTAIN SUMS OF THE STOR1
C
STOR1=ONE
STOR=ZERO
C
C CHECK THE TRIANGULAR RELATION FOR ALL J VALUES IN JWORD LIST. IF
C A SUMMATION VARIABLE THEN VALUE TAKEN FROM JSUM2 LIST
C
104 DO 79 J=1,JWRD
DO 80 I=1,6
IF(JWORD(I,J)-M) 81,81,82
81 I1=JWORD(I,J)
IST(I) = J1(I1) - 1
GO TO 80
82 I1=JWORD(I,J)-M
IST(I) = JSUM2(I1) - 1
80 CONTINUE
IF(IST(1)+IST(2)-IST(5)) 83,84,84
84 IF(IABS(IST(1)-IST(2))-IST(5)) 85,85,83
85 IF(IST(3)+IST(4)-IST(5)) 83,86,86
86 IF(IABS(IST(3)-IST(4))-IST(5)) 87,87,83
87 IF(IST(1)+IST(3)-IST(6)) 83,88,88
90 IF(IABS(IST(2)-IST(4))-IST(6)) 79,79,83
89 IF(IST(2)+IST(4)-IST(6)) 83,90,90
88 IF(IABS(IST(1)-IST(3))-IST(6))89,89,83
79 CONTINUE
GO TO 91
C
C FAIL ONE OF THE TRIANGULAR RELATIONS. INCREASE THE J VALUES
C
83 I2=NSUM
203 I1 = JSUM8(I2)
C
C INCREASE A SUMMATION J VALUE WHICH IS IN JSUM2 AND SET JSUM3 TO
C SHOW VALUE CHANGED
C
JSUM2(I1)=JSUM2(I1)+2
JSUM3(I1)=1
C
C NOW STORE J VALUE DEFINING RANGE OF THIS J IN I3 AND I4.
C
IF(JSUM(1,I1)-M) 92,92,93
92 I20 = JSUM(1,I1)
I3 = J1(I20)
GO TO 94
93 I20 = JSUM(1,I1)-M
I3 = JSUM2(I20)
94 IF(JSUM(2,I1)-M)95,95,96
95 I20 = JSUM(2,I1)
I4 = J1(I20)
GO TO 97
96 I20 = JSUM(2,I1)-M
I4 = JSUM2(I20)
97 I5=I3+I4-1
98 I6=I2+1
C
C NOW TEST J VALUES AGAINST MAXIMUM IN RANGE. IF SATISFIED RETURN
C TO SET REMAINING J VALUES WHICH DEPEND ON THIS J TO THEIR
C LOWEST VALUES. IF NOT RETURN TO INCREASE PRECEDING J VALUE
C
IF(JSUM2(I1)-I5) 100,100,101
101 I2=I2-1
IF(I2) 102,102,203
C
C NO MORE J VALUES TO SUM OVER. THE SUMMATION IS THEREFORE COMPLETE
C MULTIPLY BY COMMON FACTOR AND EXIT
C
102 RECUP=RECUP*STOR
IF(IBUG3-1) 131,230,131
230 WRITE(IWRITE,169) RECUP,STOR,STOR1
131 RETURN
C
C SEE TRIANGULAR RELATIONS ARE SATISFIED. NOW PROCEED TO EVALUATE
C RACAH COEFFICIENTS
C FIRST DETERMINE WHICH RACAH COEFFICIENTS NEED RE-EVALUATING AND
C SET JWTEST APPROPRIATELY
C
91 DO 106 J=1,NSUM
IF(JSUM3(J)) 106,106,107
107 I2=JSUM6(J)
DO 108 I1=1,I2
I3=JSUM5(J,I1)
JWTEST(I3)=1
108 CONTINUE
106 CONTINUE
C
C NOW EVALUATE ALL JWRD RACAH COEFFICIENTS WHICH HAVE NOT ALREADY
C BEEN EVALUATED
C
DO 109 I=1,JWRD
IF(JWTEST(I)) 109,109,110
110 DO 111 I1=1,6
IF(JWORD(I1,I)-M) 112,112,113
112 I2=JWORD(I1,I)
IST(I1) = J1(I2) - 1
GO TO 111
113 I2=JWORD(I1,I)-M
IST(I1) = JSUM2(I2) - 1
111 CONTINUE
IF(IBUG3-1) 132,133,132
133 WRITE (IWRITE,170) (IST(J), J=1,6)
132 CALL DRACAH(IST(1),IST(2),IST(3),IST(4),IST(5),IST(6),X1)
WSTOR(I)=X1
109 CONTINUE
C
C WSTOR(I),I=1,JWRD CONTAINS THE EVALUATED RACAH COEFFICIENTS
C
IF(IBUG3-1) 134,135,134
135 WRITE(IWRITE,190) (WSTOR(J),J=1,JWRD)
C
C SET JSUM3 AND JWTEST TO ZERO TO INDICATE THAT RACAH COEFFICIENTS
C NEED NOT BE EVALUATED UNLESS J VALUE CHANGES
C
134 DO 114 J=1,NSUM
JSUM3(J)=0
114 CONTINUE
DO 115 J=1,JWRD
JWTEST(J)=0
115 CONTINUE
C
C FORM PRODUCT OF RACAH COEFFICIENTS,(2J+1) FACTORS AND (-1)
C FACTORS IN STOR1
C
DO 116 I=1,JWRD
STOR1 = STOR1*WSTOR(I)
116 CONTINUE
C
C IASTOR CONTAINS THE POWER OF (-1)WHICH IS COMMON TO ALL TERMS
C
IX2 = IASTOR
IF(J6CP) 117,117,118
118 DO 119 I=1,J6CP
I1=J6P(I)
STOR1 = STOR1*SQRT(FLOAT(JSUM2(I1)))
119 CONTINUE
117 IF(J7CP) 120,120,121
121 DO 122 I=1,J7CP
I1=J7P(I)
IX2 = IX2 + JSUM2(I1) - 1
122 CONTINUE
120 IF(J8CP) 123,123,124
124 DO 125 I=1,J8CP
I1=J8P(I)
IX2 = IX2 - JSUM2(I1) + 1
125 CONTINUE
123 IX2 = IX2/2
C
C ADD TERM INTO STOR AND RESET STOR1 TO 1 READY FOR NEXT TERM
C
IF (MOD(IX2,2) .EQ. 1) STOR1 = -STOR1
STOR = STOR + STOR1
STOR1=ONE
GO TO 83
C
C NO SUMMATIONS. CHECK THAT THERE ARE NO INCONSISTENCIES. THEN
C MULTIPLY BY (-1) FACTOR AND EXIT
C
12 IF(J6CP+J7CP+J8CP) 309,309,310
310 WRITE(IWRITE,311)
CALL EXIT
309 IX2 = IASTOR/2
IF (MOD(IX2,2) .EQ. 1) RECUP = -RECUP
186 RETURN
END
SUBROUTINE DRACAH (J1,J2,L2,L1,J3,L3,D6J)
C THIS SUBROUTINE WAS ORIGINALLY WRITTEN BY G.BESSIS TO COMPUTE
C 6-J SYMBOLS. THIS VERSION HAS BEEN SLIGHTLY MODIFIED TO GIVE
C RACAH COEFFICENTS WITH A CALL COMPATIBLE WITH AAGD
C ARGUMENTS ARE DOUBLE THE ACTUAL QUANTUM NUMBERS
DIMENSION KC(11),NA(31),MC(23),NC(7),NB(31)
COMMON/INFORM/IREAD,IWRITE,IPUNCH
DATA KC/2,3,5,7,11,13,17,19,23,29,31/
DATA ZERO,ONE/0.0E0,1.0E0/
D6J=ZERO
IF(IABS(L1-J2).GT.L3.OR.IABS(J2-L3).GT.L1.OR.IABS(L1-L3).GT.J2) GO
1TO 99
IF(IABS(J1-J2).GT.J3.OR.IABS(J2-J3).GT.J1.OR.IABS(J1-J3).GT.J2) GO
1TO 99
IF(IABS(L1-L2).GT.J3.OR.IABS(L2-J3).GT.L1.OR.IABS(L1-J3).GT.L2) GO
1TO 99
IF(IABS(J1-L2).GT.L3.OR.IABS(L2-L3).GT.J1.OR.IABS(J1-L3).GT.L2) GO
1TO 99
DO 5 I=1,31
5 NA(I)=0
MC(1)=J1+J2-J3
MC(2)=J1-J2+J3
MC(3)=-J1+J2+J3
MC(4)=J1+L2-L3
MC(5)=J1-L2+L3
MC(6)=-J1+L2+L3
MC(7)=L1+J2-L3
MC(8)=L1-J2+L3
MC(9)=-L1+J2+L3
MC(10)=L1+L2-J3
MC(11)=L1-L2+J3
MC(12)=-L1+L2+J3
MC(13)=J1+J2+J3+2
MC(14)=J1+L2+L3+2
MC(15)=L1+J2+L3+2
MC(16)=L1+L2+J3+2
MC(17)=J1+J2+J3
MC(18)=J1+L2+L3
MC(19)=L1+J2+L3
MC(20)=L1+L2+J3
MC(21)=J1+J2+L1+L2
MC(22)=J2+J3+L2+L3
MC(23)=J3+J1+L3+L1
DO 6 I=1,23
IF (MOD(MC(I),2).NE.0) GO TO 98
MC(I)=MC(I)/2
IF(MC(I).LT.0) GO TO 99
IF(MC(I).GT.31) GO TO 98
6 CONTINUE
DO 20 I=1,12
N=MC(I)
DO 15 J=1,N
15 NA(J)=NA(J)+1
20 CONTINUE
DO 17 I=13,16
N=MC(I)
DO 16 J=1,N
16 NA(J)=NA(J)-1
17 CONTINUE
DO 26 I=1,31
26 NB(I)=NA(I)
IZM=MIN0(MC(21),MC(22),MC(23))
IZD=MAX0(MC(17),MC(18),MC(19),MC(20))
ISIG=1
IF (MOD(IZD,2).NE.0) ISIG=-ISIG
DO 60 IZ=IZD,IZM
NC(1)=IZ-MC(17)
NC(2)=IZ-MC(18)
NC(3)=IZ-MC(19)
NC(4)=IZ-MC(20)
NC(5)=MC(21)-IZ
NC(6)=MC(22)-IZ
NC(7)=MC(23)-IZ
DO 28 I=1,31
28 NA(I)=NB(I)
N=IZ+1
DO 29 I=1,N
29 NA(I)=NA(I)+2
DO 40 I=1,7
N=NC(I)
DO 35 J=1,N
35 NA(J)=NA(J)-2
40 CONTINUE
NA(2)=NA(2)+2*NA(4)+NA(6)+3*NA(8)+NA(10)+2*NA(12)+NA(14)+4*NA(16)+
1NA(18)+2*NA(20)+NA(22)+3*NA(24)+NA(26)+2*NA(28)+NA(30)
NA(3)=NA(3)+NA(6)+2*NA(9)+NA(12)+NA(15)+2*NA(18)+NA(21)+NA(24)+3*N
1A(27)+NA(30)
NA(5)=NA(5)+NA(10)+NA(15)+NA(20)+2*NA(25)+NA(30)
NA(7)=NA(7)+NA(14)+NA(21)+NA(28)
NA(11)=NA(11)+NA(22)
NA(13)=NA(13)+NA(26)
DRA=ONE
DAX=ONE
DNR=ONE
DO 50 K=1,11
I=KC(K)
N=NA(I)
IF(N.EQ.0) GO TO 50
IF(MOD(N,2)) 41,42,41
41 N=N-1
DRA=DRA*I
42 N=N/2
IF(N) 43,50,45
43 N=-N
DO 44 IN=1,N
44 DNR=DNR*I
GO TO 50
45 DO 46 IN=1,N
46 DAX=DAX*I
50 CONTINUE
DRA = SQRT(DRA)
D6J=D6J+(DAX*DRA*ISIG)/DNR
ISIG=-ISIG
60 CONTINUE
IF( MOD( (J1+J2+L1+L2)/2,2) .EQ. 0) GO TO 99
D6J = -D6J
GO TO 99
98 WRITE (IWRITE,101) J1,J2,L1,L2,J3,L3
101 FORMAT(44H FAILURE IN CALCULATING RACAH COEFFICIENT W(,3(I3,1H,),I
13,1H$,I3,1H,,I3,1H))
CALL EXIT
99 RETURN
END
FINISH
****
IN $SPQU01,$ONE.AH.NJSMD
6 3
5 4 2 2 5 3
1 2 4 4 3 6
2 3 5 1 5 6
5 4 2 2 3 3
16 6
2 1 1 2 2 2 1 2 2 1 1 2
1 2 2 2
1 15 11 2 16 12 11 12 5 5 3 6
6 4 7
1 15 13 2 16 14 13 14 8 8 3 9
9 4 7
2 1 1 2 2 2 1 2 2 1 1 2
1 2 2 2
16 6
2 1 1 2 2 2 1 2 2 1 1 2
1 2 2 2
1 15 11 2 16 12 11 12 5 5 3 6
6 4 7
15 1 13 2 16 14 13 14 8 8 3 9
9 4 7
2 1 1 2 2 2 1 2 2 1 1 2
1 2 2 2
19 7
1 1 3 5 1 3 3 1 3 3 1 3
1 3 3 3 3 3 1
18 19 16 3 15 11 11 16 12 1 2 5
5 12 6 6 4 7
19 15 17 3 17 13 13 18 14 1 2 8
8 14 9 9 4 7
1 1 3 5 1 3 3 1 3 3 1 3
1 3 3 3 3 3 5
****
JOB NJSM,$SPQU01,JD:JT 2MINS,MZ 80000$
DY $ONE.AH
TASK FORTRAN,TI 60,*CR/ATLAS/NJSMS,*LP NJSML,=CR0 NJSMD,=LP0 NJSMR,-
NOLIST *LP,NOLIST =LP
LF NJSML,*LP
LF NJSMR,*LP
ER NJSMD,NJSML,NJSMR
EJ ALL
****
ACRZGF VALUES. OSCILLATOR STRENGTHS FROM NUMERICAL MCHF RADIAL
1 FUNCTIONS. C.F. FISCHER, K.M.S. SAXENA.
REF. IN COMP. PHYS. COMMUN. 9 (1975) 381
C
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C * *
C * JULY 1974 *
C * *
C * PROGRAM TO EVALUATE LENGTH AND VELOCITY FORM OF 'GF' VALUES *
C * USING NUMERICAL MCHF RADIAL FUNCTIONS. *
C * *
C * *
C * BY *
C * *
C * *
C * C. FROESE FISCHER AND K.M.S. SAXENA *
C * *
C * DEPARTMENT OF APPLIED MATHEMATICS *
C * UNIVERSITY OF WATERLOO, WATERLOO, ONTARIO N2L 3G1 *
C * C A N A D A. *
C * *
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C * *
C * DESCRIPTION OF THE COMMON BLOCKS:- *
C * ================================ *
C * *
C * (1) COMMON BLOCK /PARAM/. *
C * -------------------- *
C * *
C * THIS COMMON BLOCK STORES SEVERAL NUMERICAL CONSTANTS *
C * IN DOUBLE PRECISION AND VALUES OF CERTAIN PARAMETERS OF THE *
C * CALCULATIONS. *
C * *
C * THE VARIABLES IN THIS COMMON BLOCK ARE AS FOLLOWS. *
C * *
C * D0 : DOUBLE PRECISION CONSTANT 0 *
C * D1 : DOUBLE PRECISION CONSTANT 1 *
C * D2 : DOUBLE PRECISION CONSTANT 2 *
C * D3 : DOUBLE PRECISION CONSTANT 3 *
C * D4 : DOUBLE PRECISION CONSTANT 4 *
C * D5 : DOUBLE PRECISION CONSTANT 1/2 *
C * D6 : DOUBLE PRECISION CONSTANT 6 *
C * D10: DOUBLE PRECISION CONSTANT 10 *
C * H : 0.0625, THE STEP-SIZE DELTA(RHO) *
C * H1 : H/3 *
C * Z : ATOMIC NUMBER *
C * NO : MAXIMUM NUMBER OF POINTS IN THE RANGE OF THE FUNCTIONS *
C * =220 *
C * ND : NO-2 *
C * *
C * MOST OF THESE CONSTANTS ARE SET IN THE BLOCK DATA *
C * SEGMENT. *
C * *
C * *
C * (2) THE BLANK COMMON //. *
C * ------------------- *
C * *
C * THIS COMMON SECTION STORES THE INFORMATION ABOUT *
C * THE NUMERICAL MCHF WAVEFUNCTIONS. *
C * *
C * THE VARIABLES IN THIS COMMON BLOCK ARE AS FOLLOWS. *
C * *
C * R(220) : VALUES OF R(J)=EXP(RHO(J))/Z *
C * RR(220) : VALUES OF R(J)**2 *
C * R2(220) : VALUES OF DSQRT(R(J)) *
C * P(50,220) : VALUES OF P(R(J))/R2(J) FOR ORBITALS I=1,50 *
C * AZ(50) : A0=LIMIT OF ( P(R)/(R**(L+1)) ) AS R->0 FOR *
C * ORBITALS I=1,50 *
C * L(50) : L-QUANTUM NUMBERS FOR ORBITALS I=1,50 *
C * MAX(50) : NUMBER OF MESH-POINTS IN THE NUMERICAL *
C * ORBITALS I=1,50 *
C * *
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C * *
C * DESCRIPTION OF THE OTHER IMPORTANT VARIABLES:- *
C * ============================================ *
C * *
C * ASTER : AN INTEGER VARIABLE READ IN FORMAT(A1). *
C * BLANK : A BLANK CHARACTER ' ', DEFINED AS AN INTEGER *
C * AND SET BY A DATA STATEMENT IN THE MAIN PROGRAM. *
C * SYMM(5) : AN INTEGER VARIABLE STORING THE SPECTROSCOPIC *
C * SYMBOLS 'S','P','D','F', AND 'G' IN FORMAT(A1). *
C * SYMM(I) CORRESPONDS TO THE SYMMETRY WITH L=(I-1). *
C * JREAD : GENERAL INPUT CHANNEL FOR A SET OF CALCULATIONS. *
C * IREAD1 : INPUT CHANNEL FOR THE WAVEFUNCTIONS REQUIRED IN *
C * A CASE. *
C * IREAD2 : INPUT CHANNEL FOR THE TRANSITION INTEGRALS DATA *
C * REQUIRED IN A CASE. *
C * IWRITE : OUTPUT CHANNEL REQUIRED TO OUTPUT THE RESULTS OF *
C * A CASE. *
C * ATOM : ATOMIC SYMBOL/DESIGNATION IN FORMAT(A8). *
C * IZ : ATOMIC NUMBER Z. *
C * NWF : NUMBER OF ORBITALS INVOLVED. *
C * TRMI : TERM SYMBOL FOR THE INITIAL STATE IN FORMAT(A8). *
C * TRMF : TERM SYMBOL FOR THE FINAL STATE IN FORMAT(A8). *
C * NCFGI : NUMBER OF CONFIGURATIONS IN THE INITIAL STATE. *
C * NCFGF : NUMBER OF CONFIGURATIONS IN THE FINAL STATE. *
C * MULT : MULTIPLICITY (2S+1) OF THE TWO STATES. *
C * EL(50,3) : AN INTEGER VARIABLE STORING THE THREE CHARACTER *
C * ALPHANUMERIC SYMBOL OF THE ORBITALS I=1,50 IN *
C * FORMAT(3A1) FOR EACH OF THEM. *
C * ETI : TOTAL ENERGY (IN A.U.) FOR THE INITIAL STATE. *
C * ETF : TOTAL ENERGY (IN A.U.) FOR THE FINAL STATE. *
C * CONFAI(30): CHARACTERS 01-08 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE INITIAL STATE CONFIGURATIONS I=1,30. *
C * CONFBI(30): CHARACTERS 09-16 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE INITIAL STATE CONFIGURATIONS I=1,30. *
C * CONFCI(30): CHARACTERS 17-24 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE INITIAL STATE CONFIGURATIONS I=1,30. *
C * CONFAF(30): CHARACTERS 01-08 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE FINAL STATE CONFIGURATIONS I=1,30. *
C * CONFBF(30): CHARACTERS 09-16 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE FINAL STATE CONFIGURATIONS I=1,30. *
C * CONFCF(30): CHARACTERS 17-24 (IN A8 FORMAT) OF THE ALPHA- *
C * NUMERIC SYMBOL (IN TOTAL OF 24 CHARACTERS) OF *
C * THE FINAL STATE CONFIGURATIONS I=1,30. *
C * WTI(30) : WEIGHTS OF THE INITIAL STATE CONFIGURATIONS I=1,30*
C * WTF(30) : WEIGHTS OF THE FINAL STATE CONFIGURATIONS I=1,30*
C * COEF : MULTILPYING COEFFICIENT IN A TRANSITION INTEGRAL. *
C * KRHO : THE NUMBER INDICATING THE ORBITAL EL(KRHO) FROM *
C * THE INITIAL STATE CONFIGURATION APPEARING IN A *
C * TRANSITION INTEGRAL. *
C * KSIG : THE NUMBER INDICATING THE ORBITAL EL(KSIG) FROM *
C * THE FINAL STATE CONFIGURATION APPEARING IN A *
C * TRANSITION INTEGRAL. *
C * JI,JF : THE NUMBERS INDICATING THE INITIAL AND FINAL *
C * STATE CONFIGURATIONS FOR A TRANSITION INTEGRAL. *
C * II1,II2, : THE NUMBERS INDICATING THE ORBITALS EL(II1), *
C * II3 EL(II2), AND EL(II3) FROM THE INITIAL STATE *
C * CONFIGURATION JI APPEARING IN THE THREE OVERLAP *
C * INTEGRALS IN A TRANSITION INTEGRAL CONTRIBUTION. *
C * IF1,IF2, : THE NUMBERS INDICATING THE ORBITALS EL(IF1), *
C * IF3 EL(IF2), AND EL(IF3) FROM THE FINAL STATE *
C * CONFIGURATION JF APPEARING IN THE THREE OVERLAP *
C * INTEGRALS IN A TRANSITION INTEGRAL CONTRIBUTION. *
C * IP1,IP2, : THE NUMBERS INDICATING THE POWERS OF THE THREE *
C * IP3 OVERLAP INTEGRALS IN A TRANSITION INTEGRAL *
C * CONTRIBUTION. *
C * *
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C * *
C * NON STANDARD FORTRAN:- *
C * ==================== *
C * *
C * THIS PROGRAM IS WRITTEN AS A SYSTEM 360 DOUBLE PRE- *
C * CISION PROGRAM. HOWEVER, ON COMPUTERS WITH A WORD LENGTH OF *
C * 48 BITS OR MORE IT SHOULD BE USED IN SINGLE PRECISION ONLY. *
C * IN ORDER TO CONVERT THIS PROGRAM TO A SINGLE PRECISION PROGRAM *
C * THE FOLLOWING SHOULD BE DONE: *
C * *
C * (1) REMOVE ALL 'IMPLICIT REAL*8(A-H,O-Z)' CARDS. *
C * (2) REMOVE '*8' FROM THE FUNCTION DEFINITION CARDS, FOR *
C * EXAMPLE, 'REAL FUNCTION GRAD*8(I,J)' WILL BE REPLACED *
C * BY 'REAL FUNCTION GRAD(I,J)' *
C * (3) CHANGE SYSTEM FUNCTION NAMES 'DSQRT','DABS', ETC. TO *
C * 'SQRT','ABS', ETC. *
C * (4) CHANGE DOUBLE PRECISION CONSTANTS TO SINGLE PRECISION *
C * CONTANTS. *
C * (5) CHANGE D-FORMAT CODES TO E-FORMAT CODES. *
C * *
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C ------------------------------------------------------------------
C *** M A I N
C ------------------------------------------------------------------
C
IMPLICIT REAL*8(A-H,O-Z)
INTEGER ASTER,BLANK,SYMM(5),EL(50,3)
COMMON /PARAM/D0,D1,D2,D3,D4,D5,D6,D10,H,H1,Z,NO,ND
CCOMMON R(220),RR(220),R2(220),P(50,220),AZ(50),L(50),MAX(50)
DIMENSION CONFAI(30),CONFBI(30),CONFCI(30),WTI(30),
1 CONFAF(30),CONFBF(30),CONFCF(30),WTF(30)
DATA BLANK/1H /
DATA SYMM(1),SYMM(2),SYMM(3),SYMM(4),SYMM(5)/1HS,1HP,1HD,1HF,1HG/
C
C *** THE INPUT FORMATS. IT IS TO BE NOTED HERE THAT THE '102 FORMAT'
C *** USED TO INPUT THE NUMERICAL MCHF RADIAL FUNCTION DATA IS NOT THE
C *** SAME AS ACTUALLY USED IN THE MCHF PROGRAM TO PUNCH THESE RADIAL
C *** FUNCTIONS. THIS HAS BEEN DONE IN ORDER TO KEEP THE DATA-FIELD
C *** LIMITED TO COLUMNS 1-72 AND USE COLUMNS 73-80 OF THE CARDS FOR
C *** IDENTIFICATION AND SEQUENCE NUMBERS ONLY. HOWEVER, ONE CAN USE
C *** THE MCHF RADIAL FUNCTION DATA AS IT IS PUNCHED OUT IN THE MCHF
C *** PROGRAM BY CHANGING THE '102 FORMAT' TO:
C102 FORMAT(32X,3A1,I6,22X,D16.8/(7F11.7))
C
101 FORMAT(A1,3I4,A8,2I4,2A8,4I4)
102 FORMAT( 3A1,I6,22X,D16.8/(6F11.7))
103 FORMAT(F16.8)
104 FORMAT(3A8,F12.8)
105 FORMAT(A1,F12.8,3HRI(,2I2,1H,,2I2,1H),9I4)
C
C *** THE OUTPUT FORMATS.
C
200 FORMAT(5H1SET ,I3/5H CASE,I3/8H *******//)
201 FORMAT(23X37HOSCILLATOR STRENGTHS CALCULATION FOR , A8,4H (Z=,I3,2
1H) ,A8,2H->,A8,12H TRANSITION )
202 FORMAT(1H ,22X,83(1H*)/)
203 FORMAT(/9H JREAD =,I3,38H (GENERAL DATA INPUT UNIT FOR THE SET) /
19H IREAD1 =,I3,45H (WAVEFUNCTION DATA INPUT UNIT FOR THIS CASE) /
29H IREAD2 =,I3,53H (TRANSITION INTEGRALS DATA INPUT UNIT FOR THIS
2CASE) /
39H IWRITE =,I3,36H (PRINTED OUTPUT UNIT FOR THIS CASE) /
49H NWF =,I3,35H (NUMBER OF WAVEFUNCTIONS INVOLVED) /
59H NCFGI =,I3,48H (NUMBER OF CONFIGURATIONS IN THE INITIAL STATE)
6/9H NCFGF =,I3,46H (NUMBER OF CONFIGURATIONS IN THE FINAL STATE)/
79H MULT =,I3,40H (MULTIPLICITY (2S+1) OF THE TWO STATES) )
204 FORMAT(//5H THE ,I2,28H ORBITALS ARE THE FOLLOWING:/)
205 FORMAT(2X,9(I1,3X),21(I2,2X))
206 FORMAT(/2X,30(3A1,1X)/)
207 FORMAT(2X,30(I2,2X))
208 FORMAT(//38H CONFIGURATIONS/WEIGHTS OF THE INITIAL,A8,
124HSTATE WITH TOTAL ENERGY= ,F16.8)
209 FORMAT( 86H -----------------------------------------------------
1--------------------------------/)
210 FORMAT(I7,1H.,3A8,F12.7)
211 FORMAT(//38H CONFIGURATIONS/WEIGHTS OF THE FINAL,A8,
124HSTATE WITH TOTAL ENERGY= ,F16.8)
212 FORMAT(64H1TERM INITIAL STATE CONFIGURATION FINAL STATE CONFI
1GURATION11X12HCONTRIBUTION18X6HLENGTH8X8HVELOCITY)
213 FORMAT(128H ---- --------------------------- ----------------
1--------- ------------------------- ---------- ---
2-------//)
214 FORMAT(//91H ERROR ( L(KRHO)-L(KSIG).NE.+1/-1 ) FOUND IN THE TRAN
1SITION INTEGRAL PART OF THE FOLLOWING,I4,32H-TH INPUT CARD FROM IR
2EAD2 FILE./)
215 FORMAT(//70H ERROR (DIFFERENT L VALUES) FOUND IN THE OVERLAP PART
1OF THE FOLLOWING,I4,32H-TH INPUT CARD FROM IREAD2 FILE./)
216 FORMAT( 2H (,I2,2H) ,I4,1H.,3A8,4H -> ,I2,1H.,3A8,4H : <,3A1,3H/O/
1,3A1,1H>,17X,1H:,2X,F13.8,2X,F13.8)
217 FORMAT(1H+,79X,3H* <,3A1,1H/,3A1,3H>**,I1)
218 FORMAT(1H ,79X,3H* <,3A1,1H/,3A1,3H>**,I1)
219 FORMAT(/35X40HFINAL OSCILLATOR STRENGTHS (LENGTH) =,F14.8/
1 63X12H(VELOCITY) =, F14.8)
220 FORMAT(/42X35HENERGY DIFFERENCE OF THE STATES = ,D16.8,5H CM-1/
174X3H= ,D16.8,10H ANGSTROMS/74X3H= ,D16.8,6H A. U.)
C
C *** SET JREAD EQUAL TO THE CARD INPUT CHANNEL OF YOUR INSTALLATION
C *** & NSET=0, AND START THE DATA READING FOR THE FISRT SET OF THE
C *** CALCULATIONS.
C
JREAD=5
NSET=0
C
C
C *** START THE DATA READING FOR A NEW SET OF CALCULATIONS.
C
1 READ(JREAD,101) ASTER, JREAD
C
C *** IF 'ASTER' IS NOT A BLANK CHARACTER, ALL SETS OF CALCULATIONS ARE
C *** FINISHED AND THE PROGRAM STOPS.
C *** IF 'ASTER' IS A BLANK CHARACTER, SET NSET=NSET+1 & NCASE=0,
C *** AND START THE DATA READING FOR THE FIRST CASE OF THIS SET.
C
IF(ASTER.NE.BLANK) GO TO 15
NSET=NSET+1
NCASE=0
C
C *** START THE DATA READING FOR A NEW CASE OF THE NSET-TH SET.
C
2 READ(JREAD,101) ASTER,IREAD1,IREAD2,IWRITE,ATOM,IZ,NWF,TRMI,TRMF,
1 NCFGI,NCFGF,MULT,ISO
C
C *** IF 'ASTER' IS NOT A BLANK CHARACTER, ALL CASES OF CALCULATIONS ARE
C *** FINISHED AND THE PROGRAM PROCEEDS TO TAKE THE NEXT SET OF CASES.
C *** IF 'ASTER' IS A BLANK CHARACTER, SET NCASE=NCASE+1, AND PROCEED
C *** FOR READING ADDITIONAL DATA, AND CALCULATIONS ETC. FOR THIS CASE.
C
IF(ASTER.NE.BLANK) GO TO 1
NCASE=NCASE+1
READ(JREAD,103) ETI
READ(JREAD,104) (CONFAI(NC),CONFBI(NC),
1 CONFCI(NC),WTI(NC),NC=1,NCFGI)
READ(JREAD,103) ETF
READ(JREAD,104) (CONFAF(NC),CONFBF(NC),
1 CONFCF(NC),WTF(NC),NC=1,NCFGF)
WRITE(IWRITE,200) NSET,NCASE
Z=IZ
WRITE(IWRITE,201) ATOM,IZ,TRMI,TRMF
WRITE(IWRITE,202)
WRITE(IWRITE,203) JREAD,IREAD1,IREAD2,IWRITE,NWF,NCFGI,NCFGF,MULT
C
C *** CALCULATE THE 'R' VARIABLE-MESH FOR THE NUMERICAL RADIAL ORBITALS
C *** P(R).
C
RHO=-4.0
DO 3 J=1,NO
R(J)=DEXP(RHO)/Z
RR(J)=R(J)*R(J)
R2(J)=DSQRT(R(J))
3 RHO=RHO+H
C
C *** READ THE RADIAL ORBITALS AND CALCULATE THEIR L-QUANTUM NUMBERS.
C
DO 5 I=1,NWF
READ(IREAD1,102) (EL(I,J),J=1,3),M,AZ(I),(P(I,J),J=1,M)
J=3
IF(EL(I,1).NE.BLANK) J=2
IF(EL(I,J).EQ.SYMM(1)) L(I)=0
IF(EL(I,J).EQ.SYMM(2)) L(I)=1
IF(EL(I,J).EQ.SYMM(3)) L(I)=2
IF(EL(I,J).EQ.SYMM(4)) L(I)=3
IF(EL(I,J).EQ.SYMM(5)) L(I)=4
MAX(I)=M
IF(M.EQ.NO) GO TO 5
M=M+1
DO 4 J=M,NO
4 P(I,J)=D0
5 CONTINUE
WRITE(IWRITE,204) NWF
N30=MIN0(NWF,30)
WRITE(IWRITE,205) (I,I=1,N30)
WRITE(IWRITE,206) ((EL(I,J),J=1,3),I=1,N30)
IF(NWF.LE.30) GO TO 6
WRITE(IWRITE,207) (I,I=31,NWF)
WRITE(IWRITE,206) ((EL(I,J),J=1,3),I=31,NWF)
6 WRITE(IWRITE,208) TRMI,ETI
WRITE(IWRITE,209)
WRITE(IWRITE,210) (NC,CONFAI(NC),CONFBI(NC),
1 CONFCI(NC),WTI(NC),NC=1,NCFGI)
WRITE(IWRITE,211) TRMF,ETF
WRITE(IWRITE,209)
WRITE(IWRITE,210) (NC,CONFAF(NC),CONFBF(NC),
1 CONFCF(NC),WTF(NC),NC=1,NCFGF)
WRITE(IWRITE,212)
WRITE(IWRITE,213)
C
C *** INITIALIZE THE TOTAL LENGTH (SL) AND THE TOTAL VELOCITY (SV)
C *** 'GF' VALUES TO ZERO, SET NTERM=0, AND START READING THE TRANSITION
C *** INTEGRALS DATA FOR THE CASE IN QUESTION.
C
SL = D0
SV = D0
NTERM=0
C
C *** READ DATA FOR THE NEXT TRANSITION INTEGRAL TERM.
C
7 READ(IREAD2,105) ASTER,COEF,KRHO,JI,KSIG,JF,II1,IF1,IP1,
1 II2,IF2,IP2,
2 II3,IF3,IP3
C
C *** IF 'ASTER' IS NOT A BLANK CHARACTER, ALL TRANSITION INTEGRAL
C *** TERMS HAVE BEEN READ AND USED. THEN THE PROGRAM PROCEEDS TO DO
C *** THE CALCULATIONS OF THE FINAL RESULTS OF OSCILLATOR STRENGTHS
C *** FOR THE CASE IN QUESTION.
C *** IF 'ASTER' IS A BLANK CHARACTER, SET NTERM=NTERM+1, AND PROCEED
C *** TO EVALUATE THE CONTRIBUTIONS TL AND TV OF THIS TERM TO THE
C *** TOTAL 'GF' VALUES SL AND SV.
C
IF(ASTER.NE.BLANK) GO TO 14
NTERM=NTERM+1
C
C *** BEFORE PROCEEDING TO USE THIS TRANSITION INTEGRAL INPUT DATA,
C *** CHECK FOR ANY OBVIOUS ERROR IN IT. IF ERROR IS FOUND, IT IS
C *** PRINTED AND THE PROGRAM STOPS.
C
IF(IABS(L(KRHO)-L(KSIG)).EQ.1) GO TO 8
C
C *** ERROR FOUND IN AN INPUT DATA FROM FILE IREAD2.
C
WRITE(IWRITE,214) NTERM
GO TO 12
8 IF(IP1.EQ.0) GO TO 9
IF(L(II1).EQ.L(IF1)) GO TO 9
C
C *** ERROR FOUND IN AN INPUT DATA FROM FILE IREAD2.
C
GO TO 11
9 IF(IP2.EQ.0) GO TO 10
IF(L(II2).EQ.L(IF2)) GO TO 10
C
C *** ERROR FOUND IN AN INPUT DATA FROM FILE IREAD2.
C
GO TO 11
10 IF(IP3.EQ.0) GO TO 13
IF(L(II3).EQ.L(IF3)) GO TO 13
C
C *** ERROR FOUND IN AN INPUT DATA FROM FILE IREAD2.
C
11 WRITE(IWRITE,215) NTERM
12 WRITE(IWRITE,105) ASTER,COEF,KRHO,JI,KSIG,JF,II1,IF1,IP1,
1 II2,IF2,IP2,
2 II3,IF3,IP3
CALL EXIT
C
C *** NO ERROR IN THE TRANSITION INTEGRAL DATA IS FOUND AND HENCE
C *** PROCEED TO USE IT FOR EVALUATING TL AND TV VALUES.
C
13 L1 = L(KRHO)
L2 = L(KSIG)
LL = MAX0(L1,L2)
K = LL - L1
D = (-1)**K*DSQRT(LL*D1)*WTI(JI)*WTF(JF)*COEF
C
C *** MULTIPLY BY THE OVERLAPS INTEGRALS, IF ANY.
C
IF (IP1 .NE. 0) D = D*QUADR(II1,IF1,0)**IP1
IF (IP2 .NE. 0) D = D*QUADR(II2,IF2,0)**IP2
IF (IP3 .NE. 0) D = D*QUADR(II3,IF3,0)**IP3
TL = D*QUADR(KRHO,KSIG,1)
TV = D*GRAD(KRHO,KSIG)
C
C *** OUTPUT THE CALCULATED TERM CONTRIBUTIONS TL AND TV.
C
WRITE(IWRITE,216) NTERM,JI,CONFAI(JI),CONFBI(JI),CONFCI(JI),
1 JF,CONFAF(JF),CONFBF(JF),CONFCF(JF),
2 (EL(KRHO,J),J=1,3),(EL(KSIG,J),J=1,3),TL,TV
IF(IP1.NE.0) WRITE(IWRITE,217) (EL(II1,J),J=1,3),(EL(IF1,J),J=1,3)
1 ,IP1
IF(IP2.NE.0) WRITE(IWRITE,218) (EL(II2,J),J=1,3),(EL(IF2,J),J=1,3)
1 ,IP2
IF(IP3.NE.0) WRITE(IWRITE,218) (EL(II3,J),J=1,3),(EL(IF3,J),J=1,3)
1 ,IP3
C
C *** ADD THE EVALUATED TERM CONTRIBUTIONS TL AND TV TO THE TOTAL
C *** 'GF' VALUES SL AND SV.
C
SL = SL + TL
SV = SV + TV
C
C *** PROCEED TO TAKE THE NEXT TRANSITION INTEGRAL DATA.
C
GO TO 7
C
C *** ALL TRANSITION INTEGRALS DATA HAVE BEEN USED AND HENCE PROCEED
C *** TO DO THE FINAL CALCULATIONS AND OUTPUT THEM.
C
14 D = DABS(ETI-ETF)
CL = D2*D*DABS(DFLOAT(MULT))/D3
CV = D2*DABS(DFLOAT(MULT))/(D*D3)
GL = CL*SL**2
GV = CV*SV**2
WRITE(IWRITE,219) GL,GV
DD = D*D2*109737.3D0
ANGS = D10**8/DD
WRITE(IWRITE,220) DD,ANGS,D
C
C *** CALCULATIONS FOR THE PRESENT CASE ARE FINISHED AND THE FINAL
C *** RESULTS HAVE ALSO BEEN OUTPUT.
C *** IF THE NEXT CASE TO BE DONE IS A CASE ISO-ELECTRONIC TO THE ONE
C *** JUST FINISHED, REWIND THE DEVICE 'IREAD2'.
C *** THIS WILL ENABLE US TO REUSE THE TRANSITION INTEGRALS DATA.
C *** PROCEED TO TAKE THE NEXT CASE.
C
IF(ISO.EQ.1) REWIND IREAD2
GO TO 2
15 STOP
END
C
C ------------------------------------------------------------------
C *** B L O C K D A T A
C ------------------------------------------------------------------
C
BLOCK DATA
IMPLICIT REAL*8(A-H,O-Z)
COMMON /PARAM/D0,D1,D2,D3,D4,D5,D6,D10,H,H1,Z,NO,ND
DATA D0,D1,D2,D3,D4,D5/0.D0,1.D0,2.D0,3.D0,4.D0,.5D0/
DATA D6,D10/6.D0,10.D0/
DATA H,H1/.0625D0,.4166666666666667D-01/
DATA NO,ND/220,218/
END
C
C ------------------------------------------------------------------
C *** Q U A D R
C ------------------------------------------------------------------
C
C *** QUADR INTEGRATES P(I)*P(J)*R**KK BY SIMPSON'S RULE
C
REAL FUNCTION QUADR*8(I,J,KK)
IMPLICIT REAL*8(A-H,O-Z)
COMMON /PARAM/D0,D1,D2,D3,D4,D5,D6,D10,H,H1,Z,NO,ND
COMMON R(220),RR(220),R2(220),P(50,220),AZ(50),L(50),MAX(50)
K = KK + 2
LI = L(I)
LJ = L(J)
DEN = LI + LJ + 1 + K
ZR = Z*R(4)
BI = (P(I,4)/(AZ(I)*R2(4)*R(4)**LI) - D1+ZR/(LI+1) )/ZR**2
BJ = (P(J,4)/(AZ(J)*R2(4)*R(4)**LJ) - D1+ZR/(LJ+1) )/ZR**2
ALPHA= (D1/(LI + 1) + D1/(LJ + 1))/(DEN + D1)
ZR = Z*R(1)
BETA = (DEN+D1)*ALPHA**2 - D2*(BI+BJ+D1/((LI+1)*(LJ+1)))/(DEN+D2)
D = P(I,1)*P(J,1)*R(1)**K*(((BETA*ZR+ALPHA)*ZR+D1)/(DEN*H1)+D5)
M = MIN0(MAX(I),MAX(J)) - 1
DO 1 JJ = 2,M,2
JP = JJ + 1
1 D = D + D2*P(I,JJ)*P(J,JJ)*R(JJ)**K+P(I,JP)*P(J,JP)*R(JP)**K
QUADR = D*H1
RETURN
END
C
C ------------------------------------------------------------------
C *** G R A D
C ------------------------------------------------------------------
C
C *** THE GRAD FUNCTION SUBPROGRAM COMPUTES THE FOLLOWING DIRECTLY
C *** <P(J)!D + L(I)/R !P(I)> WITH L(I) > L(J)
C
REAL FUNCTION GRAD*8(I,J)
IMPLICIT REAL*8(A-H,O-Z)
COMMON /PARAM/D0,D1,D2,D3,D4,D5,D6,D10,H,H1,Z,NO,ND
COMMON R(220),RR(220),R2(220),P(50,220),AZ(50),L(50),MAX(50)
LL = MAX0(L(I),L(J))
II = I
JJ = J
IF ( L(I) .GT. L(J) ) GO TO 1
II = J
JJ = I
1 A1 = (LL+D5)/(LL*(LL+1)*(2*LL+1))
GRAD = R(1)*P(I,1)*P(J,1)*(D1 + A1*Z*R(1))
DL = D5*P(I,1)*P(J,1)*R(1)
MM = MIN0(MAX(I)+1,MAX(J)+1,ND)
K = 2
F1 = D5*(P(II,K+1) - P(II,K-1))
F2 = P(II,K+1) - D2*P(II,K) + P(II,K-1)
G0 = P(JJ,K)*R(K)
G1 = D5*(P(JJ,K+1)*R(K+1) - P(JJ,K-1)*R(K-1))
G2 = P(JJ,K+1)*R(K+1) - D2*P(JJ,K)*R(K) + P(JJ,K-1)*R(K-1)
GRAD = GRAD + D2*F1*G0 +(D2*F2*G1 + F1*G2)/D3
DL = DL + D2*P(II,K)*P(JJ,K)*R(K) + P(II,K+1)*P(JJ,K+1)*R(K+1)
DO 2 K = 4,MM,2
F1 = D5*(P(II,K+1) - P(II,K-1))
F2 = P(II,K+1) - D2*P(II,K) + P(II,K-1)
F3 = D5*(P(II,K+2) - P(II,K-2)) - D2*F1
F4 = P(II,K+2) + P(II,K-2) - D4*(P(II,K+1) + P(II,K-1))
1 + D6*P(II,K)
G0 = P(JJ,K)*R(K)
G1 = D5*(P(JJ,K+1)*R(K+1) - P(JJ,K-1)*R(K-1))
G2 = P(JJ,K+1)*R(K+1) - D2*P(JJ,K)*R(K) + P(JJ,K-1)*R(K-1)
G3 = D5*(P(JJ,K+2)*R(K+2) - P(JJ,K-2)*R(K-2)) -D2*G1
G4 = P(JJ,K+2)*R(K+2) + P(JJ,K-2)*R(K-2) - D4*(P(JJ,K+1)*R(K+1)
1 + P(JJ,K-1)*R(K-1)) + D6*P(JJ,K)*R(K)
GRAD = GRAD + D2*F1*G0 +(D2*F2*G1 + F1*G2)/D3
1 - (F1*G4-F4*G1 + D4*(F2*G3-F3*G2))/90.D0
2 DL = DL + D2*P(II,K)*P(JJ,K)*R(K) + P(II,K+1)*P(JJ,K+1)*R(K+1)
GRAD = GRAD + (LL+D5)*DL*H1
IF (II .EQ. I) GRAD = - GRAD
RETURN
END
FINISH
SAMPLE DATA
5
5 5 6 HE+00 2 3 1P 1D 2 2 1 0
-2.12245410
1S(1)2P(1) 0.9999984
2P(1)3D(1) 0.0017745
-2.05555120
1S(1)3D(1) 0.9999981
2P(2) -0.0019432
1S 128 0.56569028D+01
0.5315209 0.5477458 0.5644230 0.5815607 0.5991671 0.6172497
0.6358159 0.6548724 0.6744253 0.6944799 0.7150412 0.7361127
0.7576973 0.7797967 0.8024113 0.8255399 0.8491800 0.8733271
0.8979749 0.9231148 0.9487358 0.9748244 1.0013641 1.0283352
1.0557147 1.0834755 1.1115867 1.1400129 1.1687137 1.1976437
1.2267519 1.2559813 1.2852685 1.3145433 1.3437282 1.3727382
1.4014802 1.4298528 1.4577458 1.4850397 1.5116061 1.5373068
1.5619941 1.5855107 1.6076895 1.6283547 1.6473211 1.6643957
1.6793778 1.6920608 1.7022328 1.7096787 1.7141823 1.7155284
1.7135055 1.7079090 1.6985449 1.6852333 1.6678130 1.6461460
1.6201221 1.5896647 1.5547351 1.5153386 1.4715287 1.4234125
1.3711543 1.3149793 1.2551755 1.1920953 1.1261543 1.0578295
0.9876544 0.9162128 0.8441299 0.7720611 0.7006788 0.6306576
0.5626570 0.4973049 0.4351789 0.3767902 0.3225673 0.2728432
0.2278456 0.1876911 0.1523842 0.1218209 0.0957978 0.0740251
0.0561435 0.0417439 0.0303877 0.0216279 0.0150281 0.0101784
0.0067081 0.0042939 0.0026641 0.0015985 0.0009250 0.0005146
0.0002740 0.0001388 0.0000661 0.0000290 0.0000111 0.0000031
-0.0000002 -0.0000013 -0.0000014 -0.0000013 -0.0000011 -0.0000009
-0.0000007 -0.0000005 -0.0000004 -0.0000003 -0.0000002 -0.0000001
-0.0000001 -0.0000001 -.0 -.0 -.0 -.0
-.0 -.0
2P 138 0.20138234D+00
0.0001749 0.0001920 0.0002107 0.0002313 0.0002538 0.0002785
0.0003057 0.0003354 0.0003681 0.0004039 0.0004431 0.0004861
0.0005333 0.0005850 0.0006417 0.0007038 0.0007718 0.0008464
0.0009280 0.0010174 0.0011153 0.0012226 0.0013399 0.0014683
0.0016088 0.0017625 0.0019306 0.0021144 0.0023153 0.0025348
0.0027746 0.0030365 0.0033224 0.0036345 0.0039749 0.0043462
0.0047509 0.0051919 0.0056723 0.0061953 0.0067645 0.0073836
0.0080566 0.0087880 0.0095824 0.0104446 0.0113800 0.0123943
0.0134934 0.0146837 0.0159721 0.0173658 0.0188725 0.0205002
0.0222578 0.0241543 0.0261995 0.0284036 0.0307774 0.0333324
0.0360804 0.0390341 0.0422064 0.0456108 0.0492611 0.0531715
0.0573560 0.0618284 0.0666021 0.0716894 0.0771011 0.0828461
0.0889303 0.0953561 0.1021212 0.1092179 0.1166318 0.1243408
0.1323140 0.1405106 0.1488794 0.1573574 0.1658702 0.1743312
0.1826423 0.1906942 0.1983677 0.2055351 0.2120625 0.2178120
0.2226449 0.2264251 0.2290231 0.2303202 0.2302131 0.2286183
0.2254777 0.2207623 0.2144767 0.2066624 0.1974000 0.1868103
0.1750531 0.1623247 0.1488531 0.1348910 0.1207070 0.1065758
0.0927662 0.0795298 0.0670900 0.0556318 0.0452949 0.0361680
0.0282884 0.0216432 0.0161752 0.0117906 0.0083692 0.0057750
0.0038668 0.0025074 0.0015715 0.0009498 0.0005523 0.0003082
0.0001646 0.0000839 0.0000407 0.0000187 0.0000082 0.0000033
0.0000013 0.0000005 0.0000002 0.0 0.0 0.0
3D 145 0.96975504D-02
0.0000001 0.0000001 0.0000001 0.0000001 0.0000001 0.0000002
0.0000002 0.0000002 0.0000003 0.0000003 0.0000004 0.0000004
0.0000005 0.0000006 0.0000007 0.0000008 0.0000009 0.0000011
0.0000013 0.0000015 0.0000017 0.0000020 0.0000024 0.0000028
0.0000032 0.0000038 0.0000044 0.0000051 0.0000060 0.0000070
0.0000081 0.0000095 0.0000111 0.0000129 0.0000150 0.0000175
0.0000204 0.0000238 0.0000277 0.0000323 0.0000376 0.0000438
0.0000510 0.0000593 0.0000690 0.0000803 0.0000934 0.0001085
0.0001261 0.0001466 0.0001702 0.0001977 0.0002294 0.0002663
0.0003089 0.0003581 0.0004151 0.0004810 0.0005572 0.0006452
0.0007467 0.0008639 0.0009990 0.0011547 0.0013341 0.0015407
0.0017783 0.0020514 0.0023651 0.0027250 0.0031376 0.0036101
0.0041505 0.0047676 0.0054713 0.0062724 0.0071826 0.0082148
0.0093825 0.0107005 0.0121841 0.0138494 0.0157127 0.0177907
0.0200999 0.0226560 0.0254739 0.0285664 0.0319442 0.0356145
0.0395801 0.0438388 0.0483818 0.0531924 0.0582453 0.0635049
0.0689243 0.0744444 0.0799935 0.0854866 0.0908263 0.0959035
0.1005992 0.1047873 0.1083383 0.1111235 0.1130211 0.1139216
0.1137351 0.1123977 0.1098776 0.1061809 0.1013552 0.0954914
0.0887227 0.0812209 0.0731894 0.0648536 0.0564488 0.0482071
0.0403429 0.0330414 0.0264472 0.0206580 0.0157217 0.0116382
0.0083651 0.0058268 0.0039254 0.0025521 0.0015976 0.0009606
0.0005533 0.0003045 0.0001596 0.0000795 0.0000374 0.0000166
0.0000069 0.0000027 0.0000010 0.0000003 0.0000001 0.0
0.0
1.00000000RI( 2 1, 3 1)
1.82574186RI( 1 1, 2 2)
1.00000000RI( 2 2, 1 1)
0.18257419RI( 3 2, 2 2)
*
5 5 6 LI+01 3 3 1P 1D 2 2 1 0
-4.99009630
1S(1)2P(1) 0.9999948
2P(1)3D(1) 0.0032164
-4.72219710
1S(1)3D(1) 0.9999934
2P(2) -0.0036470
1S 126 0.10392566D+02
0.7972946 0.8216323 0.8466485 0.8723555 0.8987655 0.9258900
0.9537397 0.9823249 1.0116546 1.0417372 1.0725795 1.1041874
1.1365649 1.1697145 1.2036369 1.2383304 1.2737911 1.3100124
1.3469846 1.3846951 1.4231273 1.4622609 1.5020711 1.5425284
1.5835982 1.6252401 1.6674077 1.7100476 1.7530995 1.7964953
1.8401584 1.8840032 1.9279347 1.9718475 2.0156256 2.0591413
2.1022551 2.1448147 2.1866547 2.2275963 2.2674466 2.3059982
2.3430298 2.3783051 2.4115739 2.4425721 2.4710221 2.4966343
2.5191078 2.5381325 2.5533906 2.5645596 2.5713150 2.5733339
2.5702993 2.5619042 2.5478576 2.5278896 2.5017584 2.4692569
2.4302201 2.3845328 2.3321371 2.2730407 2.2073242 2.1351480
2.0567587 1.9724938 1.8827858 1.7881629 1.6892488 1.5867587
1.4814930 1.3743275 1.2661999 1.1580934 1.0510167 0.9459815
0.8439773 0.7459458 0.6527537 0.5651676 0.4838305 0.4092418
0.3417431 0.2815095 0.2285475 0.1827014 0.1436660 0.1110067
0.0841845 0.0625855 0.0455521 0.0324137 0.0225155 0.0152427
0.0100391 0.0064199 0.0039773 0.0023810 0.0013730 0.0007594
0.0004005 0.0001995 0.0000922 0.0000380 0.0000125 0.0000015
-0.0000025 -0.0000035 -0.0000032 -0.0000026 -0.0000020 -0.0000015
-0.0000010 -0.0000007 -0.0000005 -0.0000003 -0.0000002 -0.0000001
-0.0000001 -0.0000001 -.0 -.0 -.0 -.0
2P 133 0.11627005D+01
0.0005496 0.0006033 0.0006622 0.0007268 0.0007976 0.0008754
0.0009606 0.0010541 0.0011567 0.0012692 0.0013925 0.0015277
0.0016759 0.0018383 0.0020164 0.0022115 0.0024252 0.0026594
0.0029159 0.0031968 0.0035044 0.0038411 0.0042097 0.0046129
0.0050541 0.0055367 0.0060644 0.0066412 0.0072716 0.0079604
0.0087126 0.0095339 0.0104303 0.0114083 0.0124749 0.0136376
0.0149044 0.0162842 0.0177862 0.0194203 0.0211974 0.0231286
0.0252261 0.0275028 0.0299724 0.0326493 0.0355487 0.0386868
0.0420805 0.0457475 0.0497064 0.0539764 0.0585775 0.0635306
0.0688568 0.0745780 0.0807165 0.0872947 0.0943352 0.1018604
0.1098923 0.1184521 0.1275600 0.1372343 0.1474913 0.1583444
0.1698031 0.1818724 0.1945514 0.2078319 0.2216974 0.2361212
0.2510646 0.2664751 0.2822846 0.2984073 0.3147383 0.3311517
0.3474995 0.3636111 0.3792933 0.3943312 0.4084899 0.4215177
0.4331500 0.4431150 0.4511401 0.4569598 0.4603242 0.4610090
0.4588252 0.4536292 0.4453331 0.4339131 0.4194175 0.4019724
0.3817841 0.3591390 0.3343998 0.3079971 0.2804169 0.2521851
0.2238474 0.1959473 0.1690032 0.1434853 0.1197950 0.0982476
0.0790605 0.0623480 0.0481224 0.0363022 0.0267264 0.0191730
0.0133799 0.0090670 0.0059552 0.0037834 0.0023200 0.0013700
0.0007772 0.0004224 0.0002194 0.0001086 0.0000510 0.0000227
0.0000095 0.0000038 0.0000014 0.0000005 0.0000002 0.0
0.0
3D 141 0.10719878D+00
0.0000003 0.0000004 0.0000004 0.0000005 0.0000006 0.0000007
0.0000008 0.0000009 0.0000011 0.0000013 0.0000015 0.0000017
0.0000020 0.0000024 0.0000027 0.0000032 0.0000037 0.0000044
0.0000051 0.0000060 0.0000070 0.0000081 0.0000095 0.0000111
0.0000129 0.0000151 0.0000176 0.0000206 0.0000240 0.0000280
0.0000326 0.0000381 0.0000444 0.0000518 0.0000603 0.0000703
0.0000819 0.0000955 0.0001112 0.0001295 0.0001508 0.0001755
0.0002042 0.0002376 0.0002763 0.0003213 0.0003735 0.0004340
0.0005041 0.0005854 0.0006795 0.0007884 0.0009144 0.0010600
0.0012283 0.0014227 0.0016470 0.0019058 0.0022039 0.0025473
0.0029424 0.0033967 0.0039186 0.0045176 0.0052044 0.0059910
0.0068910 0.0079193 0.0090928 0.0104300 0.0119515 0.0136796
0.0156388 0.0178557 0.0203585 0.0231776 0.0263446 0.0298925
0.0338548 0.0382654 0.0431571 0.0485611 0.0545057 0.0610148
0.0681063 0.0757902 0.0840665 0.0929232 0.1023335 0.1122538
0.1226209 0.1333498 0.1443321 0.1554338 0.1664954 0.1773316
0.1877327 0.1974680 0.2062900 0.2139413 0.2201625 0.2247030
0.2273323 0.2278534 0.2261159 0.2220291 0.2155739 0.2068117
0.1958895 0.1830405 0.1685788 0.1528882 0.1364047 0.1195942
0.1029267 0.0868487 0.0717567 0.0579745 0.0457360 0.0351772
0.0263349 0.0191565 0.0135148 0.0092290 0.0060874 0.0038697
0.0023652 0.0013864 0.0007772 0.0004156 0.0002113 0.0001018
0.0000463 0.0000198 0.0000080 0.0000030 0.0000010 0.0000003
0.0000001 0.0 0.0
1.00000000RI( 2 1, 3 1)
1.82574186RI( 1 1, 2 2)
1.00000000RI( 2 2, 1 1)
0.18257419RI( 3 2, 2 2)
*
*
5
5 5 6 HE+00 2 7 1P 1D 2 2 1 0
-2.12355450
1S1(1)2P1(1) 0.9997838
2P2(1)3D1(1) 0.0207920
-2.05557630
1S2(1)3D2(1) 0.9999900
2P3(2) -0.0044660
1S1 129 0.56614304D+01
0.5319463 0.5481842 0.5648747 0.5820261 0.5996466 0.6177437
0.6363248 0.6553965 0.6749650 0.6950357 0.7156134 0.7367017
0.7583036 0.7804207 0.8030533 0.8262004 0.8498594 0.8740258
0.8986933 0.9238532 0.9494947 0.9756041 1.0021650 1.0291576
1.0565588 1.0843417 1.1124753 1.1409240 1.1696476 1.1986005
1.2277317 1.2569842 1.2862944 1.3155922 1.3447999 1.3738326
1.4025969 1.4309914 1.4589058 1.4862205 1.5128069 1.5385268
1.5632322 1.5867657 1.6089601 1.6296393 1.6486181 1.6657030
1.6806934 1.6933823 1.7035575 1.7110039 1.7155048 1.7168448
1.7148121 1.7092021 1.6998202 1.6864864 1.6690393 1.6473404
1.6212797 1.5907801 1.5558030 1.5163534 1.4724849 1.4243044
1.3719766 1.3157266 1.2558429 1.1926780 1.1266482 1.0582309
0.9879602 0.9164209 0.8442387 0.7720702 0.7005887 0.6304696
0.5623737 0.4969297 0.4347165 0.3762459 0.3219475 0.2721552
0.2270973 0.1868912 0.1515419 0.1209461 0.0949007 0.0731163
0.0552338 0.0408439 0.0295082 0.0207791 0.0142194 0.0094181
0.0060032 0.0036499 0.0020845 0.0010849 0.0004771 0.0001302
-0.0000505 -0.0001307 -0.0001540 -0.0001479 -0.0001287 -0.0001056
-0.0000833 -0.0000637 -0.0000476 -0.0000348 -0.0000249 -0.0000175
-0.0000120 -0.0000081 -0.0000053 -0.0000034 -0.0000021 -0.0000013
-0.0000007 -0.0000004 -0.0000002 -0.0000001 -0.0000001 -.0
-.0 -.0 -.0
2P1 138 0.21035480D+00
0.0001827 0.0002005 0.0002201 0.0002416 0.0002651 0.0002910
0.0003193 0.0003504 0.0003845 0.0004219 0.0004629 0.0005078
0.0005571 0.0006111 0.0006703 0.0007351 0.0008062 0.0008841
0.0009693 0.0010628 0.0011650 0.0012770 0.0013996 0.0015337
0.0016805 0.0018411 0.0020166 0.0022086 0.0024184 0.0026477
0.0028982 0.0031718 0.0034705 0.0037964 0.0041520 0.0045398
0.0049625 0.0054232 0.0059250 0.0064713 0.0070658 0.0077124
0.0084154 0.0091794 0.0100090 0.0109096 0.0118866 0.0129460
0.0140939 0.0153371 0.0166826 0.0181381 0.0197114 0.0214112
0.0232463 0.0252264 0.0273614 0.0296621 0.0321395 0.0348054
0.0376721 0.0407525 0.0440597 0.0476074 0.0514095 0.0554801
0.0598329 0.0644813 0.0694381 0.0747146 0.0803204 0.0862625
0.0925450 0.0991677 0.1061254 0.1134072 0.1209950 0.1288628
0.1369755 0.1452884 0.1537460 0.1622818 0.1708178 0.1792646
0.1875219 0.1954789 0.2030158 0.2100052 0.2163142 0.2218069
0.2263475 0.2298034 0.2320495 0.2329723 0.2324740 0.2304778
0.2269322 0.2218154 0.2151394 0.2069531 0.1973442 0.1864399
0.1744061 0.1614436 0.1477840 0.1336819 0.1194064 0.1052304
0.0914198 0.0782216 0.0658531 0.0544925 0.0442719 0.0352725
0.0275244 0.0210083 0.0156616 0.0113867 0.0080607 0.0055464
0.0037028 0.0023937 0.0014953 0.0009007 0.0005219 0.0002901
0.0001544 0.0000784 0.0000379 0.0000173 0.0000075 0.0000031
0.0000012 0.0000004 0.0000001 0.0 0.0 0.0
2P2 131 0.31968754D+01
0.0027760 0.0030470 0.0033443 0.0036705 0.0040284 0.0044209
0.0048515 0.0053236 0.0058414 0.0064092 0.0070317 0.0077141
0.0084621 0.0092819 0.0101803 0.0111647 0.0122430 0.0134241
0.0147175 0.0161336 0.0176838 0.0193803 0.0212366 0.0232671
0.0254875 0.0279150 0.0305679 0.0334663 0.0366316 0.0400871
0.0438577 0.0479704 0.0524539 0.0573390 0.0626588 0.0684483
0.0747448 0.0815878 0.0890189 0.0970820 0.1058228 0.1152891
0.1255300 0.1365964 0.1485396 0.1614118 0.1752647 0.1901490
0.2061135 0.2232039 0.2414613 0.2609209 0.2816098 0.3035450
0.3267311 0.3511576 0.3767955 0.4035944 0.4314786 0.4603436
0.4900520 0.5204296 0.5512614 0.5822886 0.6132049 0.6436549
0.6732333 0.7014852 0.7279092 0.7519628 0.7730708 0.7906374
0.8040618 0.8127581 0.8161793 0.8138441 0.8053667 0.7904876
0.7691034 0.7412934 0.7073395 0.6677377 0.6231966 0.5746229
0.5230910 0.4697982 0.4160067 0.3629777 0.3119009 0.2638284
0.2196173 0.1798890 0.1450082 0.1150844 0.0899945 0.0694230
0.0529139 0.0399269 0.0298920 0.0222546 0.0165100 0.0122233
0.0090376 0.0066720 0.0049129 0.0036021 0.0026240 0.0018950
0.0013537 0.0009547 0.0006635 0.0004536 0.0003047 0.0002008
0.0001296 0.0000819 0.0000505 0.0000304 0.0000178 0.0000101
0.0000056 0.0000030 0.0000016 0.0000008 0.0000004 0.0000002
0.0000001 0.0 0.0 0.0 0.0
3D1 135 0.17836844D+01
0.0000142 0.0000166 0.0000194 0.0000227 0.0000265 0.0000310
0.0000362 0.0000423 0.0000495 0.0000578 0.0000675 0.0000788
0.0000921 0.0001076 0.0001257 0.0001468 0.0001714 0.0002001
0.0002337 0.0002729 0.0003185 0.0003718 0.0004340 0.0005065
0.0005910 0.0006896 0.0008044 0.0009383 0.0010942 0.0012758
0.0014872 0.0017332 0.0020195 0.0023525 0.0027395 0.0031893
0.0037118 0.0043182 0.0050218 0.0058375 0.0067825 0.0078767
0.0091423 0.0106049 0.0122936 0.0142411 0.0164843 0.0190649
0.0220293 0.0254293 0.0293220 0.0337706 0.0388438 0.0446162
0.0511679 0.0585837 0.0669525 0.0763655 0.0869150 0.0986913
0.1117797 0.1262568 0.1421856 0.1596101 0.1785489 0.1989884
0.2208756 0.2441100 0.2685374 0.2939428 0.3200458 0.3464988
0.3728869 0.3987329 0.4235064 0.4466381 0.4675384 0.4856216
0.5003332 0.5111786 0.5177531 0.5197680 0.5170727 0.5096682
0.4977120 0.4815120 0.4615099 0.4382556 0.4123749 0.3845335
0.3554013 0.3256204 0.2957791 0.2663942 0.2379016 0.2106536
0.1849225 0.1609079 0.1387443 0.1185107 0.1002381 0.0839160
0.0694989 0.0569113 0.0460524 0.0368018 0.0290239 0.0225734
▶EOF◀