C CHOLI1 SOURCE PV 19/03/06 21:15:01 10147 # KIDEP,KI1,KQ,imasq,idep,prec,icle,nc,diagref) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMMATRI -INC CCHOLE DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1) dimension imasq(1) IPPKHG=IPPVF(KHG) KBAS=IPKNO(KIDEP) KHAU=IPKNO(KI1) KDIAG=KI1+1 DNORM=ABS(VALF(KDIAG))*PREC KPREM=IVPOF(KHG)-IPPKHG DO 10 K=KBAS,KHAU LIG1=ILIGF(K) IECAR=KQ-LIG1.IPREL+1 ICA=MAX(1,KIDEP+IECAR) ICB=LIG1.IMMM(/1) > imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm) 10 CONTINUE * LIGN=ILIGF(KHAU+1) * IECAR = KQ-IPREL+1 GOTO 50 20 CONTINUE IECAR=KQ-IPREL+1 DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR KK=NNJ-IECAR NNJJ=IPPVV(NNJ+1) NJ=NNJJ-IPPVV(NNJ) LLOL=MIN(NJ,KK)-1 LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1) C 3 lignes ajoutees IF (LLON.GT.0.and.kk.ge.1) THEN IEC1=KK-LLOL-1 IEC2=NNJJ-llol -1 if (llon.gt.masdim) then ideq=1+iec1+idep-1 ideq=1+idep-1 > imasq(1),ideq,nc) else if (llon.gt.0) nc=nc+llon endif VALF(KK)=VALF(KK)-P ENDIF IF (ABS(VALF(KK)).GT.DNORM) then KPREM=KK imasq((kk+idep-1)/masdim+1) =1 imasq((kk)/masdim+1) =1 else valf(kk)=0.d0 ENDIF 30 CONTINUE 50 CONTINUE AUX1=0.D0 if(ICLE.EQ.2) THEN iecar = KQ-IPREL+1 nnj= ki1+IECAR+1 kk = nnj-iecar nnjj=IPPVV(NNJ+1) NJ=NNJJ-IPPVV(NNJ) LLOL=MIN(NJ,KK)-1 LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1) IEC1=KK-LLOL-1 IEC2=NNJJ-llol -1 IF(LLON.GT.0) THEN * write(6,*)'diagonale llon iec1 iec2' , llon, iec1,iec2 DO 9 K=1+iec1,iec1+LLON AUX1=AUX1+valf(K)*VAL(K-iec1+iec2) 9 CONTINUE if (llon.gt.0) nc=nc+llon ENDIF DO 91 K=1,kprem VALF(K)=VALF(K) /DAAG(K) diagref=max(diagref,abs(daag(k))) 91 CONTINUE else DO 90 K=1,KPREM VALF(K)=VALF(K) /DAAG(K) diagref=max(diagref,abs(daag(k))) 90 CONTINUE endif IVPOF(KHG)=KPREM+IPPKHG CHOLI1=-AUX1 RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales