C CHOLE1 SOURCE PV 13/10/23 21:15:01 7848 FUNCTION CHOLE1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF, # KIDEP,KI1,KQ,imasq,idep,prec) 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) IF (LIG1.EQ.LIGN) GOTO 20 IECAR=KQ-LIG1.IPREL+1 ICA=MAX(1,KIDEP+IECAR) ICB=LIG1.IMMM(/1) CALL CHOLE2(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(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) THEN IEC1=KK-LLOL-1 IEC2=NNJJ-IPPKHG-KK ideq=1+iec1+idep-1 if (llon.gt.masdim+1) then p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2), > imasq(1),ideq) else if (imasq(ideq/masdim+1).gt.0.or. > imasq((ideq+llon)/masdim+1).gt.0) > p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2)) endif VALF(KK)=VALF(KK)-P ENDIF IF (ABS(VALF(KK)).GT.DNORM) then KPREM=KK imasq((kk+idep-1)/masdim+1) =1 ENDIF 30 CONTINUE 50 CONTINUE AUX1=0.D0 kdeb=1 43 continue km1=0 im=1 DO 9 K=kdeb,KPREM km=(k+idep-1)/masdim+1 if (km.ne.km1) then km1=km im=imasq(km) endif if (im.eq.0) goto 9 if (im.lt.0) then imr=-im-idep+1 if (imr.gt.k+5) then kdeb=imr * write (6,*) ' k kdeb ',k,imasq(km) GOTO 43 else goto 9 endif ENDIF AUX=VALF(K) VALF(K)=AUX/DAAG(K) AUX1=AUX1+AUX*VALF(K) 9 CONTINUE IVPOF(KHG)=KPREM+IPPKHG DO 8 K=KPREM+1,KI1 VALF(K)=0.D0 8 CONTINUE CHOLE1=-AUX1 RETURN END