1 : C COMPAC SOURCE PV 13/10/14 21:17:44 7838 2 : SUBROUTINE COMPAC(VAL,NBPAR,KIVPO,KIVLO,NVALL,IPPVV, 3 : > IZROFS,NA,PREC,imasq) 4 : ****** 5 : * COMPACTE UNE LIGNE DE LA MATRICE. TOUTES SEQUENCES DE IZROFS VALEURS 6 : * INFERIEURES A PREC SONT ELIMINEES 7 : * 8 : ****** 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : -INC CCHOLE 12 : DIMENSION VAL(*),KIVPO(*),KIVLO(*),IPPVV(*),imasq(*) 13 : IDECI=0 14 : NBPAR=0 15 : DO 140 KHG=1,NA 16 : LHG=IPPVV(KHG)+1 17 : VAL(LHG-IDECI)=VAL(LHG) 18 : IBL=LHG+1 19 : NBPAR=NBPAR+1 20 : KIVPO(NBPAR)=LHG 21 : KIVLO(NBPAR)=LHG-IDECI 22 : IDEB=IZROFS+LHG 23 : IPPVV(KHG)=NBPAR 24 : IFIN=IPPVV(KHG+1) 25 : 1 CONTINUE 26 : * ON SUPPOSE ICI QUE TOUT CE QUI EST JUSQU'A ( IDEB-IZROFS) 27 : * EST BIEN PLACE 28 : * IBL INDIQUE LA PREMIERE VALEUR NON TRAITE DANS LE DECALAGE 29 : * IDECI EST LA VALEUR DU DECALAGE A FAIRE 30 : DO 2 I=IDEB,IFIN-1,IZROFS 31 : IF(ABS(VAL(I)).LT.PREC ) THEN 32 : I1=I-IZROFS+1 33 : I2=I 34 : GO TO 10 35 : ENDIF 36 : 2 CONTINUE 37 : IF( IDECI.EQ.0) GO TO 140 38 : DO 3 J=IBL,IFIN 39 : VAL(J-IDECI)=VAL(J) 40 : 3 CONTINUE 41 : GO TO 140 42 : * 43 : * ON EST EN PRESENCE D'UN 'ZERO' IL FAUT TESTER SI TOUTES LES VALEURS 44 : * SONT NULLES 45 : * 46 : 10 CONTINUE 47 : ** JCOU=( I2 + I1) /2 48 : ** IF(JCOU.EQ.I1) GO TO 20 49 : ** IF(ABS(VAL(JCOU)).GT.PREC ) THEN 50 : * ON REPREND LA BOUCLE INITIALE A PARTIR DE CETTE VALEUR NON NULLE 51 : ** IDEB= JCOU 52 : ** GO TO 1 53 : ** ENDIF 54 : ** I2= JCOU 55 : ** GO TO 10 56 : 20 CONTINUE 57 : * PAR DICHOTOMIE ON A TROUVE QUE DES VALEURS NULLES, ON PART EN TEST 58 : * CONTINU A PARTIR DE I1 59 : * 60 : * plus de dichotomie, mais 61 : * utilisation de itmasq pour accelerer la recherche 62 : * 63 : DO 24 I = I1,min((i1/masdim+1)*masdim,ifin) 64 : IF(ABS(VAL(I)).GT.PREC) THEN 65 : I3= I 66 : GO TO 30 67 : ENDIF 68 : 24 CONTINUE 69 : ipr=i1/masdim+1 70 : 27 continue 71 : do 25 im=ipr,ifin/masdim 72 : if (imasq(im+1).gt.0) goto 26 73 : if (imasq(im+1).lt.0) then 74 : ipr=-(imasq(im+1)/masdim)+1 75 : *** write (6,*) ' compac acceleration ',im,ipr 76 : goto 27 77 : endif 78 : 79 : 25 continue 80 : 26 continue 81 : i1b=im*masdim 82 : DO 21 I = I1b,IFIN 83 : IF(ABS(VAL(I)).GT.PREC) THEN 84 : I3= I 85 : GO TO 30 86 : ENDIF 87 : 21 CONTINUE 88 : * SI QUE DES VALEURS NULLES GARDER DERNIERE SINON PLOUFPLOUF DANS CHOLE 89 : I3=IFIN 90 : GOTO 30 91 : * IL N'Y A QUE DES VALEURS NULLES ON MET A JOUR IDECI ET ON SORT 92 : * IDECI = IDECI + IFIN - I1 +1 93 : * RETURN 94 : 30 CONTINUE 95 : * IL FAUT SAVOIR SI I3 -I1 EST SUPERIEUR A EST IZROFS 96 : IF(I3-I1.GE.IZROFS) THEN 97 : * OUI IL FAUT COMPACTER LE PRECEDENT ET POSITIONNER I3 98 : IF(IDECI.NE.0) THEN 99 : DO 33 J=IBL,I1-1 100 : VAL(J-IDECI)=VAL(J) 101 : 33 CONTINUE 102 : ENDIF 103 : IBL=I3+1 104 : IDECI=IDECI+I3-I1 105 : VAL(I3-IDECI)=VAL(I3) 106 : NBPAR=NBPAR+1 107 : KIVPO(NBPAR)=I3 108 : KIVLO(NBPAR)=I3-IDECI 109 : ENDIF 110 : IDEB=I3+IZROFS 111 : GO TO 1 112 : 140 CONTINUE 113 : NBPAR=NBPAR+1 114 : KIVPO(NBPAR)=IPPVV(NA+1)+1 115 : IPPVV(NA+1)=NBPAR 116 : NVALL=IFIN-IDECI 117 : KIVLO(NBPAR)=NVALL+1 118 : RETURN 119 : END 120 : 121 : 122 :
© Cast3M 2003 - All rights reserved.
Disclaimer