C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
SUBROUTINE STRNL(ETOT1)
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
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),ZZZ(KNG1,KEG,KNV3)
& ,ZFC(KEG,KNV3,KATM,10),ZFC2(KEG,KNV3,KATM,6)
& ,OCCUU(KEG,KNV3),RAA(KNG1,KNV3)
!XOCL LOCAL SSS(:,/IP,:,:),SS2(:,/IP,:,:),SS3(:,/IP,:)
!XOCL LOCAL ZZZ(:,:,/IP),ZFC(:,/IP,:,:),ZFC2(:,/IP,:,:)
!XOCL LOCAL OCCUU(:,/IP),RAA(:,/IP)
EQUIVALENCE (SNL,SSS),(SNL2,SS2),(SNL3,SS3),(ZAJ,ZZZ)
& ,(ZFBB,ZFC),(ZFBB2,ZFC2),(OCCUP,OCCUU)
& ,(RAK,RAA)
C STRESS CALCULATION FOR NON-LOCAL PSEUDOPOTENTIAL PART
KSTR=KEG*KNV3*KATM*6
CCC =2.D0*RVOL/(2.D0*PAI)**3/FLOAT(KV3)
RUNI=2.0D0*CCC
DO 1003 IS=1,6
SIGNL(IS)=0.0D0
1003 CONTINUE
C VPP-PARALLEL START 1
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1901 IK=1,KV3
DO 1002 IBAN=NBD1,NBD2
DO 1902 IA=1,KATM
ZFC2(IBAN,IK,IA,1)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,2)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,3)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,4)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,5)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,6)=DCMPLX(0.0D0,0.0D0)
1902 CONTINUE
1002 CONTINUE
1901 CONTINUE
!XOCL END SPREAD
C!XOCL END PARALLEL
C
C VPP-PARALLEL 2
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1010 IK=1,KV3
DO 1000 IA=1,KATM
RWS =WS(KFTYPE(IA))*UNIVOL
RWP =WP(KFTYPE(IA))*UNIVOL
CWL(1)= RWS
CWL(2)= RWP
CWL(3)= RWP
CWL(4)= RWP
IF (NLSPD(KFTYPE(IA)).EQ.1) THEN
LNUM = 4
ELSE
LNUM = 9
RWD =WD(KFTYPE(IA))*UNIVOL
CWL(5)= RWD
CWL(6)= RWD
CWL(7)= RWD
CWL(8)= RWD
CWL(9)= RWD
END IF
C
DO 1022 L=1,LNUM
DO 1020 IBAN=NBD1,NBD2
CW=0.5D0*RUNI*OCCUU(IBAN,IK)
STMP=CW*CWL(L)*DREAL(DCONJG(ZFC(IBAN,IK,IA,L))
& *ZFC(IBAN,IK,IA,L))
SIGNL(1)=SIGNL(1)-STMP
SIGNL(4)=SIGNL(4)-STMP
SIGNL(6)=SIGNL(6)-STMP
1020 CONTINUE
1022 CONTINUE
1000 CONTINUE
1010 CONTINUE
!XOCL END SPREAD SUM(SIGNL)
C!XOCL END PARALLEL
SSS1=SIGNL(1)
SSS2=SIGNL(2)
SSS3=SIGNL(3)
SSS4=SIGNL(4)
SSS5=SIGNL(5)
SSS6=SIGNL(6)
WRITE (6,*) 'SIGNL 1 1 = ',SSS1
WRITE (6,*) ' 2 = ',SSS2
WRITE (6,*) ' 3 = ',SSS3
WRITE (6,*) ' 4 = ',SSS4
WRITE (6,*) ' 5 = ',SSS5
WRITE (6,*) ' 6 = ',SSS6
C
SK1=0.0D0
SK2=0.0D0
SK3=0.0D0
SK4=0.0D0
SK5=0.0D0
SK6=0.0D0
C VPP-PARALLEL START 3
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1110 IK=1,KV3
AKX = VX(IK)
AKY = VY(IK)
AKZ = VZ(IK)
DO 1100 IA=1,KATM
DO 1120 IBAN=NBD1,NBD2
CW=RUNI*OCCUU(IBAN,IK)
DO 1130 I=1,IBA(IK)
I1 = NBASE(I,IK)
ZTMP=ZZZ(I,IBAN,IK)*DCONJG(ZFM2(I1,IA))
& *SS2(I,IK,KFTYPE(IA),1)*RAA(I,IK)
ZFC2(IBAN,IK,IA,1)=ZFC2(IBAN,IK,IA,1)
& -ZTMP*(AKX+GX(I1))*(AKX+GX(I1))
ZFC2(IBAN,IK,IA,2)=ZFC2(IBAN,IK,IA,2)
& -ZTMP*(AKX+GX(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,3)=ZFC2(IBAN,IK,IA,3)
& -ZTMP*(AKX+GX(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,4)=ZFC2(IBAN,IK,IA,4)
& -ZTMP*(AKY+GY(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,5)=ZFC2(IBAN,IK,IA,5)
& -ZTMP*(AKY+GY(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,6)=ZFC2(IBAN,IK,IA,6)
& -ZTMP*(AKZ+GZ(I1))*(AKZ+GZ(I1))
1130 CONTINUE
SIGNL(1)=SIGNL(1)+CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG(ZFC(IBAN,IK,IA,1)) )
SIGNL(2)=SIGNL(2)+CW *DREAL(
& ZFC2(IBAN,IK,IA,2)*DCONJG(ZFC(IBAN,IK,IA,1)) )
SIGNL(3)=SIGNL(3)+CW *DREAL(
& ZFC2(IBAN,IK,IA,3)*DCONJG(ZFC(IBAN,IK,IA,1)) )
SIGNL(4)=SIGNL(4)+CW *DREAL(
& ZFC2(IBAN,IK,IA,4)*DCONJG(ZFC(IBAN,IK,IA,1)) )
SIGNL(5)=SIGNL(5)+CW *DREAL(
& ZFC2(IBAN,IK,IA,5)*DCONJG(ZFC(IBAN,IK,IA,1)) )
SIGNL(6)=SIGNL(6)+CW *DREAL(
& ZFC2(IBAN,IK,IA,6)*DCONJG(ZFC(IBAN,IK,IA,1)) )
1120 CONTINUE
1100 CONTINUE
1110 CONTINUE
!XOCL END SPREAD SUM(SIGNL)
C!XOCL END PARALLEL
TTT1=SIGNL(1)-SSS1
TTT2=SIGNL(2)-SSS2
TTT3=SIGNL(3)-SSS3
TTT4=SIGNL(4)-SSS4
TTT5=SIGNL(5)-SSS5
TTT6=SIGNL(6)-SSS6
SSS1=SIGNL(1)
SSS2=SIGNL(2)
SSS3=SIGNL(3)
SSS4=SIGNL(4)
SSS5=SIGNL(5)
SSS6=SIGNL(6)
WRITE (6,*) 'SIGNL 2 1 = ',TTT1
WRITE (6,*) ' 2 = ',TTT2
WRITE (6,*) ' 3 = ',TTT3
WRITE (6,*) ' 4 = ',TTT4
WRITE (6,*) ' 5 = ',TTT5
WRITE (6,*) ' 6 = ',TTT6
C 4
DO 1300 L =2,9
C VPP-PARALLEL START 4
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1912 IK=1,KV3
DO 1913 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.4)
& GO TO 1913
DO 1911 IBAN=NBD1,NBD2
ZFC2(IBAN,IK,IA,1)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,2)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,3)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,4)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,5)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,6)=DCMPLX(0.0D0,0.0D0)
1911 CONTINUE
1913 CONTINUE
1912 CONTINUE
!XOCL END SPREAD
C!XOCL END PARALLEL
C
C VPP-PARALLEL START 5
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1320 IK=1,KV3
AKX = VX(IK)
AKY = VY(IK)
AKZ = VZ(IK)
DO 1310 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.4)
& GO TO 1310
DO 1330 IBAN=NBD1,NBD2
CW=RUNI*OCCUU(IBAN,IK)
DO 1340 I=1,IBA(IK)
I1 = NBASE(I,IK)
ZTMP=ZZZ(I,IBAN,IK)*DCONJG(ZFM2(I1,IA))
& *( SS2(I,IK,KFTYPE(IA),L) )*RAA(I,IK)
ZFC2(IBAN,IK,IA,1)=ZFC2(IBAN,IK,IA,1)-ZTMP
& *(AKX+GX(I1))*(AKX+GX(I1))
ZFC2(IBAN,IK,IA,2)=ZFC2(IBAN,IK,IA,2)-ZTMP
& *(AKX+GX(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,3)=ZFC2(IBAN,IK,IA,3)-ZTMP
& *(AKX+GX(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,4)=ZFC2(IBAN,IK,IA,4)-ZTMP
& *(AKY+GY(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,5)=ZFC2(IBAN,IK,IA,5)-ZTMP
& *(AKY+GY(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,6)=ZFC2(IBAN,IK,IA,6)-ZTMP
& *(AKZ+GZ(I1))*(AKZ+GZ(I1))
1340 CONTINUE
SIGNL(1)=SIGNL(1)+CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG( ZFC(IBAN,IK,IA,L)) )
SIGNL(2)=SIGNL(2)+CW *DREAL(
& ZFC2(IBAN,IK,IA,2)*DCONJG( ZFC(IBAN,IK,IA,L)) )
SIGNL(3)=SIGNL(3)+CW *DREAL(
& ZFC2(IBAN,IK,IA,3)*DCONJG( ZFC(IBAN,IK,IA,L)) )
SIGNL(4)=SIGNL(4)+CW *DREAL(
& ZFC2(IBAN,IK,IA,4)*DCONJG( ZFC(IBAN,IK,IA,L)) )
SIGNL(5)=SIGNL(5)+CW *DREAL(
& ZFC2(IBAN,IK,IA,5)*DCONJG( ZFC(IBAN,IK,IA,L)) )
SIGNL(6)=SIGNL(6)+CW *DREAL(
& ZFC2(IBAN,IK,IA,6)*DCONJG( ZFC(IBAN,IK,IA,L)) )
1330 CONTINUE
1310 CONTINUE
1320 CONTINUE
!XOCL END SPREAD SUM(SIGNL)
C!XOCL END PARALLEL
1300 CONTINUE
TTT1=SIGNL(1)-SSS1
TTT2=SIGNL(2)-SSS2
TTT3=SIGNL(3)-SSS3
TTT4=SIGNL(4)-SSS4
TTT5=SIGNL(5)-SSS5
TTT6=SIGNL(6)-SSS6
SSS1=SIGNL(1)
SSS2=SIGNL(2)
SSS3=SIGNL(3)
SSS4=SIGNL(4)
SSS5=SIGNL(5)
SSS6=SIGNL(6)
WRITE (6,*) 'SIGNL 3 1 = ',TTT1
WRITE (6,*) ' 2 = ',TTT2
WRITE (6,*) ' 3 = ',TTT3
WRITE (6,*) ' 4 = ',TTT4
WRITE (6,*) ' 5 = ',TTT5
WRITE (6,*) ' 6 = ',TTT6
CWL(1)=1.0D0
CWL(2)=1.0D0
CWL(3)=1.0D0
CWL(4)=1.0D0
CWL(5)=2.0D0
CWL(6)=2.0D0
CWL(7)=2.0D0
CWL(8)=2.0D0
CWL(9)=2.0D0
CWL(10)=1.0D0
C 4
DO 1400 L=2,10
C VPP-PARALLEL START 6
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1922 IK=1,KV3
DO 1923 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.4)
& GO TO 1923
DO 1921 IBAN=NBD1,NBD2
ZFC2(IBAN,IK,IA,1)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,2)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,3)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,4)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,5)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,6)=DCMPLX(0.0D0,0.0D0)
1921 CONTINUE
1923 CONTINUE
1922 CONTINUE
!XOCL END SPREAD
C!XOCL END PARALLEL
C
C VPP-PARALLEL START 7
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1420 IK=1,KV3
AKX = VX(IK)
AKY = VY(IK)
AKZ = VZ(IK)
DO 1410 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.4)
& GO TO 1410
DO 1430 IBAN=NBD1,NBD2
CW=CWL(L)*RUNI*OCCUU(IBAN,IK)
DO 1440 I=1,IBA(IK)
I1 = NBASE(I,IK)
ZTMP=ZZZ(I,IBAN,IK)*DCONJG(ZFM2(I1,IA))
& *SSS(I,IK,KFTYPE(IA),L)*RAA(I,IK)*RAA(I,IK)
ZFC2(IBAN,IK,IA,1)=ZFC2(IBAN,IK,IA,1)+ZTMP
& *(AKX+GX(I1))*(AKX+GX(I1))
ZFC2(IBAN,IK,IA,2)=ZFC2(IBAN,IK,IA,2)+ZTMP
& *(AKX+GX(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,3)=ZFC2(IBAN,IK,IA,3)+ZTMP
& *(AKX+GX(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,4)=ZFC2(IBAN,IK,IA,4)+ZTMP
& *(AKY+GY(I1))*(AKY+GY(I1))
ZFC2(IBAN,IK,IA,5)=ZFC2(IBAN,IK,IA,5)+ZTMP
& *(AKY+GY(I1))*(AKZ+GZ(I1))
ZFC2(IBAN,IK,IA,6)=ZFC2(IBAN,IK,IA,6)+ZTMP
& *(AKZ+GZ(I1))*(AKZ+GZ(I1))
1440 CONTINUE
SIGNL(1)=SIGNL(1)+CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG(ZFC(IBAN,IK,IA,L)) )
SIGNL(2)=SIGNL(2)+CW *DREAL(
& ZFC2(IBAN,IK,IA,2)*DCONJG(ZFC(IBAN,IK,IA,L)) )
SIGNL(3)=SIGNL(3)+CW *DREAL(
& ZFC2(IBAN,IK,IA,3)*DCONJG(ZFC(IBAN,IK,IA,L)) )
SIGNL(4)=SIGNL(4)+CW *DREAL(
& ZFC2(IBAN,IK,IA,4)*DCONJG(ZFC(IBAN,IK,IA,L)) )
SIGNL(5)=SIGNL(5)+CW *DREAL(
& ZFC2(IBAN,IK,IA,5)*DCONJG(ZFC(IBAN,IK,IA,L)) )
SIGNL(6)=SIGNL(6)+CW *DREAL(
& ZFC2(IBAN,IK,IA,6)*DCONJG(ZFC(IBAN,IK,IA,L)) )
1430 CONTINUE
1410 CONTINUE
1420 CONTINUE
!XOCL END SPREAD SUM(SIGNL)
C!XOCL END PARALLEL
1400 CONTINUE
TTT1=SIGNL(1)-SSS1
TTT2=SIGNL(2)-SSS2
TTT3=SIGNL(3)-SSS3
TTT4=SIGNL(4)-SSS4
TTT5=SIGNL(5)-SSS5
TTT6=SIGNL(6)-SSS6
SSS1=SIGNL(1)
SSS2=SIGNL(2)
SSS3=SIGNL(3)
SSS4=SIGNL(4)
SSS5=SIGNL(5)
SSS6=SIGNL(6)
WRITE (6,*) 'SIGNL 4 1 = ',TTT1
WRITE (6,*) ' 2 = ',TTT2
WRITE (6,*) ' 3 = ',TTT3
WRITE (6,*) ' 4 = ',TTT4
WRITE (6,*) ' 5 = ',TTT5
WRITE (6,*) ' 6 = ',TTT6
C 1
DO 2331 L=1,4
C VPP-PARALLEL START 8
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1942 IK=1,KV3
DO 1943 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.1)
& GO TO 1943
DO 1941 IBAN=NBD1,NBD2
ZFC2(IBAN,IK,IA,1)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,2)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,3)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,4)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,5)=DCMPLX(0.0D0,0.0D0)
ZFC2(IBAN,IK,IA,6)=DCMPLX(0.0D0,0.0D0)
1941 CONTINUE
1943 CONTINUE
1942 CONTINUE
!XOCL END SPREAD
C!XOCL END PARALLEL
C
C VPP-PARALLEL START 9
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
DO 1520 IK=1,KV3
C IWRT(IK) =IK
AKX = VX(IK)
AKY = VY(IK)
AKZ = VZ(IK)
DO 1510 IA=1,KATM
IF (NLSPD(KFTYPE(IA)).EQ.1 .AND. L.GT.1)
& GO TO 1510
IF (L.EQ.1) THEN
RWC=1.0D0/(WP(KFTYPE(IA))*UNIVOL)
ELSE
RWC=1.0D0/(WD(KFTYPE(IA))*UNIVOL)
END IF
DO 1530 IBAN=NBD1,NBD2
CW=RUNI*OCCUU(IBAN,IK)
DO 1540 I=1,IBA(IK)
I1 = NBASE(I,IK)
ZTMP=DCONJG(ZZZ(I,IBAN,IK))*ZFM2(I1,IA)
& *SS3(I,IK,KFTYPE(IA),L)*RAA(I,IK)
ZFC2(IBAN,IK,IA,1)=ZFC2(IBAN,IK,IA,1)-ZTMP
& *(AKX+GX(I1))
ZFC2(IBAN,IK,IA,2)=ZFC2(IBAN,IK,IA,2)-ZTMP
& *(AKY+GY(I1))
ZFC2(IBAN,IK,IA,3)=ZFC2(IBAN,IK,IA,3)-ZTMP
& *(AKZ+GZ(I1))
1540 CONTINUE
SIGNL(1)=SIGNL(1)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG(ZFC2(IBAN,IK,IA,1)) )
SIGNL(2)=SIGNL(2)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG(ZFC2(IBAN,IK,IA,2)) )
SIGNL(3)=SIGNL(3)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,1)*DCONJG(ZFC2(IBAN,IK,IA,3)) )
SIGNL(4)=SIGNL(4)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,2)*DCONJG(ZFC2(IBAN,IK,IA,2)) )
SIGNL(5)=SIGNL(5)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,2)*DCONJG(ZFC2(IBAN,IK,IA,3)) )
SIGNL(6)=SIGNL(6)-RWC*CW *DREAL(
& ZFC2(IBAN,IK,IA,3)*DCONJG(ZFC2(IBAN,IK,IA,3)) )
1530 CONTINUE
1510 CONTINUE
1520 CONTINUE
!XOCL END SPREAD SUM(SIGNL)
C!XOCL END PARALLEL
2331 CONTINUE
TTT1=SIGNL(1)-SSS1
TTT2=SIGNL(2)-SSS2
TTT3=SIGNL(3)-SSS3
TTT4=SIGNL(4)-SSS4
TTT5=SIGNL(5)-SSS5
TTT6=SIGNL(6)-SSS6
SSS1=SIGNL(1)
SSS2=SIGNL(2)
SSS3=SIGNL(3)
SSS4=SIGNL(4)
SSS5=SIGNL(5)
SSS6=SIGNL(6)
WRITE (6,*) 'SIGNL 5 1 = ',TTT1
WRITE (6,*) ' 2 = ',TTT2
WRITE (6,*) ' 3 = ',TTT3
WRITE (6,*) ' 4 = ',TTT4
WRITE (6,*) ' 5 = ',TTT5
WRITE (6,*) ' 6 = ',TTT6
RETURN
END