C---*----1----*----2----*----3----*----4----*----5----*- 5/1, 2009 --7 SUBROUTINE FORCE(IREC8) C---*----1----*----2----*----3----*----4----*----5----*----6----*----7 IMPLICIT REAL(A-H,O-Y) IMPLICIT COMPLEX(Z) INCLUDE 'PACVPP' !$OMP THREADPRIVATE( /PSSNL/, /ZAJEKO/, /EIGENP/ ) C VPP-PARALLEL !XOCL SUBPROCESSOR PS(IPARA)=PQ(1:IPARA) !XOCL INDEX PARTITION IP=(PS,INDEX=1:KNV3,PART=BAND) C DIMENSION SSS(KNG1,KNV3,KTYP,10) C & ,ZZZ(KNG1,KEG,KNV3),ZFC(KEG,KNV3,KATM,10) C & ,OCCUU(KEG,KNV3) !XOCL LOCAL SSS(:,/IP,:,:),ZZZ(:,:,/IP),ZFC(:,/IP,:,:) !XOCL LOCAL OCCUU(:,/IP) C EQUIVALENCE (SNL,SSS),(ZAJ,ZZZ),(ZFBB,ZFC) C & ,(OCCUP,OCCUU) DIMENSION ZFX1(KEG),ZFX2(KEG),ZFX3(KEG),ZFX4(KEG) DIMENSION ZFY1(KEG),ZFY2(KEG),ZFY3(KEG),ZFY4(KEG) DIMENSION ZFZ1(KEG),ZFZ2(KEG),ZFZ3(KEG),ZFZ4(KEG) DIMENSION ZFB1(KEG),ZFB2(KEG),ZFB3(KEG),ZFB4(KEG) C DIMENSION ZFX5(KEG),ZFX6(KEG),ZFX7(KEG),ZFX8(KEG),ZFX9(KEG) DIMENSION ZFY5(KEG),ZFY6(KEG),ZFY7(KEG),ZFY8(KEG),ZFY9(KEG) DIMENSION ZFZ5(KEG),ZFZ6(KEG),ZFZ7(KEG),ZFZ8(KEG),ZFZ9(KEG) DIMENSION ZFB5(KEG),ZFB6(KEG),ZFB7(KEG),ZFB8(KEG),ZFB9(KEG) DIMENSION ZFBA(KEG) C DO 1000 IA=1,KATM ZFORC2(IA,1)=DCMPLX(0.0D0,0.0D0) ZFORC2(IA,2)=DCMPLX(0.0D0,0.0D0) ZFORC2(IA,3)=DCMPLX(0.0D0,0.0D0) 1000 CONTINUE C VPP-PAEALLEL START C!XOCL PARALLEL REGION !XOCL SPREAD NOBARRIER DO /IP C C OPENMP 4/17, 2009 C WRITE (6,*) 'OPENMP START IN FORCE' C--!$OMP& FIRSTPRIVATE( KFT1,KFT2,KFT3,KSUM,KVOL, DTIM ) C--!$OMP& PRIVATE(NNN,IBAN,VKIN,AKX,AKY,AKZ,I,J,K,L,M, C--!$OMP& IIBA,ITY,CD,CS,CP,LNUM,TMPP,ZEV3C,ZC1D, C--!$OMP& I1,L1,L2,L3,ierr1,IA,ZTMP, C--!$OMP& ierr,ZPGG,WDI,ZROF,ZDEVC,EMAS,ESHI,ZNRM, C--!$OMP& IWL,IWM,IWN,IWORK, C--!$OMP& DENOM,JBAN,EE,ZTV,IV ) C !$OMP PARALLEL DEFAULT(PRIVATE) !$OMP& COPYIN( SNL, ZAJ, OCCUP ) !$OMP& SHARED( ZFBB,KV3,NBD1,NBD2, !$OMP& VX,VY,VZ,ZI,IBA,NBASE,IGF1,IGF2,IGF3, !$OMP& UNIVOL,WS,WP,WD,IATOM, !$OMP& ZFM2,KFTYPE,ZFORC2, !$OMP& GX,GY,GZ, NLSPD, ZV1D, ZVP ) !$OMP DO REDUCTION(+:ZFORC2) DO 2100 IK=1,KV3 WRITE (6,*) 'OPENMP: IK LOOP IN FORCE = ',IK IIBA = IBA(IK) C*******DO 1 IBAN=NBD1,NBD2 C IREC = KV3*(IBAN-1)+IK C IF (IREC8.NE.0) IREC=IREC8*IREC-IREC8+1 C READ(80,REC=IREC) ZV1 C DO 2 I=1,IIBA C ZEVC(I,IBAN) = ZV1(I) C 2 CONTINUE C***1 CONTINUE DO 2110 IA=1,KATM CS=1.0D0/(WS(KFTYPE(IA))*UNIVOL) CP=1.0D0/(WP(KFTYPE(IA))*UNIVOL) DO 2115 IBAN=NBD1,NBD2 ZFX1(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX2(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX3(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX4(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY1(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY2(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY3(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY4(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ1(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ2(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ3(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ4(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB1(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB2(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB3(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB4(IBAN)=DCMPLX(0.0D0,0.0D0) 2115 CONTINUE DO 2200 IBAN=NBD1,NBD2 DO 1510 I=1,IIBA I1=NBASE(I,IK) ZTMP=ZAJ(I,IBAN,IK)*DCONJG( ZFM2( I1 ,IA ) ) ZTMP1=ZTMP*SNL(I,IK,KFTYPE(IA),1) ZTMP2=ZTMP*SNL(I,IK,KFTYPE(IA),2) ZTMP3=ZTMP*SNL(I,IK,KFTYPE(IA),3) ZTMP4=ZTMP*SNL(I,IK,KFTYPE(IA),4) ZFB1(IBAN)=ZFB1(IBAN)+ZTMP1 ZFB2(IBAN)=ZFB2(IBAN)+ZTMP2 ZFB3(IBAN)=ZFB3(IBAN)+ZTMP3 ZFB4(IBAN)=ZFB4(IBAN)+ZTMP4 ZFX1(IBAN)=ZFX1(IBAN)+GX(I1)*ZTMP1 ZFX2(IBAN)=ZFX2(IBAN)+GX(I1)*ZTMP2 ZFX3(IBAN)=ZFX3(IBAN)+GX(I1)*ZTMP3 ZFX4(IBAN)=ZFX4(IBAN)+GX(I1)*ZTMP4 ZFY1(IBAN)=ZFY1(IBAN)+GY(I1)*ZTMP1 ZFY2(IBAN)=ZFY2(IBAN)+GY(I1)*ZTMP2 ZFY3(IBAN)=ZFY3(IBAN)+GY(I1)*ZTMP3 ZFY4(IBAN)=ZFY4(IBAN)+GY(I1)*ZTMP4 ZFZ1(IBAN)=ZFZ1(IBAN)+GZ(I1)*ZTMP1 ZFZ2(IBAN)=ZFZ2(IBAN)+GZ(I1)*ZTMP2 ZFZ3(IBAN)=ZFZ3(IBAN)+GZ(I1)*ZTMP3 ZFZ4(IBAN)=ZFZ4(IBAN)+GZ(I1)*ZTMP4 1510 CONTINUE 2200 CONTINUE DO 2205 IBAN=NBD1,NBD2 ZFBB(IBAN,IK,IA,1)=CS*ZFB1(IBAN) ZFBB(IBAN,IK,IA,2)=CP*ZFB2(IBAN) ZFBB(IBAN,IK,IA,3)=CP*ZFB3(IBAN) ZFBB(IBAN,IK,IA,4)=CP*ZFB4(IBAN) ZFORC2(IA,1)=ZFORC2(IA,1)+OCCUP(IBAN,IK)* & ( DCONJG(ZFX1(IBAN))*ZFBB(IBAN,IK,IA,1) & +DCONJG(ZFX2(IBAN))*ZFBB(IBAN,IK,IA,2) & +DCONJG(ZFX3(IBAN))*ZFBB(IBAN,IK,IA,3) & +DCONJG(ZFX4(IBAN))*ZFBB(IBAN,IK,IA,4) ) ZFORC2(IA,2)=ZFORC2(IA,2)+OCCUP(IBAN,IK)* & ( DCONJG(ZFY1(IBAN))*ZFBB(IBAN,IK,IA,1) & +DCONJG(ZFY2(IBAN))*ZFBB(IBAN,IK,IA,2) & +DCONJG(ZFY3(IBAN))*ZFBB(IBAN,IK,IA,3) & +DCONJG(ZFY4(IBAN))*ZFBB(IBAN,IK,IA,4) ) ZFORC2(IA,3)=ZFORC2(IA,3)+OCCUP(IBAN,IK)* & ( DCONJG(ZFZ1(IBAN))*ZFBB(IBAN,IK,IA,1) & +DCONJG(ZFZ2(IBAN))*ZFBB(IBAN,IK,IA,2) & +DCONJG(ZFZ3(IBAN))*ZFBB(IBAN,IK,IA,3) & +DCONJG(ZFZ4(IBAN))*ZFBB(IBAN,IK,IA,4) ) 2205 CONTINUE C IF (NLSPD(KFTYPE(IA)).EQ.2) THEN C CD=1.0D0/(WD(KFTYPE(IA))*UNIVOL) DO 2135 IBAN=NBD1,NBD2 ZFX5(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX6(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX7(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX8(IBAN)=DCMPLX(0.0D0,0.0D0) ZFX9(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY5(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY6(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY7(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY8(IBAN)=DCMPLX(0.0D0,0.0D0) ZFY9(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ5(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ6(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ7(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ8(IBAN)=DCMPLX(0.0D0,0.0D0) ZFZ9(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB5(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB6(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB7(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB8(IBAN)=DCMPLX(0.0D0,0.0D0) ZFB9(IBAN)=DCMPLX(0.0D0,0.0D0) ZFBA(IBAN)=DCMPLX(0.0D0,0.0D0) 2135 CONTINUE DO 2230 IBAN=NBD1,NBD2 DO 1513 I=1,IIBA I1=NBASE(I,IK) ZTMP=ZAJ(I,IBAN,IK)*DCONJG( ZFM2( I1 ,IA ) ) ZTMP5=ZTMP*SNL(I,IK,KFTYPE(IA),5) ZTMP6=ZTMP*SNL(I,IK,KFTYPE(IA),6) ZTMP7=ZTMP*SNL(I,IK,KFTYPE(IA),7) ZTMP8=ZTMP*SNL(I,IK,KFTYPE(IA),8) ZTMP9=ZTMP*SNL(I,IK,KFTYPE(IA),9) ZTMPA=ZTMP*SNL(I,IK,KFTYPE(IA),10) ZFB5(IBAN)=ZFB5(IBAN)+ZTMP5 ZFB6(IBAN)=ZFB6(IBAN)+ZTMP6 ZFB7(IBAN)=ZFB7(IBAN)+ZTMP7 ZFB8(IBAN)=ZFB8(IBAN)+ZTMP8 ZFB9(IBAN)=ZFB9(IBAN)+ZTMP9 ZFBA(IBAN)=ZFBA(IBAN)+ZTMPA ZFX5(IBAN)=ZFX5(IBAN)+GX(I1)*ZTMP5 ZFX6(IBAN)=ZFX6(IBAN)+GX(I1)*ZTMP6 ZFX7(IBAN)=ZFX7(IBAN)+GX(I1)*ZTMP7 ZFX8(IBAN)=ZFX8(IBAN)+GX(I1)*ZTMP8 ZFX9(IBAN)=ZFX9(IBAN)+GX(I1)*ZTMP9 ZFY5(IBAN)=ZFY5(IBAN)+GY(I1)*ZTMP5 ZFY6(IBAN)=ZFY6(IBAN)+GY(I1)*ZTMP6 ZFY7(IBAN)=ZFY7(IBAN)+GY(I1)*ZTMP7 ZFY8(IBAN)=ZFY8(IBAN)+GY(I1)*ZTMP8 ZFY9(IBAN)=ZFY9(IBAN)+GY(I1)*ZTMP9 ZFZ5(IBAN)=ZFZ5(IBAN)+GZ(I1)*ZTMP5 ZFZ6(IBAN)=ZFZ6(IBAN)+GZ(I1)*ZTMP6 ZFZ7(IBAN)=ZFZ7(IBAN)+GZ(I1)*ZTMP7 ZFZ8(IBAN)=ZFZ8(IBAN)+GZ(I1)*ZTMP8 ZFZ9(IBAN)=ZFZ9(IBAN)+GZ(I1)*ZTMP9 1513 CONTINUE 2230 CONTINUE DO 2235 IBAN=NBD1,NBD2 ZFBB(IBAN,IK,IA,5)=CD*ZFB5(IBAN) ZFBB(IBAN,IK,IA,6)=CD*ZFB6(IBAN) ZFBB(IBAN,IK,IA,7)=CD*ZFB7(IBAN) ZFBB(IBAN,IK,IA,8)=CD*ZFB8(IBAN) ZFBB(IBAN,IK,IA,9)=CD*ZFB9(IBAN) ZFBB(IBAN,IK,IA,10)=CD*ZFBA(IBAN) ZFORC2(IA,1)=ZFORC2(IA,1)+OCCUP(IBAN,IK)* & ( DCONJG(ZFX5(IBAN))*ZFBB(IBAN,IK,IA,5) & +DCONJG(ZFX6(IBAN))*ZFBB(IBAN,IK,IA,6) & +DCONJG(ZFX7(IBAN))*ZFBB(IBAN,IK,IA,7) & +DCONJG(ZFX8(IBAN))*ZFBB(IBAN,IK,IA,8) & +DCONJG(ZFX9(IBAN))*ZFBB(IBAN,IK,IA,9) ) ZFORC2(IA,2)=ZFORC2(IA,2)+OCCUP(IBAN,IK)* & ( DCONJG(ZFY5(IBAN))*ZFBB(IBAN,IK,IA,5) & +DCONJG(ZFY6(IBAN))*ZFBB(IBAN,IK,IA,6) & +DCONJG(ZFY7(IBAN))*ZFBB(IBAN,IK,IA,7) & +DCONJG(ZFY8(IBAN))*ZFBB(IBAN,IK,IA,8) & +DCONJG(ZFY9(IBAN))*ZFBB(IBAN,IK,IA,9) ) ZFORC2(IA,3)=ZFORC2(IA,3)+OCCUP(IBAN,IK)* & ( DCONJG(ZFZ5(IBAN))*ZFBB(IBAN,IK,IA,5) & +DCONJG(ZFZ6(IBAN))*ZFBB(IBAN,IK,IA,6) & +DCONJG(ZFZ7(IBAN))*ZFBB(IBAN,IK,IA,7) & +DCONJG(ZFZ8(IBAN))*ZFBB(IBAN,IK,IA,8) & +DCONJG(ZFZ9(IBAN))*ZFBB(IBAN,IK,IA,9) ) 2235 CONTINUE END IF C 2110 CONTINUE 2100 CONTINUE !$OMP END DO !$OMP END PARALLEL C WRITE (6,*) 'OPENMP END IN FORCE' C !XOCL END SPREAD SUM(ZFORC2) C!XOCL END PARALLEL ZCCC = 4.D0*ZI*RVOL/(2.D0*PAI)**3/FLOAT(KV3) C--------------------------------------------------------- DO 1501 IA=1,KATM ZFORC2(IA,1)=ZCCC*DIMAG( ZFORC2(IA,1) ) ZFORC2(IA,2)=ZCCC*DIMAG( ZFORC2(IA,2) ) ZFORC2(IA,3)=ZCCC*DIMAG( ZFORC2(IA,3) ) 1501 CONTINUE 3000 FORMAT(I4,6F12.8) RETURN END