Sources Esope | Cast3M

graco3
C GRACO3    SOURCE    PV090527  23/03/08    12:22:20     11617          
      FUNCTION GRACO3(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
     # KIDEP,KI1,KQ,imasq,idep,prec,ittrl,nc)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C  COPIE DE CHOLE1 POUR FAIRE UN CHOLEVSKI INCOMPLET
C
-INC SMMATRI
-INC CCHOLE
      DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1)
      dimension imasq(1),ittrl(1)
      IPPKHG=IPPVF(KHG)
      KBAS=IPKNO(KIDEP)
      KHAU=IPKNO(KI1)
      KDIAG=KI1+1
      kndiag=ipkno(kdiag)
      DNORM=ABS(VALF(KDIAG))*PREC
      KPREM=IVPOF(KHG)-IPPKHG
       incomp=1
       if (ittrl(iprel-1+khg).ne.0) incomp=0
      DO 10 K=KBAS,KHAU
       if (kndiag-k.lt.1) incomp=0
       LIG1=ILIGF(K)
       IF (LIG1.EQ.LIGN) GOTO 20
       IECAR=KQ-LIG1.IPREL+1
       ICA=MAX(1,KIDEP+IECAR)
       ICB=LIG1.IMMM(/1)
       CALL GRACO4(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
     >  imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm,incomp,
     >  lig1.iderl,ittrl(1),nc)
  10  CONTINUE
      GOTO 50
  20  CONTINUE
      IECAR=KQ-IPREL+1
      DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
       KK=NNJ-IECAR
       NNJJ=IPPVF(NNJ+1)
       if (valf(kk).eq.0.d0.and.incomp.eq.1.and.
     >   ittrl(iderl-ki1+kk).eq.0)goto 31
       NJ=NNJJ-IPPVF(NNJ)
       LLOL=MIN(NJ,KK)-1
       LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1)
       IF (LLON.GT.0) THEN
        P=0.D0
        IEC1=KK-LLOL-1
        IEC2=NNJJ-IPPKHG-KK
        ideq=1+iec1+idep-1
        if (llon.gt.masdim+1) then
        p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2),
     >     imasq(1),ideq,nc)
        else
         if (imasq(ideq/masdim+1).gt.0.or.
     >       imasq((ideq+llon)/masdim+1).gt.0)
     >   p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2))
         nc=nc+llon
        endif
        VALF(KK)=VALF(KK)-P
       ENDIF
  31   continue
       IF (ABS(VALF(KK)).GT.DNORM) then
         KPREM=KK
         imasq((kk+idep-1)/masdim+1) =1
       ENDIF
  30  CONTINUE
  50  CONTINUE
      AUX1=0.D0
      kdeb=1
  43  continue
      km1=0
      im=1
      DO 9 K=kdeb,KPREM
       km=(k+idep-1)/masdim+1
       if (km.ne.km1) then
        km1=km
        im=imasq(km)
       endif
       if (im.eq.0) goto 9
       if (im.lt.0) then
        imr=-im-idep+1
        if (imr.gt.k+jacc) then
          kdeb=imr
*          write (6,*) ' k kdeb ',k,imasq(km)
          GOTO 43
        else
         goto 9
        endif
       ENDIF
      AUX=VALF(K)
      if (aux.ne.0.d0) then
      VALF(K)=AUX*DAAG(K)
      AUX1=AUX1+AUX*VALF(K)
      endif
   9  CONTINUE
      IVPOF(KHG)=KPREM+IPPKHG
      DO 8 K=KPREM+1,KI1
      VALF(K)=0.D0
   8  CONTINUE
      GRACO3=-AUX1
      RETURN
      END