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