Sources Esope | Cast3M

graco4
C GRACO4    SOURCE    PV        22/04/15    17:10:52     11344          
      SUBROUTINE GRACO4(IPPVV,VALF,VAL,IVPO,imasq,idep,prec,
     >  ica,icb,iecar,kprem,dnorm,incomp,iddr,ittr,nc)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC CCHOLE
C
C  COPIE DE CHOLE2  POUR FAIRE UN CHOLEVSKI INCOMPLET
C
      DIMENSION IPPVV(1),VALF(1),VAL(1),IVPO(1),imasq(1),ittr(1)
 
       IDEB4=2*IPPVV(ICA)
       NNKK=IVPO(IDEB4-1)
       DO 10 NNJ=ICA,ICB
        KK=NNJ-IECAR
        IDEB3=2*IPPVV(NNJ+1)
        NNJJ=IVPO(IDEB3-1)
        IF(VALF(KK).EQ.0.D0.and.incomp.eq.1.and.ittr(iddr+nnj-icb).eq.0)
     >      GO TO 11
        NJ=NNJJ-NNKK
        LLOL=MIN(NJ,KK)-1
        LLON=LLOL-KK+KPREM+1
        IF (LLON.GT.0) THEN
         IPOSM=NNJJ-LLOL-2
         IPLAC2=KK-LLOL-1
         IDEBZC=IVPO(IDEB3)
         P=0.D0
         DO 2 IDEB2=IDEB3,IDEB4+2,-2
          IAUX=IVPO(IDEB2-3)-IPOSM
          IPLAC=IVPO(IDEB2-2)-IAUX
          IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
          IDEBZC=MAX(1,IAUX)+IPLAC
          IPLAC3=IPLAC2-IPLAC
       if (IFINZ-IDEBZC+1.GT.0) then
        ideq=IDEBZC+IPLAC3+idep-1
        if (IFINZ-IDEBZC.gt.masdim) then
       p=p+ddotpw(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC),
     >    imasq(1),ideq,nc)
        else
         if (imasq(ideq/masdim+1).gt.0.or.
     >       imasq((ifinz+iplac3+idep-1)/masdim+1).gt.0)
     > p=p+ddotpv(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC))
       if(ifinz-idebzc+1.ge.1) nc=nc+ifinz-idebzc+1
        endif
       endif
          IF (IAUX.LE.1) GOTO 3
   2     CONTINUE
   3     CONTINUE
         VALF(KK)=VALF(KK)-P
        ENDIF
  11    CONTINUE
        IF (ABS(VALF(KK)).GT.DNORM) then
          KPREM=KK
          if (imasq((kk+idep-1)/masdim+1).le.0)
     >        imasq((kk+idep-1)/masdim+1)=1
        ENDIF
        IDEB4=IDEB3
        NNKK=NNJJ
  10   CONTINUE
       RETURN
       END