Line data Source code
1 : MODULE m_coredir
2 : CONTAINS
3 664 : SUBROUTINE coredir(mrad,e,l,xmj,iway,vv,bb,rc,dx,nmatch,nzero,
4 664 : + gc,fc,pow,qow,piw,qiw)
5 :
6 : c.........................................................coredir
7 : c solution of dirac equation for atomic problem
8 : c full relativistic spin-polarized case
9 : c Ry units: in charge
10 : c_______________________________________________ a. shick KFA 1996
11 :
12 : USE m_constants, ONLY : c_light
13 : USE m_crtail
14 : USE m_kernel1
15 : USE m_kernel2
16 :
17 : IMPLICIT NONE
18 : c
19 : C .. Parameters ..
20 : INTEGER, INTENT (IN) :: mrad
21 : C ..
22 : C .. Scalar Arguments ..
23 : REAL dx,e,xmj
24 : INTEGER iway,l,nmatch,nzero
25 : C ..
26 : C .. Array Arguments ..
27 : REAL bb(mrad),fc(2,2,mrad),gc(2,2,mrad),piw(2,2),pow(2,2),
28 : + qiw(2,2),qow(2,2),rc(mrad),vv(mrad)
29 : C ..
30 : C .. Local Scalars ..
31 : REAL cc,csq,dx1
32 : INTEGER i,ir,irv,j,kap1,kap2,n,nn,nsol,nstart
33 : C ..
34 : C .. Local Arrays ..
35 664 : REAL b(mrad),dp(2,2,mrad),dq(2,2,mrad),ra(mrad),v(mrad),
36 664 : + wp(2,2,mrad),wq(2,2,mrad),xx1(4),xx2(4)
37 : C ..
38 : C .. External Subroutines ..
39 : EXTERNAL inconi,inconz
40 : C ..
41 : C .. Intrinsic Functions ..
42 : INTRINSIC abs
43 : C ..
44 664 : cc = c_light(2.0)
45 664 : csq = cc*cc
46 : C
47 664 : kap1 = -l - 1
48 664 : kap2 = +l
49 : c
50 664 : nsol = 2
51 664 : IF (abs(xmj).GE.l) nsol = 1
52 : C
53 664 : IF (iway.EQ.2) GO TO 60
54 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
55 : C OUTWARD INTEGRATION
56 : C
57 996 : DO i = 1,2
58 2324 : DO j = 1,2
59 1328 : pow(j,i) = 0.0
60 1992 : qow(j,i) = 0.0
61 : END DO
62 : END DO
63 : c potential redefinition
64 165890 : DO ir = 1,nmatch
65 165558 : v(ir) = vv(ir)*rc(ir)*rc(ir)
66 165558 : b(ir) = bb(ir)*rc(ir)*rc(ir)
67 165890 : ra(ir) = rc(ir)
68 : END DO
69 : c initial condition
70 332 : CALL inconz(e,l,xmj,kap1,kap2,vv(1),bb(1),rc(1),xx1,xx2)
71 : c dirac equation solution: two cases 1)nsol=2; 2)nsol=1.
72 332 : nstart = 1
73 332 : IF (nsol.EQ.2) THEN
74 : CALL kernel2(mrad,nsol,xmj,kap1,kap2,xx1,xx2,e,v,b,ra,dx,
75 170 : + nmatch,nstart,dp,dq,wp,wq)
76 : ELSE
77 : CALL kernel1(mrad,xmj,kap1,xx1,e,v,b,ra,dx,nmatch,nstart,dp,
78 162 : + dq,wp,wq)
79 : END IF
80 : C
81 : C NOW TRANSFORM TO THE PROPER WAVEFUNCTIONS
82 : C
83 165890 : DO 30 n = 1,nmatch
84 417864 : DO 20 j = 1,nsol
85 678108 : DO 10 i = 1,nsol
86 425802 : gc(i,j,n) = wp(i,j,n)/rc(n)
87 425802 : fc(i,j,n) = wq(i,j,n)/ (rc(n)*cc)
88 252306 : 10 CONTINUE
89 165558 : 20 CONTINUE
90 332 : 30 CONTINUE
91 : c
92 834 : DO 50 j = 1,nsol
93 1344 : DO 40 i = 1,nsol
94 842 : pow(i,j) = wp(i,j,nmatch)
95 842 : qow(i,j) = wq(i,j,nmatch)
96 502 : 40 CONTINUE
97 332 : 50 CONTINUE
98 664 : RETURN
99 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
100 : C INWARD INTEGRATION
101 : C
102 : 60 CONTINUE
103 996 : DO i = 1,2
104 2324 : DO j = 1,2
105 1328 : piw(j,i) = 0.0
106 1992 : qiw(j,i) = 0.0
107 : END DO
108 : END DO
109 : c initial condition
110 332 : CALL inconi(l,xmj,e,csq,rc(nzero),xx1,xx2)
111 : c redefinition of order & potential redefinition
112 26210 : DO ir = nzero,nmatch,-1
113 25878 : irv = nzero - ir + 1
114 25878 : v(irv) = vv(ir)*rc(ir)*rc(ir)
115 25878 : b(irv) = bb(ir)*rc(ir)*rc(ir)
116 26210 : ra(irv) = rc(ir)
117 : END DO
118 332 : dx1 = -dx
119 : c dirac equation solution: two cases 1)nsol=2; 2)nsol=1.
120 332 : nstart = 1
121 332 : IF (nsol.EQ.2) THEN
122 : CALL kernel2(mrad,nsol,xmj,kap1,kap2,xx1,xx2,e,v,b,ra,dx1,
123 170 : + nzero-nmatch+1,nstart,dp,dq,wp,wq)
124 : ELSE
125 : CALL kernel1(mrad,xmj,kap1,xx1,e,v,b,ra,dx1,nzero-nmatch+1,
126 162 : + nstart,dp,dq,wp,wq)
127 : END IF
128 : C
129 : C NOW TRANSFORM TO THE PROPER WAVEFUNCTIONS
130 : C
131 26210 : DO 90 nn = 1,nzero - nmatch + 1
132 25878 : n = nzero - nn + 1
133 64728 : DO 80 j = 1,nsol
134 103644 : DO 70 i = 1,nsol
135 64794 : gc(i,j,n) = wp(i,j,nn)/ra(nn)
136 64794 : fc(i,j,n) = wq(i,j,nn)/ (ra(nn)*cc)
137 38850 : 70 CONTINUE
138 25878 : 80 CONTINUE
139 332 : 90 CONTINUE
140 :
141 : c exponential tail
142 :
143 : CALL crtail(
144 : > mrad,e,rc,nsol,nzero,csq,
145 332 : X gc,fc)
146 :
147 834 : DO j = 1,nsol
148 1676 : DO i = 1,nsol
149 842 : piw(i,j) = wp(i,j,nzero-nmatch+1)
150 1344 : qiw(i,j) = wq(i,j,nzero-nmatch+1)
151 : ENDDO
152 : ENDDO
153 : c
154 : END SUBROUTINE coredir
155 : END MODULE m_coredir
|
