C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
SUBROUTINE KBINT
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
C K-B TYPE ADDITION
C VPP-PARALLEL
!XOCL SUBPROCESSOR PS(IPARA)=PQ(1:IPARA)
!XOCL INDEX PARTITION IP=(PS,INDEX=1:KNV3,PART=BAND)
DIMENSION SSS(KNG1,KNV3,KTYP,10),SS2(KNG1,KNV3,KTYP,9)
& ,SS3(KNG1,KNV3,KTYP,4)
& ,RAA(KNG1,KNV3)
!XOCL LOCAL SSS(:,/IP,:,:),SS2(:,/IP,:,:),SS3(:,/IP,:)
!XOCL LOCAL RAA(:,/IP)
EQUIVALENCE (SNL,SSS),(SNL2,SS2),(SNL3,SS3)
& ,(RAK,RAA)
C
C K-B TYPE ADDITION
C INTEGRATION OF K-B TYPE POTENTIAL
C MODIFIED TO STRESS CALCULATION FOR KB-SEPARABLE FORM
NSEK=2
CO0=DSQRT(2.0D0)
CO1=DSQRT(3.0D0)
SC=DSQRT(PAI4)
PC=DSQRT(3.0D0*PAI4)
DC=DSQRT(5.0D0*PAI4)
C
!XOCL SPREAD DO /IP
DO 1003 IK=1,KV3
AKX = VX(IK)
AKY = VY(IK)
AKZ = VZ(IK)
C IIBA = IBA(IK)
DO 1005 I=1,IBA(IK)
RK=SQRT((AKX+GX(NBASE(I,IK)))**2
& +(AKY+GY(NBASE(I,IK)))**2 + (AKZ+GZ(NBASE(I,IK)))**2 )
*VOCL STMT,IF(90)
IF (RK.NE.0.0D0) THEN
RAA(I,IK)=1.0D0/RK
ELSE
RAA(I,IK)=0.0D0
END IF
1005 CONTINUE
1003 CONTINUE
!XOCL END SPREAD
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1006 NNN=1,KV3
AKX = VX(NNN)
AKY = VY(NNN)
AKZ = VZ(NNN)
IIBA = IBA(NNN)
C
DO 7500 J =1,IIBA
QX(J)=AKX+GX(NBASE(J,NNN))
QY(J)=AKY+GY(NBASE(J,NNN))
QZ(J)=AKZ+GZ(NBASE(J,NNN))
QA1(J)=0.5D0*(2.0D0*QZ(J)*QZ(J)-QX(J)*QX(J)-QY(J)*QY(J))
QA2(J)=0.5D0*CO1*(QX(J)*QX(J)-QY(J)*QY(J))
QA3(J)=CO1*QX(J)*QY(J)
QA4(J)=CO1*QX(J)*QZ(J)
QA5(J)=CO1*QY(J)*QZ(J)
AK2(J) = SQRT( QX(J)**2 + QY(J)**2 + QZ(J)**2 )
7500 CONTINUE
C REWIND 15
DO 7300 ITY=1,KTYP
C ATTN] IL=1,4 (S,P ONLY)
DO 7311 KN=1,KNG1
SSS(KN,NNN,ITY,1)=0.0D0
SSS(KN,NNN,ITY,2)=0.0D0
SSS(KN,NNN,ITY,3)=0.0D0
SSS(KN,NNN,ITY,4)=0.0D0
SS2(KN,NNN,ITY,1)=0.0D0
SS2(KN,NNN,ITY,2)=0.0D0
SS2(KN,NNN,ITY,3)=0.0D0
SS2(KN,NNN,ITY,4)=0.0D0
SS3(KN,NNN,ITY,1)=0.0D0
7311 CONTINUE
C
DO 7320 N=1,MESHR
R=RAD(N)
FACS= OMO(N)*WVS(N,ITY)*R**NSEK*SC*DX
FACP= OMO(N)*WVP(N,ITY)*R**NSEK*PC*DX
FAC1=-OMO(N)*WVS(N,ITY)*R**(NSEK+1)*SC*DX
FAC2= OMO(N)*WVP(N,ITY)*R**(NSEK+1)*PC*DX
DO 7777 KN=1,IIBA
X(KN)=AK2(KN)*R
7777 CONTINUE
CALL DSJNV(0,IIBA,X,Y1)
CALL DSJNV(1,IIBA,X,Y2)
CALL DSJNV(2,IIBA,X,Y3)
DO 7878 KN=1,IIBA
Y3(KN)=(Y1(KN)-2.0D0*Y3(KN))/3.0D0
7878 CONTINUE
DO 7330 KN=1,IIBA
C RKS(N)=$DMSJM(0,AK2(KN)*RAD(N))
SSS(KN,NNN,ITY,1) =SSS(KN,NNN,ITY,1) +FACS*Y1(KN)
SSS(KN,NNN,ITY,2) =SSS(KN,NNN,ITY,2)
& +FACP*Y2(KN)*QX(KN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,3) =SSS(KN,NNN,ITY,3)
& +FACP*Y2(KN)*QY(KN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,4) =SSS(KN,NNN,ITY,4)
& +FACP*Y2(KN)*QZ(KN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,1) =SS2(KN,NNN,ITY,1)+FAC1*Y2(KN)
SS2(KN,NNN,ITY,2) =SS2(KN,NNN,ITY,2)
& +FAC2*Y3(KN)*QX(KN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,3) =SS2(KN,NNN,ITY,3)
& +FAC2*Y3(KN)*QY(KN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,4) =SS2(KN,NNN,ITY,4)
& +FAC2*Y3(KN)*QZ(KN)*RAA(KN,NNN)
SS3(KN,NNN,ITY,1) =SS3(KN,NNN,ITY,1)+FACP*Y2(KN)
7330 CONTINUE
7320 CONTINUE
C
IF (NLSPD(ITY).EQ.2) THEN
C
DO 7314 KN=1,KNG1
SSS(KN,NNN,ITY,5)=0.0D0
SSS(KN,NNN,ITY,6)=0.0D0
SSS(KN,NNN,ITY,7)=0.0D0
SSS(KN,NNN,ITY,8)=0.0D0
SSS(KN,NNN,ITY,9)=0.0D0
SSS(KN,NNN,ITY,10)=0.0D0
SS2(KN,NNN,ITY,5)=0.0D0
SS2(KN,NNN,ITY,6)=0.0D0
SS2(KN,NNN,ITY,7)=0.0D0
SS2(KN,NNN,ITY,8)=0.0D0
SS2(KN,NNN,ITY,9)=0.0D0
SS3(KN,NNN,ITY,2)=0.0D0
SS3(KN,NNN,ITY,3)=0.0D0
SS3(KN,NNN,ITY,4)=0.0D0
7314 CONTINUE
C
DO 7321 N=1,MESHR
R=RAD(N)
FACS= OMO(N)*WVS(N,ITY)*R**NSEK*SC*DX
FACP= OMO(N)*WVP(N,ITY)*R**NSEK*PC*DX
FACD= OMO(N)*WVD(N,ITY)*R**NSEK*DC*DX
FAC1=-OMO(N)*WVS(N,ITY)*R**(NSEK+1)*SC*DX
FAC2= OMO(N)*WVP(N,ITY)*R**(NSEK+1)*PC*DX
FAC3= OMO(N)*WVD(N,ITY)*R**(NSEK+1)*DC*DX
DO 8778 KN=1,IIBA
X(KN)=AK2(KN)*R
8778 CONTINUE
CALL DSJNV(0,IIBA,X,Y1)
CALL DSJNV(1,IIBA,X,Y2)
CALL DSJNV(2,IIBA,X,Y3)
CALL DSJNV(3,IIBA,X,Y4)
DO 7788 KN=1,IIBA
YD(KN)= Y3(KN)
Y3(KN)=(Y1(KN)-2.0D0*Y3(KN))/3.0D0
Y4(KN)=(2.0D0*Y2(KN)-3.0D0*Y4(KN))/5.0D0
7788 CONTINUE
DO 7331 KN=1,IIBA
C ATTN] FOR SSL2 (IN ISSP)
SSS(KN,NNN,ITY,5) =SSS(KN,NNN,ITY,5)
& +FACD*YD(KN)*QA1(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,6) =SSS(KN,NNN,ITY,6)
& +FACD*YD(KN)*QA2(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,7) =SSS(KN,NNN,ITY,7)
& +FACD*YD(KN)*QA3(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,8) =SSS(KN,NNN,ITY,8)
& +FACD*YD(KN)*QA4(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,9) =SSS(KN,NNN,ITY,9)
& +FACD*YD(KN)*QA5(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SSS(KN,NNN,ITY,10)=SSS(KN,NNN,ITY,10)+FACD*YD(KN)
SS2(KN,NNN,ITY,5)=SS2(KN,NNN,ITY,5)
& +FAC3*Y4(KN)*QA1(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,6)=SS2(KN,NNN,ITY,6)
& +FAC3*Y4(KN)*QA2(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,7)=SS2(KN,NNN,ITY,7)
& +FAC3*Y4(KN)*QA3(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,8)=SS2(KN,NNN,ITY,8)
& +FAC3*Y4(KN)*QA4(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SS2(KN,NNN,ITY,9)=SS2(KN,NNN,ITY,9)
& +FAC3*Y4(KN)*QA5(KN)*RAA(KN,NNN)*RAA(KN,NNN)
SS3(KN,NNN,ITY,2)=SS3(KN,NNN,ITY,2)+CO1*FACD*QX(KN)*YD(KN)
& *RAA(KN,NNN)
SS3(KN,NNN,ITY,3)=SS3(KN,NNN,ITY,3)+CO1*FACD*QY(KN)*YD(KN)
& *RAA(KN,NNN)
SS3(KN,NNN,ITY,4)=SS3(KN,NNN,ITY,4)+CO1*FACD*QZ(KN)*YD(KN)
& *RAA(KN,NNN)
7331 CONTINUE
7321 CONTINUE
END IF
7300 CONTINUE
1006 CONTINUE
!XOCL END SPREAD
C!XOCL END PARALLEL
RETURN
END