📄 redmat.bas
字号:
DECLARE SUB SIXj (RJ0!, RJ1!, RJ2!, RJ3!, RL1!, RL2!, RL3!)REM REDMATREM TO CALCULATE J BASIS REDUCED MATRIX ELEMENTSREM FROM LS BASIS REDUCED MATRIX ELEMENTSREMREM CRYSTAL FIELD HANDBOOK (D.J. NEWMAN AND BETTY NG)REM CHAPTER 5 AND APPENDIX 2 DEFINT I-J, LLCONT: CLS PRINT "CALCULATION OF REDUCED MATRIX ELEMENTS" PRINT " <S L J葺VK葺S L' J'> FROM LS REDUCED " PRINT " MATRIX ELEMENTS <S L葺VK葺S L'>" PRINT " " INPUT "S, L, J = "; RS, RL, RJ INPUT "L', J' = "; RL1, RJ1LTRY: INPUT "RANK K OF TENSOR (2 OR 4 OR 6 ONLY) = "; K IF K < 2 OR K > 6 OR K = 3 OR K = 5 THEN PRINT "K CAN ONLY 2 OR 4 OR 6" GOTO LTRY END IF PRINT " " REMATLS = 0 PRINT "DO YOU WANT TO INPUT LS REDUCED MATRIX ELEMENT?" INPUT "INPUT Y/y FOR YES "; ANS$ IF ANS$ = "Y" OR ANS$ = "y" THEN PRINT " " INPUT "LS UNIT TENSOR REDUCED MATRIX ELEMENT = "; REMATLS ELSE PRINT "A DEFAULT LS REDUCED MATRIX ELEMENT WILL BE USED" IF RL > RL1 OR RL < RL1 OR RJ < RJ1 OR RJ > RJ1 THEN GOTO LINP END IF IF K = 2 THEN IF RL = 5! AND RS = 1! THEN IF RJ = 4! THEN REMATLS = 1.06533 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = -1.06533 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 1.5 THEN IF RJ = 4.5 THEN REMATLS = .44381 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = -.44381 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 2! THEN IF RJ = 4! THEN REMATLS = -.44381 GOTO LJUMP ELSE IF RJ = 8! THEN REMATLS = .44381 GOTO LJUMP END IF END IF END IF IF RL = 5! AND RS = 2.5 THEN IF RJ = 2.5 THEN REMATLS = -1.06533 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = 1.06533 GOTO LJUMP END IF END IF END IF IF RL = 3! AND RS = 3! THEN IF RJ = 0! THEN REMATLS = -1 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = 1 GOTO LJUMP END IF END IF END IF ELSE IF K = 4 THEN IF RL = 5! AND RS = 1! THEN IF RJ = 4! THEN REMATLS = -.90851 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = .90851 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 1.5 THEN IF RJ = 4.5 THEN REMATLS = -.63708 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = .63708 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 2! THEN IF RJ = 4! THEN REMATLS = .63708 GOTO LJUMP ELSE IF RJ = 8! THEN REMATLS = -.63708 GOTO LJUMP END IF END IF END IF IF RL = 5! AND RS = 2.5 THEN IF RJ = 2.5 THEN REMATLS = .90851 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = -.90851 GOTO LJUMP END IF END IF END IF IF RL = 3! AND RS = 3! THEN IF RJ = 0! THEN REMATLS = -1 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = 1 GOTO LJUMP END IF END IF END IF ELSE IF K = 6 THEN IF RL = 5! AND RS = 1! THEN IF RJ = 4! THEN REMATLS = -1.34921 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = 1.34921 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 1.5 THEN IF RJ = 4.5 THEN REMATLS = 1.78266 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = -1.78266 GOTO LJUMP END IF END IF END IF IF RL = 6! AND RS = 2! THEN IF RJ = 4! THEN REMATLS = -1.78266 GOTO LJUMP ELSE IF RJ = 8! THEN REMATLS = 1.78266 GOTO LJUMP END IF END IF END IF IF RL = 5! AND RS = 2.5 THEN IF RJ = 2.5 THEN REMATLS = 1.34921 GOTO LJUMP ELSE IF RJ = 7.5 THEN REMATLS = -1.34921 GOTO LJUMP END IF END IF END IF IF RL = 3! AND RS = 3! THEN IF RJ = 0! THEN REMATLS = -1 GOTO LJUMP ELSE IF RJ = 6! THEN REMATLS = 1 GOTO LJUMP END IF END IF END IF ELSELINP: PRINT "SORRY! A REDUCED MATRIX ELEMENT IS " PRINT "NOT AVAILABLE IN THE DEFAULT OPTION" PRINT "PLEASE ENTER IT IN" PRINT " " INPUT "LS BASIS UNIT TENSOR MATRIX ELEMENT = "; REMATLS END IF END IF END IF END IFLJUMP:REM CALL THE SUBPROGRAM SIXJ DK = K CALL SIXj(R0, RL, RJ, RS, RJ1, RL1, DK) RDUM = RS + K + RJ + RL1 REMATJ = (-1) ^ RDUM * SQR((2 * RJ + 1) * (2 * RJ1 + 1)) * R0 * REMATLSREM CONVERTING THE UNIT TENSOR REDUCED MATRIX ELEMENT TO THAT FOR CK IF K = 2 THEN REMATJ = REMATJ * (-2) * SQR(7! / 15!) ELSE IF K = 4 THEN REMATJ = REMATJ * SQR(14! / 11!) ELSE IF K = 6 THEN REMATJ = REMATJ * (-10) * SQR(7! / 429!) END IF END IF END IF PRINT " " PRINT " " PRINT "THE CALCULATED J BASIS REDUCED MATRIX ELEMENT = "; REMATJ PRINT " " INPUT "DO YOU WANT TO CONTINUE? Y/y FOR YES"; ANS1$ IF ANS1$ = "Y" OR ANS1$ = "y" THEN GOTO LCONT END IF ENDSUB SIXj (RJ0, RJ1, RJ2, RJ3, RL1, RL2, RL3)REM THIS SUBPROGRAM CALCULATE 6-J SYMBOL:REM R0=(RJ1,RJ2,RJ3;RL1,RL2,RL3)REM F(I) = I! IS THE FACTORIAL FUNCTIONREM I=0 TO 30 IS USUALLY SUFFICIENTREM PLEASE NOTE THAT I STARTS FROM ZERO DIM F(0 TO 30), RK(1 TO 7) FOR I = 0 TO 30 F(I) = 1 FOR J = 1 TO I F(I) = F(I) * J NEXT J NEXT I RK(7) = RJ3 + RJ1 + RL3 + RL1 RK(6) = RJ2 + RJ3 + RL2 + RL3 RK(5) = RJ1 + RJ2 + RL1 + RL2 RK(4) = RL1 + RL2 + RJ3 RK(3) = RL1 + RJ2 + RL3 RK(2) = RJ1 + RL2 + RL3 RK(1) = RJ1 + RJ2 + RJ3 IF RK(5) > RK(6) THEN RMAX = RK(6) ELSE RMAX = RK(5) END IF IF RMAX < RK(7) THEN ELSE RMAX = RK(7) END IF IF RK(1) < RK(2) THEN RMIN = RK(2) ELSE RMIN = RK(1) END IF FOR I = 3 TO 4 IF RMIN < RK(I) THEN RMIN = RK(I) ELSE END IF NEXT I RJ0 = 0 FOR I = RMIN TO RMAX RJ0 = RJ0 + ((-1) ^ I) * F(I + 1) / (F(I - RK(1)) * F(I - RK(2)) * F(I - RK(3)) * F(I - RK(4)) * F(RK(5) - I) * F(RK(6) - I) * F(RK(7) - I)) NEXT I C1 = SQR(F(RJ1 + RJ2 - RJ3) * F(RJ1 - RJ2 + RJ3) * F(-RJ1 + RJ2 + RJ3) / F(RJ1 + RJ2 + RJ3 + 1)) C2 = SQR(F(RJ1 + RL2 - RL3) * F(RJ1 - RL2 + RL3) * F(-RJ1 + RL2 + RL3) / F(RJ1 + RL2 + RL3 + 1)) C3 = SQR(F(RL1 + RJ2 - RL3) * F(RL1 - RJ2 + RL3) * F(-RL1 + RJ2 + RL3) / F(RL1 + RJ2 + RL3 + 1)) C4 = SQR(F(RL1 + RL2 - RJ3) * F(RL1 - RL2 + RJ3) * F(-RL1 + RL2 + RJ3) / F(RL1 + RL2 + RJ3 + 1)) RJ0 = RJ0 * C1 * C2 * C3 * C4END SUB⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -