Esope source files

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