super3
C SUPER3 SOURCE PV 22/04/15 17:10:56 11344 # IPPVV1,VAL,VAL1,IVPO1,NBNNMA,XMATRI,imasq,prec,nc) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION IPPV(100),IVPO(*),IPPVV1(*),VAL(*),VAL1(*),IVPO1(*) dimension imasq(1) -INC SMRIGID -INC CCHOLE IDD2=IPPV(1) na=iderl-iprel+1 kidepg=ivpo(1) kidepb=ivpo(1) do 121 im=2,na kidepg=max(kidepg,ivpo(im)) 121 continue DO 10 J=IPREL,IDERL ICOL=J-NBNNMA JID=J-IPREL+1 IDD3=IPPV(JID+1) N2=IDD3-IDD2 KD2=J-N2+1 c KD2=J-N2 N2J=IDD3-J KIDEP=IVPO(JID) c IBABA=MAX(IPPR,KD2+1) IBABA=MAX(IPPR,KD2) IF (IBABA.GT.IDDR) GOTO 30 IDEB4=2*IPPVV1(IBABA-IPPR+1) IDD=IVPO1(IDEB4-1) DO 20 JHY=IBABA,IDDR ILIG=JHY-NBNNMA ILM=JHY-IPPR+1 IDEB3=2*IPPVV1(ILM+1) NNJJ=IVPO1(IDEB3-1) N=NNJJ-IDD KD1=1+JHY-N IDEP=MAX(KD2,KD1) LLOL=JHY-IDEP I1=JHY+N2J LLON=MIN(LLOL-I1+KIDEPg+1,NBNNMA-IDEP+1) * on compare a la diagonale de la colonne DNORM=ABS(VAL1(IVPO1(IDEB3)-1))*prec IF (LLON.GT.0.and.i1.ge.1) THEN IPOSM=N-LLOL+IDD-2 IPLAC2=N2J+IDEP-1 idebzc=ivpo1(ideb3) p=0.D0 DO 2 IDEB2=IDEB3,IDEB4+2,-2 IAUX=IVPO1(IDEB2-3)-IPOSM IPLAC=IVPO1(IDEB2-2)-IAUX IFINZ=MIN(IDEBZC-1,LLON+IPLAC) IDEBZC=MAX(1,IAUX)+IPLAC IPLAC3=IPLAC2-IPLAC lond=ifinz-idebzc+1 if (lond.GT.0) then ideq=IDEBZC+IPLAC3 if (IFINZ-IDEBZC.GT.masdim) then if (-imasq((ideq-idd2)/masdim+1).le.ideq-ippv(jid)+lond-1) > imasq(1),ideq-idd2,nc) else * if (imasq(ideq/masdim+1).gt.0.or. * > imasq((ifinz+iplac3)/masdim+1).gt.0) if (lond.ge.1) nc=nc+lond endif endif IF (IAUX.LE.1) GOTO 3 2 CONTINUE 3 CONTINUE val(i1)=val(i1)-p if (abs(val(i1)).gt.dnorm) then imasq(i1/masdim+1)=1 imasq((i1-idd2)/masdim+1)=1 * mise a jour masque do imt=kidep/masdim+1+1,i1/masdim+1-1 imasq(imt)=-(i1/masdim)*masdim+1 enddo KIDEP=I1 if (jid.ne.1) then do imt=kidepb/masdim+1+1,(i1-idd2)/masdim+1-1 imasq(imt)=-((i1-idd2)/masdim)*masdim+1 enddo endif kidepb=max(i1-idd2,kidepb) ELSE val(i1)=0.d0 ENDIF ENDIF if (ilig.ge.1.and.icol.ge.1) then RE(ILIG,ICOL,1)=VAL(I1) RE(ICOL,ILIG,1)=VAL(I1) endif 5 CONTINUE IDEB4=IDEB3 IDD=NNJJ 20 CONTINUE 30 CONTINUE IVPO(JID)=KIDEP IVPO(1)=kidepb IDD2=IDD3 10 CONTINUE RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales