C^^^^^1992 1/7 FOR STRESS ^^^^^^^^^^^                                   
      SUBROUTINE FORZFB 
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)
     &         ,ZZZ(KNG1,KEG,KNV3),ZFC(KEG,KNV3,KATM,10) 
!XOCL LOCAL SSS(:,/IP,:,:),ZZZ(:,:,/IP),ZFC(:,/IP,:,:) 
      EQUIVALENCE (SNL,SSS),(ZAJ,ZZZ),(ZFBB,ZFC) 
C                                                                       
cGEN
      DIMENSION CWLNEW(10)
cGEN 
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP 
      DO 1000 IA=1,KATM                                                 
      IF (NLSPD(KFTYPE(IA)).EQ.1) THEN
          LNUM = 4
      ELSE
          LNUM = 9
      END IF
      DO 1003 L=1,LNUM
cGEN
*pdir pardo 
      DO 1001 IK=1,KV3                                                  
      DO 1002 IBAN=NBD1,NBD2                                            
      ZFC(IBAN,IK,IA,L) =DCMPLX(0.0D0,0.0D0)                            
 1002 CONTINUE                                                          
 1001 CONTINUE                                                          
 1003 CONTINUE
 1000 CONTINUE                                                          
!XOCL END SPREAD 
C!XOCL END PARALLEL
C     VPP-PARALLEL START
C!XOCL PARALLEL REGION 
!XOCL SPREAD DO /IP 
cGEN
*pdir pardo 
      DO 2100 IK=1,KV3                                                  
      DO 2110 IA=1,KATM
      CS=1.0D0/(WS(KFTYPE(IA))*UNIVOL)                                  
      CP=1.0D0/(WP(KFTYPE(IA))*UNIVOL)                                  
      CWLNEW(1)=CS
      CWLNEW(2)=CP
      CWLNEW(3)=CP
      CWLNEW(4)=CP 
C
      IF (NLSPD(KFTYPE(IA)).EQ.1) THEN
          LNUM = 4
      ELSE
          LNUM = 9
          CD=1.0D0/(WD(KFTYPE(IA))*UNIVOL)
          CWLNEW(5)=CD
          CWLNEW(6)=CD
          CWLNEW(7)=CD
          CWLNEW(8)=CD
          CWLNEW(9)=CD 
      END IF
      DO 3222 L=1,LNUM
      DO 3200 IBAN=NBD1,NBD2                                            
C     1991 11/28  I ---> I1                                             
      DO 3510 I=1,IBA(IK)
      I1  = NBASE(I,IK)                                                 
      L1  = IG1(I1)+KX1                                                 
      L2  = IG2(I1)+KY1                                                 
      L3  = IG3(I1)+KZ1                                                 
      ZTMP=ZZZ(I,IBAN,IK)*DCONJG( ZFM2( I1 ,IA ) )                     
      ZFC(IBAN,IK,IA,L)=ZFC(IBAN,IK,IA,L)+
     &                  ZTMP*SSS(I,IK,KFTYPE(IA),L)
 3510 CONTINUE 
      ZFC(IBAN,IK,IA,L)=CWLNEW(L)*ZFC(IBAN,IK,IA,L)
 3200 CONTINUE
 3222 CONTINUE 
C
 2110 CONTINUE 
 2100 CONTINUE                                                          
!XOCL END SPREAD 
C!XOCL END PARALLEL
C 
      RETURN
      END