C MONDE2    SOURCE    PV        20/09/29    21:15:12     10725          
      SUBROUTINE MONDE2(ITTRV,IPPVV,VECTBB,VAL,IVPO,
     >  NA,IPREL,MULRE,INC,IVS,LLOM,dnorm)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION ITTRV(*),IPPVV(*),VECTBB(*),VAL(*),IVPO(*)
      IDEB2=IPPVV(1)*2
      nbg=ippvv(2)-1
      ifib=2*nbg*na
      IMOI2= IVPO(IDEB2-1)
      DO 50 ILM=1,NA
       II=IPREL+ILM-1
       IDEB22=2*IPPVV(ILM+1)
       IMOI1= IVPO(IDEB22-1)
       LLOM=IMOI1-IMOI2-1
       IF (LLOM.GT.0) THEN
        IPOSM=IMOI2-1
        DO 20 K=1,MULRE
        IPLAC=IVPO(IDEB2)-1
        IDEBZ=1
         J=II+(K-1)*INC
         IPLAC2=J-LLOM-1
         IF (ITTRV(K).LE.IVS) THEN
          P=0.D0
          DO 2 IDEB3=IDEB2,IFIB,2
           IMOI=IVPO(IDEB3+2)
           ILONZ=IMOI-IPLAC-IDEBZ
           IDEBZC=IDEBZ+IPLAC2
           IPLAC=IPLAC-IPLAC2
**         DO 1 ISD=IDEBZC,MIN(IDEBZC+ILONZ,J)-1
**          P = P + VECTBB(ISD) * VAL(IPLAC+ISD)
** 1       CONTINUE
            P=P+DDOTPV(MIN(IDEBZC+ILONZ,J)-IDEBZC,
     #      VECTBB(IDEBZC),VAL(IPLAC+IDEBZC))
           IF (IDEBZ.GE.LLOM) GOTO 3
           IDEBZ=IVPO(IDEB3+1)-IPOSM
           IPLAC=IMOI-IDEBZ
   2      CONTINUE
   3      CONTINUE
          VECTBB(J)=VECTBB(J)-P
          if (abs(vectbb(j)).lt.dnorm) vectbb(j)=0.d0
         ENDIF
  20    CONTINUE
       ENDIF
       IMOI2=IMOI1
       IDEB2=IDEB22
  50  CONTINUE
      RETURN
      END