C CHOLE3    SOURCE    PV        13/10/23    21:15:04     7848           
      SUBROUTINE CHOLE3(IPREL,IDERL,IPPV,IPPR,IDDR,IVPO,                        
     # IPPVV1,VAL,VAL1,IVPO1,imasq,prec)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCHOLE
      DIMENSION IPPV(1),IVPO(1),IPPVV1(1),VAL(1),VAL1(1),IVPO1(1)               
      dimension imasq(1)
      IDD2=IPPV(1)                                                              
      DO 10 J=IPREL,IDERL                                                       
       JID=J-IPREL+1                                                            
       IDD3=IPPV(JID+1)                                                         
       N2=IDD3-IDD2                                                             
       KD2=J-N2+1                                                               
       N2J=IDD3-J                                                               
       KIDEP=IVPO(JID)                                                          
       IBABA=MAX(IPPR,KD2+1)                                                    
       IF (IBABA.GT.IDDR) GOTO 30                                               
       IDEB4=2*IPPVV1(IBABA-IPPR+1)                                             
       IDD=IVPO1(IDEB4-1)                                                       
       DO 20 JHY=IBABA,IDDR                                                     
        ILM=JHY-IPPR+1                                                          
        IDEB3=2*IPPVV1(ILM+1)                                                   
        NNJJ=IVPO1(IDEB3-1)                                                     
        N=NNJJ-IDD                                                              
        KD1=1+JHY-N                                                             
        IDEP=MAX(KD2,KD1)                                                       
        LLOL=JHY-IDEP                                                           
        I1=JHY+N2J                                                              
        LLON=LLOL-I1+KIDEP+1                                                    
*  on compare a la diagonale de la colonne
        DNORM=ABS(VAL1(IVPO1(IDEB3)-1))*PREC
        IF (LLON.GT.0) THEN                                                     
         p=0.D0
         IPOSM=N-LLOL+IDD-2                                                     
         IPLAC2=N2J+IDEP-1                                                      
         idebzc=ivpo1(ideb3)
         DO 2 IDEB2=IDEB3,IDEB4+2,-2
          IAUX=IVPO1(IDEB2-3)-IPOSM                                             
          IPLAC=IVPO1(IDEB2-2)-IAUX                                             
          IFINZ=MIN(IDEBZC-1,LLON+IPLAC)                                        
          IDEBZC=MAX(1,IAUX)+IPLAC                                              
          IPLAC3=IPLAC2-IPLAC                                                   
          lond=ifinz-idebzc+1
        if (lond.GT.0) then
        ideq=IDEBZC+IPLAC3
        if (IFINZ-IDEBZC.GT.masdim) then
        if (-imasq(ideq/masdim+1).le.ideq+lond-1)
     >  p=p+ddotpw(lond,VAL(ideq),VAL1(IDEBZC),
     >      imasq(1),ideq)
        else
         if (imasq(ideq/masdim+1).gt.0.or.
     >       imasq((ifinz+iplac3)/masdim+1).gt.0)
     >  p=p+ddotpv(lond,VAL(ideq),VAL1(IDEBZC))
        endif
        endif
          IF (IAUX.LE.1) GOTO 3                                                 
   2     CONTINUE                                                               
   3     CONTINUE                                                               
         if (abs(p).LT.dnorm.and.imasq(i1/masdim+1).le.0) goto 5
         VAL(I1)=VAL(I1)-P
        ENDIF                                                                   
        IF (ABS(VAL(I1)).GT.DNORM) then
          if (imasq(i1/masdim+1).le.0) imasq(i1/masdim+1)=1
          KIDEP=I1
        endif
   5    continue
        IDEB4=IDEB3                                                             
        IDD=NNJJ                                                                
  20   CONTINUE                                                                 
       IVPO(JID)=KIDEP                                                          
  30   CONTINUE                                                                 
       IDD2=IDD3                                                                
  10  CONTINUE                                                                  
      RETURN                                                                    
      END