Esope source files

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