Esope source files

   1 : C CHOLI1    SOURCE    PV        13/09/26    21:48:45     7827           
   2 :       FUNCTION CHOLI1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,               
   3 :      # KIDEP,KI1,KQ,imasq,idep,prec,icle)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   6 : -INC SMMATRI                                                                    
   7 : -INC CCHOLE
   8 :       DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1)
   9 :       dimension imasq(1)
  10 :       IPPKHG=IPPVF(KHG)                                                         
  11 :       KBAS=IPKNO(KIDEP)                                                         
  12 :       KHAU=IPKNO(KI1)                                                           
  13 :       KDIAG=KI1+1                                                       
  14 :       DNORM=ABS(VALF(KDIAG))*PREC
  15 :       KPREM=IVPOF(KHG)-IPPKHG                                   
  16 :       DO 10 K=KBAS,KHAU                                                         
  17 :        LIG1=ILIGF(K)                                                            
  18 :        IF (LIG1.EQ.LIGN) GOTO 20                                                
  19 :        IECAR=KQ-LIG1.IPREL+1                                                    
  20 :        ICA=MAX(1,KIDEP+IECAR)                                              
  21 :        ICB=LIG1.IMMM(/1)                                                     
  21 :        CALL CHOLE2(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
  22 :      >  imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm)
  23 :   10  CONTINUE  
  24 : *      LIGN=ILIGF(KHAU+1)
  25 : *      IECAR = KQ-IPREL+1                                                               
  26 :       GOTO 50                                                                   
  27 :   20  CONTINUE                                                               
  28 :       IECAR=KQ-IPREL+1                                                           
  29 :       DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR                                    
  30 :        KK=NNJ-IECAR                                                             
  31 :        NNJJ=IPPVV(NNJ+1)                                                        
  32 :        NJ=NNJJ-IPPVV(NNJ)                                                       
  33 :        LLOL=MIN(NJ,KK)-1                                                                                                                                                                
  34 :        LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1) 
  35 : C 3 lignes ajoutees                               
  36 :        IF (LLON.GT.0) THEN  
  37 :         IEC1=KK-LLOL-1                                                      
  38 :         IEC2=NNJJ-llol -1                                                                                                                              
  39 :         if (llon.gt.masdim) then
  40 :         ideq=1+iec1+idep-1
  41 :         p=ddotpw(llon,VALF(1+iec1),VAL(1+iec2),
  42 :      >     imasq(1),ideq)
  43 :         else
  44 :         p=ddotpv(llon,VALF(1+iec1),VAL(1+iec2))
  45 :         endif
  46 :         VALF(KK)=VALF(KK)-P
  47 :        ENDIF                                                                    
  48 :        IF (ABS(VALF(KK)).GT.DNORM) then
  49 :          KPREM=KK
  50 :          imasq((kk+idep-1)/masdim+1) =1
  51 :        ENDIF
  52 :   30  CONTINUE                                                                  
  53 :   50  CONTINUE                                                                  
  54 :       AUX1=0.D0                                                             
  55 :       if(ICLE.EQ.2) THEN
  56 :       iecar = KQ-IPREL+1
  57 :       nnj= ki1+IECAR+1
  58 :       kk = nnj-iecar
  59 :       nnjj=IPPVV(NNJ+1)  
  60 :       NJ=NNJJ-IPPVV(NNJ)
  61 :       LLOL=MIN(NJ,KK)-1 
  62 :       LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1) 
  63 :       IEC1=KK-LLOL-1 
  64 :       IEC2=NNJJ-llol -1 
  65 :       IF(LLON.GT.0) THEN  
  66 : *      write(6,*)'diagonale llon iec1  iec2' , llon, iec1,iec2             
  67 :         DO 9 K=1+iec1,iec1+LLON                                                          
  68 : *        AUX=VALF(K)                                                               
  69 : *        VALF(K)=AUX/DAAG(K)                                                       
  70 :         AUX1=AUX1+valf(K)*VAL(K-iec1+iec2)                                                     
  71 :    9    CONTINUE   
  72 :       ENDIF
  73 :       DO 91 K=1,kprem
  74 :       VALF(K)=VALF(K)  /DAAG(K)                                                                                                       
  75 :   91  CONTINUE  
  76 :       else    
  77 :       DO 90 K=1,KPREM                                                                                                                      
  78 :       VALF(K)=VALF(K)  /DAAG(K)                                                                                                       
  79 :   90  CONTINUE  
  80 :       endif                                                            
  81 :       IVPOF(KHG)=KPREM+IPPKHG                                                   
  82 :       DO 8 K=KPREM+1,KI1                                                        
  83 :       VALF(K)=0.D0                                                              
  84 :    8  CONTINUE                                                                  
  85 :       CHOLI1=-AUX1                                                              
  86 :       RETURN                                                                    
  87 :       END                                                                       
  88 :  
  89 :  
  90 :  
  91 :  
  92 :  
  93 :  
  94 :  
  95 :  
  96 :