Esope source files

   1 : C CHOLE3    SOURCE    PV        13/10/23    21:15:04     7848           
   2 :       SUBROUTINE CHOLE3(IPREL,IDERL,IPPV,IPPR,IDDR,IVPO,                        
   3 :      # IPPVV1,VAL,VAL1,IVPO1,imasq,prec)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   6 : -INC CCHOLE
   7 :       DIMENSION IPPV(1),IVPO(1),IPPVV1(1),VAL(1),VAL1(1),IVPO1(1)               
   8 :       dimension imasq(1)
   9 :       IDD2=IPPV(1)                                                              
  10 :       DO 10 J=IPREL,IDERL                                                       
  11 :        JID=J-IPREL+1                                                            
  12 :        IDD3=IPPV(JID+1)                                                         
  13 :        N2=IDD3-IDD2                                                             
  14 :        KD2=J-N2+1                                                               
  15 :        N2J=IDD3-J                                                               
  16 :        KIDEP=IVPO(JID)                                                          
  17 :        IBABA=MAX(IPPR,KD2+1)                                                    
  18 :        IF (IBABA.GT.IDDR) GOTO 30                                               
  19 :        IDEB4=2*IPPVV1(IBABA-IPPR+1)                                             
  20 :        IDD=IVPO1(IDEB4-1)                                                       
  21 :        DO 20 JHY=IBABA,IDDR                                                     
  22 :         ILM=JHY-IPPR+1                                                          
  23 :         IDEB3=2*IPPVV1(ILM+1)                                                   
  24 :         NNJJ=IVPO1(IDEB3-1)                                                     
  25 :         N=NNJJ-IDD                                                              
  26 :         KD1=1+JHY-N                                                             
  27 :         IDEP=MAX(KD2,KD1)                                                       
  28 :         LLOL=JHY-IDEP                                                           
  29 :         I1=JHY+N2J                                                              
  30 :         LLON=LLOL-I1+KIDEP+1                                                    
  31 : *  on compare a la diagonale de la colonne
  32 :         DNORM=ABS(VAL1(IVPO1(IDEB3)-1))*PREC
  33 :         IF (LLON.GT.0) THEN                                                     
  34 :          p=0.D0
  35 :          IPOSM=N-LLOL+IDD-2                                                     
  36 :          IPLAC2=N2J+IDEP-1                                                      
  37 :          idebzc=ivpo1(ideb3)
  38 :          DO 2 IDEB2=IDEB3,IDEB4+2,-2
  39 :           IAUX=IVPO1(IDEB2-3)-IPOSM                                             
  40 :           IPLAC=IVPO1(IDEB2-2)-IAUX                                             
  41 :           IFINZ=MIN(IDEBZC-1,LLON+IPLAC)                                        
  42 :           IDEBZC=MAX(1,IAUX)+IPLAC                                              
  43 :           IPLAC3=IPLAC2-IPLAC                                                   
  44 :           lond=ifinz-idebzc+1
  45 :         if (lond.GT.0) then
  46 :         ideq=IDEBZC+IPLAC3
  47 :         if (IFINZ-IDEBZC.GT.masdim) then
  48 :         if (-imasq(ideq/masdim+1).le.ideq+lond-1)
  49 :      >  p=p+ddotpw(lond,VAL(ideq),VAL1(IDEBZC),
  50 :      >      imasq(1),ideq)
  51 :         else
  52 :          if (imasq(ideq/masdim+1).gt.0.or.
  53 :      >       imasq((ifinz+iplac3)/masdim+1).gt.0)
  54 :      >  p=p+ddotpv(lond,VAL(ideq),VAL1(IDEBZC))
  55 :         endif
  56 :         endif
  57 :           IF (IAUX.LE.1) GOTO 3                                                 
  58 :    2     CONTINUE                                                               
  59 :    3     CONTINUE                                                               
  60 :          if (abs(p).LT.dnorm.and.imasq(i1/masdim+1).le.0) goto 5
  61 :          VAL(I1)=VAL(I1)-P
  62 :         ENDIF                                                                   
  63 :         IF (ABS(VAL(I1)).GT.DNORM) then
  64 :           if (imasq(i1/masdim+1).le.0) imasq(i1/masdim+1)=1
  65 :           KIDEP=I1
  66 :         endif
  67 :    5    continue
  68 :         IDEB4=IDEB3                                                             
  69 :         IDD=NNJJ                                                                
  70 :   20   CONTINUE                                                                 
  71 :        IVPO(JID)=KIDEP                                                          
  72 :   30   CONTINUE                                                                 
  73 :        IDD2=IDD3                                                                
  74 :   10  CONTINUE                                                                  
  75 :       RETURN                                                                    
  76 :       END                                                                       
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  
  87 :