1 : C GRACO3 SOURCE PV 13/10/23 21:15:07 7848 2 : FUNCTION GRACO3(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF, 3 : # KIDEP,KI1,KQ,imasq,idep,prec,ittrl) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C 7 : C COPIE DE CHOLE1 POUR FAIRE UN CHOLEVSKI INCOMPLET 8 : C 9 : -INC SMMATRI 10 : -INC CCHOLE 11 : DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1) 12 : dimension imasq(1),ittrl(1) 13 : IPPKHG=IPPVF(KHG) 14 : KBAS=IPKNO(KIDEP) 15 : KHAU=IPKNO(KI1) 16 : KDIAG=KI1+1 17 : kndiag=ipkno(kdiag) 18 : DNORM=ABS(VALF(KDIAG))*PREC 19 : KPREM=IVPOF(KHG)-IPPKHG 20 : incomp=1 21 : if (ittrl(iprel-1+khg).ne.0) incomp=0 22 : DO 10 K=KBAS,KHAU 23 : if (kndiag-k.lt.1) incomp=0 24 : LIG1=ILIGF(K) 25 : IF (LIG1.EQ.LIGN) GOTO 20 26 : IECAR=KQ-LIG1.IPREL+1 27 : ICA=MAX(1,KIDEP+IECAR) 28 : ICB=LIG1.IMMM(/1) 28 : CALL GRACO4(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1), 29 : > imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm,incomp, 30 : > lig1.iderl,ittrl(1)) 31 : 10 CONTINUE 32 : GOTO 50 33 : 20 CONTINUE 34 : IECAR=KQ-IPREL+1 35 : DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR 36 : KK=NNJ-IECAR 37 : NNJJ=IPPVF(NNJ+1) 38 : if (valf(kk).eq.0.d0.and.incomp.eq.1.and. 39 : > ittrl(iderl-ki1+kk).eq.0)goto 31 40 : NJ=NNJJ-IPPVF(NNJ) 41 : LLOL=MIN(NJ,KK)-1 42 : LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1) 43 : IF (LLON.GT.0) THEN 44 : P=0.D0 45 : IEC1=KK-LLOL-1 46 : IEC2=NNJJ-IPPKHG-KK 47 : ideq=1+iec1+idep-1 48 : if (llon.gt.masdim+1) then 49 : p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2), 50 : > imasq(1),ideq) 51 : else 52 : if (imasq(ideq/masdim+1).gt.0.or. 53 : > imasq((ideq+llon)/masdim+1).gt.0) 54 : > p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2)) 55 : endif 56 : VALF(KK)=VALF(KK)-P 57 : ENDIF 58 : 31 continue 59 : IF (ABS(VALF(KK)).GT.DNORM) then 60 : KPREM=KK 61 : imasq((kk+idep-1)/masdim+1) =1 62 : ENDIF 63 : 30 CONTINUE 64 : 50 CONTINUE 65 : AUX1=0.D0 66 : kdeb=1 67 : 43 continue 68 : km1=0 69 : im=1 70 : DO 9 K=kdeb,KPREM 71 : km=(k+idep-1)/masdim+1 72 : if (km.ne.km1) then 73 : km1=km 74 : im=imasq(km) 75 : endif 76 : if (im.eq.0) goto 9 77 : if (im.lt.0) then 78 : imr=-im-idep+1 79 : if (imr.gt.k+5) then 80 : kdeb=imr 81 : * write (6,*) ' k kdeb ',k,imasq(km) 82 : GOTO 43 83 : else 84 : goto 9 85 : endif 86 : ENDIF 87 : AUX=VALF(K) 88 : VALF(K)=AUX/DAAG(K) 89 : AUX1=AUX1+AUX*VALF(K) 90 : 9 CONTINUE 91 : IVPOF(KHG)=KPREM+IPPKHG 92 : DO 8 K=KPREM+1,KI1 93 : VALF(K)=0.D0 94 : 8 CONTINUE 95 : GRACO3=-AUX1 96 : RETURN 97 : END 98 : 99 : 100 : 101 : 102 : 103 : 104 : 105 : 106 : 107 :
© Cast3M 2003 - All rights reserved.
Disclaimer