C CHOLE1 SOURCE GF238795 18/02/01 21:15:04 9724 # KIDEP,KI1,KQ,imasq,idep,prec,nbo) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMMATRI -INC CCHOLE DIMENSION ILIGF(*),VALF(*),DAAG(*),IPKNO(*),IPPVF(*),IVPOF(*) 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 GOTO 50 20 CONTINUE IECAR=KQ-IPREL+1 DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR KK=NNJ-IECAR NNJJ=IPPVF(NNJ+1) NJ=NNJJ-IPPVF(NNJ) LLOL=MIN(NJ,KK)-1 LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1) IF (LLON.GT.0.and.kk.ge.1) THEN IEC1=KK-LLOL-1 IEC2=NNJJ-IPPKHG-KK ideq=1+iec1+idep-1 if (llon.gt.masdim+1) then > imasq(1),1+idep-1,nbo) else ** if (imasq(ideq/masdim+1).gt.0.or. ** > imasq((ideq+llon)/masdim+1).gt.0) c if (llon.ge.1) nc=nc+llon endif VALF(KK)=VALF(KK)-P IF (ABS(VALF(KK)).GT.DNORM) then KPREM=KK imasq((kk+idep-1)/masdim+1) =1 * si on remonte, on tombe au terme diagonal ou apres, mais ce n'est qu'un seul terme imasq(kk/masdim+1) =1 ELSE * annuler le terme car on l'ignorera par la suite valf(kk)=0.d0 ENDIF ENDIF 30 CONTINUE 50 CONTINUE AUX1=0.D0 kdeb=1 43 continue kdebi=kdeb 44 continue do 100 im=kdeb/masdim+1,kprem/masdim+1 jm=imasq(im) if (jm.gt.0) goto 105 if (jm.eq.0) goto 100 jinio=-jm/masdim+1 if (jinio.gt.im+7) then * write (6,*) 'saut kdeb jm ',kdeb,jm kdeb=-jm goto 44 endif 100 continue 105 continue ideb=max((im-1)*masdim,kdebi) do 110 im=ideb/masdim+1,kprem/masdim+1 if (imasq(im).le.0) goto 115 110 continue 115 continue im=im-1 ifin=min((im)*masdim-1,kprem) ** write (6,*) ' chole1 kdeb kprem ideb ifin ',kdeb,kprem,ideb,ifin DO 9 K=ideb,ifin AUX=VALF(K) VALF(K)=AUX/DAAG(K) AUX1=AUX1+AUX*VALF(K) 9 CONTINUE if (ifin.lt.kprem) then kdeb=ifin+1 goto 43 endif ivpof(khg)=kprem+ippkhg CHOLE1=-AUX1 RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales