C^^^^^1992 1/7 FOR STRESS ^^^^^^^^^^^  5/1, 2009
      SUBROUTINE FORZFB                                                 
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                                   
      IMPLICIT REAL(A-H,O-Y)                                          
      IMPLICIT COMPLEX(Z)                                            
      INCLUDE 'PACVPP'                                                  
!$OMP THREADPRIVATE( /PSSNL/, /ZAJEKO/ )
C
C     OEPNMP 4/17, 2009
C 
C      WRITE (6,*) 'OPENMP START IN FORZFB'
C
!$OMP PARALLEL DEFAULT(NONE) 
!$OMP& COPYIN( SNL, ZAJ )
!$OMP& PRIVATE(IIBA,CS,CP,CD,LNUM,I1,ZTMP)
!$OMP& SHARED( ZFBB,KV3,NBD1,NBD2,
!$OMP&  IBA,NBASE,
!$OMP&  UNIVOL,WS,WP,WD,
!$OMP&  ZFM2,KFTYPE,
!$OMP&  NLSPD )
!$OMP DO
      DO 2100 IK=1,KV3                                                  
      IIBA = IBA(IK)
C      WRITE (6,*) 'CHECK FORZFB IK,KATM = ',IK,KATM,KV3,IIBA
      DO 2110 IA=1,KATM                                                 
      CS=1.0D0/(WS(KFTYPE(IA))*UNIVOL)                                  
      CP=1.0D0/(WP(KFTYPE(IA))*UNIVOL)                                  
      CWL(1)=CS
      CWL(2)=CP
      CWL(3)=CP
      CWL(4)=CP
C
      IF (NLSPD(KFTYPE(IA)).EQ.1) THEN
          LNUM = 4
      ELSE
          LNUM = 10
          CD=1.0D0/(WD(KFTYPE(IA))*UNIVOL)
          CWL(5)=CD
          CWL(6)=CD
          CWL(7)=CD
          CWL(8)=CD
          CWL(9)=CD
          CWL(10)=CD
      END IF
      DO 3222 L=1,LNUM
      DO 3200 IBAN=NBD1,NBD2                                            
      ZFBB(IBAN,IK,IA,L) =DCMPLX(0.0D0,0.0D0)                            
C     1991 11/28  I ---> I1, LNUM = 10(DEBUG, 7/18, 2001)
      DO 3510 I=1,IIBA
C      I1  = NBASE(I,IK)
      ZTMP=ZAJ(I,IBAN,IK)*DCONJG( ZFM2( NBASE(I,IK) ,IA ) )
      ZFBB(IBAN,IK,IA,L)=ZFBB(IBAN,IK,IA,L)+
     &                  ZTMP*SNL(I,IK,KFTYPE(IA),L)
 3510 CONTINUE                                                          
      ZFBB(IBAN,IK,IA,L)=CWL(L)*ZFBB(IBAN,IK,IA,L)                            
 3200 CONTINUE                                                          
 3222 CONTINUE
C
 2110 CONTINUE                                                          
C      WRITE (6,*) 'CHECK POINT LNUM,CS,CP,CD = ',LNUM,CS,CP,CD
 2100 CONTINUE                                                          
!$OMP END DO
!$OMP END PARALLEL
C
C      WRITE (6,*) 'OPENMP END IN FORZFB'
C
!XOCL END SPREAD
C!XOCL END PARALLEL
C                                                                       
      RETURN                                                            
      END