1 : C GRACO4 SOURCE PV 13/10/21 21:15:22 7845 2 : SUBROUTINE GRACO4(IPPVV,VALF,VAL,IVPO,imasq,idep,prec, 3 : > ica,icb,iecar,kprem,dnorm,incomp,iddr,ittr) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : -INC CCHOLE 7 : C 8 : C COPIE DE CHOLE2 POUR FAIRE UN CHOLEVSKI INCOMPLET 9 : C 10 : DIMENSION IPPVV(1),VALF(1),VAL(1),IVPO(1),imasq(1),ittr(1) 11 : 12 : IDEB4=2*IPPVV(ICA) 13 : NNKK=IVPO(IDEB4-1) 14 : DO 10 NNJ=ICA,ICB 15 : KK=NNJ-IECAR 16 : IDEB3=2*IPPVV(NNJ+1) 17 : NNJJ=IVPO(IDEB3-1) 18 : IF(VALF(KK).EQ.0.D0.and.incomp.eq.1.and.ittr(iddr+nnj-icb).eq.0) 19 : > GO TO 11 20 : NJ=NNJJ-NNKK 21 : LLOL=MIN(NJ,KK)-1 22 : LLON=LLOL-KK+KPREM+1 23 : IF (LLON.GT.0) THEN 24 : IPOSM=NNJJ-LLOL-2 25 : IPLAC2=KK-LLOL-1 26 : IDEBZC=IVPO(IDEB3) 27 : P=0.D0 28 : DO 2 IDEB2=IDEB3,IDEB4+2,-2 29 : IAUX=IVPO(IDEB2-3)-IPOSM 30 : IPLAC=IVPO(IDEB2-2)-IAUX 31 : IFINZ=MIN(IDEBZC-1,LLON+IPLAC) 32 : IDEBZC=MAX(1,IAUX)+IPLAC 33 : IPLAC3=IPLAC2-IPLAC 34 : if (IFINZ-IDEBZC+1.GT.0) then 35 : ideq=IDEBZC+IPLAC3+idep-1 36 : if (IFINZ-IDEBZC.gt.masdim) then 37 : p=p+ddotpw(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC), 38 : > imasq(1),ideq) 39 : else 40 : if (imasq(ideq/masdim+1).gt.0.or. 41 : > imasq((ifinz+iplac3+idep-1)/masdim+1).gt.0) 42 : > p=p+ddotpv(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC)) 43 : endif 44 : endif 45 : IF (IAUX.LE.1) GOTO 3 46 : 2 CONTINUE 47 : 3 CONTINUE 48 : VALF(KK)=VALF(KK)-P 49 : ENDIF 50 : 11 CONTINUE 51 : IF (ABS(VALF(KK)).GT.DNORM) then 52 : KPREM=KK 53 : if (imasq((kk+idep-1)/masdim+1).le.0) 54 : > imasq((kk+idep-1)/masdim+1)=1 55 : ENDIF 56 : IDEB4=IDEB3 57 : NNKK=NNJJ 58 : 10 CONTINUE 59 : RETURN 60 : END 61 : 62 : 63 : 64 : 65 : 66 : 67 : 68 :
© Cast3M 2003 - All rights reserved.
Disclaimer