Sources Esope | Cast3M

graco5
C GRACO5    SOURCE    PV        22/04/15    17:10:52     11344          
      SUBROUTINE GRACO5(IPREL,IDERL,IPPV,IPPR,IDDR,IVPO,
     # IPPVV1,VAL,VAL1,IVPO1,imasq,ittr,incom1,nc)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCHOLE
C
C  COPIE DE CHOLE3  POUR FAIRE UN CHOLEVSKI INCOMPLET
C
      DIMENSION IPPV(1),IVPO(1),IPPVV1(1),VAL(1),VAL1(1),IVPO1(1)
      dimension imasq(1),ittr(1)
      IDD2=IPPV(1)
      DO 10 J=IPREL,IDERL
       incomp=incom1
       if (ittr(j).ne.0) incomp=0
       JID=J-IPREL+1
       IDD3=IPPV(JID+1)
       IF(IDD3.NE.1)THEN
         DNORM=ABS(VAL(IDD3-1))*PRECC
       ELSE
         DNORM=0.
       ENDIF
       N2=IDD3-IDD2
       KD2=J-N2+1
       N2J=IDD3-J
       KIDEP=IVPO(JID)
       IBABA=MAX(IPPR,KD2+1)
       IF (IBABA.GT.IDDR) GOTO 30
       IDEB4=2*IPPVV1(IBABA-IPPR+1)
       IDD=IVPO1(IDEB4-1)
       ibabad=ibaba
   21  continue
       DO 20 JHY=IBABAD,IDDR
        I1=JHY+N2J
        if(imasq(i1/masdim+1).eq.0) then
            ibabad=(i1/masdim+1)*masdim-n2j
            goto 21
        elseif(imasq(i1/masdim+1).lt.0) then
            ibabad=-imasq(i1/masdim+1)-n2j
            goto 21
        endif
        ILM=JHY-IPPR+1
        IDEB3=2*IPPVV1(ILM+1)
        NNJJ=IVPO1(IDEB3-1)
        IF(VAL(I1) .NE.0.D0.or.incomp.eq.0.or.ittr(jhy).ne.0) then
        N=NNJJ-IDD
        KD1=1+JHY-N
        IDEP=MAX(KD2,KD1)
        LLOL=JHY-IDEP
        LLON=LLOL-I1+KIDEP+1
          IF (LLON.GT.0) THEN
           P=0.D0
           IPOSM=N-LLOL+IDD-2
           IPLAC2=N2J+IDEP-1
         idebzc=ivpo1(ideb3)
           DO 2 IDEB2=IDEB3,IDEB4+2,-2
            IAUX=IVPO1(IDEB2-3)-IPOSM
            IPLAC=IVPO1(IDEB2-2)-IAUX
            IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
            IDEBZC=MAX(1,IAUX)+IPLAC
            IPLAC3=IPLAC2-IPLAC
          lond=ifinz-idebzc+1
        if (lond.GT.0) then
        ideq=IDEBZC+IPLAC3
        if (IFINZ-IDEBZC.GT.masdim) then
        p=p+ddotpw(lond,VAL(ideq),VAL1(IDEBZC),
     >      imasq(1),ideq,nc)
        else
         if (imasq(ideq/masdim+1).gt.0.or.
     >       imasq((ifinz+iplac3)/masdim+1).gt.0)
     >  p=p+ddotpv(lond,VAL(ideq),VAL1(IDEBZC))
        if (lond.ge.1) nc=nc+lond
        endif
        endif
            IF (IAUX.LE.1) GOTO 3
   2       CONTINUE
   3       CONTINUE
         if (abs(p).LT.dnorm.and.imasq(i1/masdim+1).le.0) goto 5
           VAL(I1)=VAL(I1)-P
          ENDIF
        ENDIF
        IF (ABS(VAL(I1)).GT.DNORM) then
          if (imasq(i1/masdim+1).le.0) imasq(i1/masdim+1)=1
          KIDEP=I1
        endif
   5    continue
       IDEB4=IDEB3
        IDD=NNJJ
  20   CONTINUE
  30   CONTINUE
       IVPO(JID)=KIDEP
       IDD2=IDD3
  10  CONTINUE
      RETURN
      END