super1
C SUPER1 SOURCE PV 22/04/15 17:10:55 11344 # KIDEP,KI1,KQ,NBNNMA,XMATRI,imasq,idep,prec,nc) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMMATRI -INC SMRIGID -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 ILIG=IPREL+KHG-NBNNMA-1 DO 10 K=KBAS,KHAU LIG1=ILIGF(K) IECAR=KQ-LIG1.IPREL+1 ICA=MAX(1,KIDEP+IECAR) ICB=LIG1.IMMM(/1) write (6,*) ' appel super2 ' > KQ,NBNNMA,ILIG,XMATRI,imasq(1),idep,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 ICOL=KQ+KK-NBNNMA NNJJ=IPPVF(NNJ+1) NJ=NNJJ-IPPVF(NNJ) LLOL=MIN(NJ,KK)-1 LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1) LLON=MIN(LLON,NBNNMA-KQ-KK+LLOL+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),ideq-idep+1,nc) else ** if (imasq(ideq/masdim+1).gt.0.or. ** > imasq((ideq+llon)/masdim+1).gt.0) 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 imasq((kk)/masdim+1) =1 ELSE VALF(KK)=0.d0 ENDIF ENDIF if (ilig.ge.1.and.icol.ge.1) then RE(ILIG,ICOL,1)=VALF(KK) RE(ICOL,ILIG,1)=VALF(KK) endif 30 CONTINUE 50 CONTINUE AUX1=0.D0 kdeb=1 43 continue DO 9 K=kdeb,min(KPREM,nbnnma-kq) im=imasq((k)/masdim+1) if (im.eq.0) goto 9 if (im.lt.0) then imr=-im if (imr.gt.k+jacc) then kdeb=imr 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 SUPER1=-AUX1 RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales