C CHOMOD SOURCE PV 22/10/14 11:58:20 11482 C C DECOMPOSITION DE CROUT MODIFIEE POUR LE CALCUL DES MATRICES C CONDENSEES D'UN SUPER-ELEMENT C RESULTAT DANS XMATRI C SUBROUTINE CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATRI,NLIGRA) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C TANT QUE OOOVAL(1,4) NE MARCHE PAS SUR CRAY PARAMETER (LPCRAY=10000) INTEGER OOOVAL,ILIMITE,OOOLEN dimension ittime(4) SEGMENT ITMASQ(NBLIG) SEGMENT IMASQ(LMASQ) segment immt(nblig) segment igarde(nvstrm) POINTEUR LILIGN.MILIGN external chole3i C LOGICAL TEST1,LIMIT C C **** MISE SOUS FORME A=Lt D L DE LA MATRICE MMATRX C -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMMATRI -INC SMRIGID -INC CCASSIS -INC CCHOLE -INC SMELEME C SEGMENT SNTO INTEGER NTOTMA(NN) ENDSEGMENT C SEGMENT SNTT INTEGER NTTMAI(NN) ENDSEGMENT C SEGMENT KIVPO(IIMAX) SEGMENT KIVLO(IIMAX) SAVE IPASV DATA IPASV/0/ logical ngmpet C character*8 zen C equivalence (zen,izen) logical lsgdes,pasfait,ngdyn nbnnmc=nbnnma prec=xpetit pasfait=.true. lsgdes=.false. * faire attention a respecter l'ordre des segdes par la suite call ooomru(1) condmax=0.d0 condmin=xgrand ngmpet=.false. ngdyn=.true. call timespv(ittime,oothrd) kcour=(ittime(1)+ittime(2))/10 kcourp=kcour kcouri=kcour kdiff=0 kcour=0 perf=0.d0 perfp=-1 nbchan=1 nbopit=0 iposm=0 C zen='CPU'//char(0) C le=4 lolig=0 nvaor=0 nbthro=nbthrs ithrd=0 if (nbthro.gt.1) then ithrd=1 call threadii call oooprl(1) endif nbthr=nbthro do ith=1,nbthr nbop(ith)=0 enddo stmult=1d-5 C nouvelle methode de gestion de l'espace memoire necessitee par la parallelisation C memoire vive totale MACTIT=OOOVAL(1,1) C un bloc de memoire fera au plus macti/2 call intpdo(inpdo) nvstrm=mactit/10 MMATRI=MMATRX SEGACT,MMATRI*MOD PRCHLV=PREC MILIGN=IILIGN SEGACT,MILIGN*MOD INO=ILIGN(/1) MDIAG=IDIAG SEGACT,MDIAG*MOD NBLIG=INO segini immt SEGINI ITMASQ precc=prec INC=DIAG(/1) nvstrm=max(inc*inpdo,nvstrm) ** write(6,*) ' nvstrm ',nvstrm INCC=INC MIMIK=IIMIK MINCPO=IINCPO SEGACT,MINCPO,MIMIK IPLUMI=IMIK(/2)*2 +4 IL2=0 IIMAX=IJMAX+IPLUMI SEGINI KIVPO,KIVLO INEG=0 NBLAG=0 NENSLX=0 NVSTOC=0 NVSTOR=0 NLIGRP=NLIGRA NLIGRD=NLIGRA diagmax=xpetit/xzprec diagmin=xgrand do i=1,diag(/1) if (ittr(i).eq.0) diagmax=max(diagmax,abs(diag(i))) if (ittr(i).eq.0.and.abs(diag(i)).gt.xpetit/xzprec) > diagmin=min(diagmin,abs(diag(i))) enddo if (diagmax.le.xpetit/xzprec) then do i=1,diag(/1) diagmax=max(diagmax,abs(diag(i))) if (abs(diag(i)).gt.xpetit/xzprec) > diagmin=min(diagmin,abs(diag(i))) enddo endif diagmin=min(diagmin,diagmax) *** write (6,*) ' chole diagmin diagmax ',diagmin,diagmax,diag(/1) C C nelrig=1 SEGINI,XMATRI matric=xmatri C C** ILIMITE = nb de noeuds qui ne sont pas maitres C SEGACT,SNTO SEGACT,SNTT ILIMITE = INO - (NTOTMA(/1) + NTTMAI(/1)) ** write(6,*) ' nbnnma,ntotma nttmai ',nbnnma,ntotma(/1),nttmai(/1) TEST1=.FALSE. IF(ILIMITE.EQ.0) THEN IL2=0 TEST1=.TRUE. ENDIF LIMIT=.FALSE. C C **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD, C **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUD C C **** LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX C 1 CONTINUE IF (TEST1) LIMIT=.TRUE. C IVALMA=IJMAX+IPLUMI IL1=IL2+1 IMIN=IL1 * reserver de la place ou mettre les lignes superieures dans le cas debordement igarde=0 if (ngmpet) then segini igarde ** write(6,*) 'segini igarde',nvstrm endif DO 2 I=IL1,INO ngdyn=.true. imasq=0 LIGN=0 LLIGN= ILIGN(I) SEGACT /ERR=32/LLIGN goto 31 32 continue ** write(6,*) ' segact llign erreur',i,il1,lsgdes if (.not.lsgdes) then ** write(6,*) ' lsgdes 1 ' lsgdes=.true. ***** ngmpet=.true. ** write(6,*) 'desactivation-1 ',1,il1-1 do it=il1-1,1,-1 lign=ilign(it) segdes lign enddo if(igarde.eq.0) segini igarde else goto 3 endif SEGACT /ERR=3/LLIGN 31 continue NA= IMMMM(/1) NBPAR=NA+1 NVALL= NJMAX *pv write (6,*) ' chole ligne noeud inconnues ',i,ipno(i),na,nvall lolig=nvall/na+1 * Si separateur derriere on se prepare pour lui ** if (lolig.gt.8192.and.lolig.gt.5*loligp/3.and. ** > i-il1+1.ge. nbthrs/2+1) goto 3 loligp=lolig SEGINI /ERR=33/ LIGN goto 34 33 continue ** write(6,*) ' segini lign erreur',il1 if (.not.lsgdes) then ** write(6,*) ' lsgdes 2 ' lsgdes=.true. ***** ngmpet=.true. ** write(6,*) 'desactivation-2 ',1,il1-1 do it=il1-1,1,-1 lign=ilign(it) segdes lign enddo if(igarde.eq.0) segini igarde else goto 3 endif SEGINI /ERR=3/ LIGN ** write(6,*) 'deuxieme essai lign ok' 34 continue C recuperer la longueur du segment lglig=(nvall/na)**1.333333333333333333 ** if(lglig.gt.1000000) write(6,*) 'i lglig ',i,lglig C* > .AND.I.GT.IL1) THEN C* SEGSUP LIGN C* GOTO 3 C* endif NVSTOC=NVSTOC + NVALL IVALMA=IVALMA + NVALL nvaor = nvaor + xxva(/1) C C **** DECOMPACTAGE C LMASQ=NVALL/MASDIM+2 SEGINI /ERR=35/ IMASQ goto 36 35 continue ** write(6,*) ' segini masq erreur',il1 if (.not.lsgdes) then ** write(6,*) ' lsgdes 3 ' lsgdes=.true. ***** ngmpet=.true. ** write(6,*) 'desactivation-3 ',1,il1-1 do it=il1-1,1,-1 lign=ilign(it) segdes lign enddo if(igarde.eq.0) segini igarde else goto 3 endif SEGINI /ERR=3/ IMASQ 36 continue IPA=1 DO 121 JPA=1,NA IVPO(JPA)=IPA KPA = IPPO(JPA+1)- IPPO(JPA) IPP = IPPO(JPA) IPPVV(JPA)=IPA-1 LPA = LDEB(JPA) LPA1 = LPA-IPA DO 122 MPA=1,KPA LL = LINC(MPA+IPP) IPLA = LL -LPA1 VAL(IPLA)= XXVA(MPA+IPP) IMASQ(IPLA/MASDIM+1)=1 if (ipla-ipa+1.ge.1) IMASQ((IPLA-ipa+1)/MASDIM+1)=1 122 CONTINUE IPA=IPA+ IMMMM(JPA)-LPA + 1 Cpv IMMM(JPA)= IPNO(LPA) IMMM(JPA)=LPA IF(IMIN .GT. IPNO(LPA )) IMIN = IPNO(LPA) 121 CONTINUE * indexation de imasq ipln=lmasq/na iplp=lmasq/na do 123 ipl=lmasq/na,1,-1 if (imasq(ipl).gt.0) then imasq(ipl)=iplp*masdim ipln=ipl-1 else imasq(ipl)=-ipln*masdim iplp=ipl-1 endif 123 continue ** write (6,*) ' imasq ',lmasq/na ** write (6,*) (imasq(ipl),ipl=1,lmasq/na) C*** **** **** ITMASQ(I)=IMASQ if (na.gt.0) then IPREL= IMMMM(1) IDERL= IMMMM(NA) lcara(2,i)=iprel lcara(3,i)=iderl endif IPPVV(NA+1)=IPA-1 SEGSUP LLIGN ILIGN(I)=LIGN IF(IIMPI.EQ.1525) THEN WRITE( IOIMP,4987) I 4987 FORMAT (' NOEUD NUMERO ',I5) LL=VAL(/1) WRITE(IOIMP, 4926)(VAL(MPA),MPA=1,LL) 4926 FORMAT(' VAL ' , 10E11.4) ENDIF C IF ((I.EQ.(ILIMITE)).AND.(.NOT.TEST1)) THEN TEST1=.TRUE. IL2 = I GOTO 4 ENDIF C* write (6,*) 'longueur ligne ',nvall C nb de ligne multiple du nb de threads C blocage ligne lecture-ecriture pour minimiser le cache C on note si on est au minimum de lignes C si on est dans les noeuds maitres on prend tout ce qu'on peut if (i.ge.ilimite) then nbthro=nbthrs*(128000000/lglig+1) else nbthro=min(nbthrs,lglig/400+1) endif if (i+1-il1.ge.nbthro.and.(.not.ngmpet)) then nbthro=min(nbthrs,i+1-il1) ngdyn=.true. if(i+1-il1.eq.nbthrs) ngdyn=.false. il2=i GOTO 4 endif 2 CONTINUE IL2=INO GO TO 4 3 IL2=I-1 loligp=lolig ** write(6,*) 'desactivation-4 ',llign segdes llign if (imasq.eq.0.and.lign.ne.0) segsup lign 4 CONTINUE nbthro=min(nbthrs,nbthro) nbthr=nbthro C IF(IL2.GE.IL1) GO TO 40 C C **** APPEL AUX ERREURS MESSAGE PAS ASSEZ DE PLACE MEMOIRE C C ITYP=48 CALL ERREUR(48) call ooodmp(0) if (ithrd.eq.1) then call threadis call oooprl(0) endif call ooomru(0) RETURN 40 CONTINUE if (igarde.ne.0) then segsup igarde ** write(6,*) 'segsup igarde il1 il2 ',il1,il2 endif IM=INC DO 352 IH=IL2 ,IL1,-1 LIGN= ILIGN(IH ) IL=INC DO 354 JH=1, IMMM(/1) IM=MIN(IM, IMMM(JH)) IL=MIN(IL, IMMM(JH)) 354 CONTINUE IML=IL lcara(1,ih)=iml immt(ih)=ipno(im) 352 CONTINUE C 353 CONTINUE LIGN=ILIGN(IL1) IL11= IPREL C C **** BOUCLE *5* TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE C C > il1,il2 lig1= ilign(imin) ipos=0 iper=imin ider=imin-1 iderac=imin-1 IL1i=il1 DO 5 I=IMIN ,IL2 IMASQ=ITMASQ(I) LIG1= ILIGN(I) IF(I.LT.IL1) GO TO 7 C____________ C C ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A C ******* IPREL IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER C ******* LE TERME DIAGONAL C LIGN=LIG1 DO 156 KHG=1,IMMM(/1) II=IPREL-1+KHG IMMM(KHG)=0 NN=IPPVV(KHG+1) NNM1=IPPVV(KHG) N=NN-NNM1 DIAG(II)=VAL(NN) IF(N.EQ.1) THEN IF(LIMIT) THEN RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN) GO TO 41 ELSE GO TO 8 ENDIF ENDIF NMI=N-II KI1=N-1 KQ=-NMI C C ****** NOEUD MAITRE ET NON MAITRE traites dans CHOLE1 C if (limit) then IDEP=MAX(IL11,1-NMI) else IDEP=MAX(IL11,2-NMI) endif KIDEP=IDEP+NMI VAL(NN)=VAL(NN)+ # CHOLE1(ILIGN,LIGN,VAL(1+IPPVV(KHG)),DIAG(1-NMI),IPNO(1-NMI), # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,IMASQ(1),1+IPPVV(KHG), # prec,nbop(1)) imasq(nn/masdim+1)=1 imasq(n/masdim+1)=1 if (limit) then RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN) goto 41 endif C 8 CONTINUE diagref=max(abs(diag(ii)),diagmin) diagcmp=diagref*5d-12 IF( ITTR(II).EQ.0.AND. & ABS( VAL(NN)).GT.diagcmp) GO TO 12 IF( ITTR(II).NE.0.AND. & ABS( VAL(NN)).GT.diagcmp) GO TO 12 ** write(6,*) ' ittr val diagcmp ',ittr(ii),val(nn),diagcmp C il faut mettre une valeur plus grande sur les LX car on a un probleme de conditionnement C sur le calcul des reactions en cas de 2 relations presque identique C C **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE C **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT C **** AU PREALABLE SUR CETTE INCONNUE. C * write (6,*) ' chomod nens ii ittr val diag ',ii,ittr(ii), * > val(nn),diag(ii),ipt2.num(1,ipno(ii)),limit if (ittr(ii).eq.0) then VAL(NN)=DIAGREF else VAL(NN)=val(nn)-4.D0*abs(DIAGREF) NENSLX=NENSLX+1 endif NENS=NENS+1 IMMM(KHG)=NENS 12 CONTINUE IMASQ(NN/MASDIM+1)=1 IMASQ(N/MASDIM+1)=1 DIAG(II)=VAL(NN) IF(DIAG(II).NE.0.d0) GO TO 41 KQ1=1+NNM1 KQN=N+NNM1 DO 16 LFG=KQ1,KQN IF(VAL(LFG).NE.0.d0) GO TO 17 16 CONTINUE DIAG(II)=1.d0 if (ittr(ii).ne.0) diag(ii)=-1.d0 VAL(NN)=diag(ii) GO TO 41 17 CONTINUE diag(ii)=val(lfg) if (ittr(ii).ne.0) diag(ii)=-abs(diag(ii)) val(nn)=diag(ii) goto 41 C C **** ENVOI ERREUR MATRICE SINGULIERE C ITYP=49 INTERR(1)=I CALL ERREUR(49) if (ithrd.eq.1) then call threadis call oooprl(0) endif call ooomru(0) RETURN C C **** ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS C ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE C 41 IF(DIAG(II).LT.0.D0) INEG=INEG+1 IF(ITTR(II).NE.0) NBLAG=NBLAG+1 if (.not.limit) then condmin=min(condmin,abs(diag(ii))) condmax=max(condmax,abs(diag(ii))) endif 156 CONTINUE NA=IMMM(/1) C C RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE) C ** write(6,*) 'chole ligne lpl',i,na,ippvv(2)-ippvv(1) if (na.gt.0) >CALL COMPAC(VAL(1),NBPAR,KIVPO(1),KIVLO(1), # NVALL,IPPVV(1),IZROSF,NA,PREC,imasq(1),iprel,iderl) C C on recree lign car la compacter en place emiette la memoire lig1=lign segini /err=1431/ lig1 1431 continue * deplacement fait ici maintenant, avec unrolling do 300 nbp=1,nbpar-1 kdif =kivpo(nbp)-kivlo(nbp) do iv=kivlo(nbp),kivlo(nbp+1)-4,4 lig1.val(iv)=val(iv+kdif ) lig1.val(iv+1)=val(iv+1+kdif ) lig1.val(iv+2)=val(iv+2+kdif ) lig1.val(iv+3)=val(iv+3+kdif ) enddo do iv1=iv,kivlo(nbp+1)-1 lig1.val(iv1)=val(iv1-kivlo(nbp)+kivpo(nbp)) enddo 300 continue ** do it=1,nvall ** lig1.val(it)=val(it) ** enddo do it=1,na lig1.immm(it)=immm(it) lig1.ippvv(it)=ippvv(it) enddo lig1.ippvv(na+1)=ippvv(na+1) lig1.iml=iml lig1.iprel=iprel lig1.iderl=iderl lcara(1,i)=iml lcara(2,i)=iprel lcara(3,i)=iderl segsup lign *pv write (6,*) ' cho2 ligne noeud inconnues ',i,ipno(i),na,nvall lign=lig1 ilign(i)=lign NVSTOR=NVSTOR+NVALL nvstrm=max(nvstrm,nvall) DO 143 LHG=1,NBPAR IVPO(2*LHG-1)=KIVPO(LHG) IVPO(2*LHG)=KIVLO(LHG) 143 CONTINUE C Si la ligne est petite, il n'y a rien a gagner a paralleliser segsup imasq imasq=itmasq(i) if (i.gt.1) then lig1=ilign(i-1) ** if(lsgdes) write(6,*) 'desactivation-5 ',i if (lsgdes) segdes lig1 iderac=min(iderac,i-2) endif C C **** ON TRIANGULARISE LES AUTRES LIGNES C il1=il1+1 if (il1.gt.il2) goto 5 LIG1=ILIGN(I) lign=ilign(il1) IL11=IPREL goto 7 C 72 continue 71 continue if (ider.lt.il1-1.and..not.ngmpet.and.i.ne.ilimite) then ngmpet=.true. endif C soit parce qu'on a fini, soit parce qu'on manque de memoire C il faut executer les lignes activees puis les desactiver C lancer les chole3 et attendre qu'ils soient finis if (ipos.ne.0) then C write (6,*) ' lancement thread ',iper,ider,il1,il2 if (iper.gt.ider) then write (6,*) ' erreur interne chole ' call erreur(5) endif IF(I.LE.ILIMITE) THEN maitre=0 nbthr=min(nbthr,il2-il1+1) LILIGN=MILIGN * blocage pour rester dans le cache secondaire ipers=iper iders=ider ipas=2200 if(nbthr.eq.1) ipas=igrand do 400 iper=ipers,iders,ipas ider=min(iders,iper+ipas-1) do ith=2,nbthr call threadid(ith,chole3i) enddo call chole3i(1) do ith=2,nbthr call threadif(ith) enddo 400 continue endif C test ctrlC if (ierr.ne.0) goto 9999 iposm=max(iposm,ipos) ipos=0 iderf=ider-1 if (ider.ne.il1-1) iderf=ider if (lsgdes) then ** write(6,*) 'desactivation 7 iper iderf',iper,iderf do il=iderf,iper,-1 lign=ilign(il) segdes lign C write (6,*) ' desactivation ligne ',il enddo endif iderac=min(iderac,iper-1) iper=ider+1 C write (6,*) ' iper ider il1 ',iper,ider,il1 if (i.eq.ilimite) goto 5 if (iper.ne.il1) goto 7 ENDIF goto 5 7 CONTINUE ** call oooeta(lig1,ieta,imod) ** if (.not.lsgdes.and.ieta.ne.1) write(6,*) ' prob ',lig1 if (lsgdes) SEGACT/err=71/LIG1 ipos=ipos+1 ider=i if (i.gt.iderac) iderac=i if (i.eq.il1-1.and.i.le.ilimite) goto 71 IF(I.EQ.ILIMITE) GOTO 71 IF(I.GT.ILIMITE) THEN maitre=1 IPPR=LIG1.IPREL IDDR=LIG1.IDERL C C lig2=lig1 ** write(6,*) 'chomod il1t il2t',il1t,il2t ** DO 10 JBI=IL1T,IL2T,nbthrs C C ****** CAS NOEUD MAITRE C nbthr=min(nbthrs,il2-il1+1) ** write(6,*) 'avant nouveau',iper,ider do ith=nbthr,2,-1 call threadid(ith,chole3i) enddo ** write(6,*) ' deuxieme appel chole3 ' call chole3i(1 ) do ith=nbthr,2,-1 call threadif(ith) enddo ** write(6,*) 'apres nouveau' IF(IMM.GT.I) GO TO 106 10 CONTINUE 106 CONTINUE IF(I.LT.IL1) then if(lsgdes) SEGDES,LIG1 endif ENDIF 5 CONTINUE C write (6,*) ' il1 il2 apres 5 ',il1,il2 if (lsgdes) then ** write(6,*) 'desactivation 8 il1 il2',il1,il2 DO I=min(il1,il2),max(il1,il2) LIGN= ILIGN(I) if(lign.ne.0) SEGDES,LIGN enddo endif nbopt=0 do ith=1,nbthro nbopt=nbopt+nbop(ith) nbop(ith)=0 enddo nbopin=nbopt nbopit=nbopit+nbopin call timespv(ittime,oothrd) kcour=(ittime(1)+ittime(2))/10 kdiff=kcour-kcourp C* write (6,*) ' nb operation temps ',nbopin,kdiff if (kdiff.ge.1) then perf=real(nbopin)/kdiff C* if (nbchan.ne.0) perfp=perf if (ngdyn.or.limit) then if (perf.lt.perfp*0.90 .and.nbchan.ne.1 ) then nbchan=1 perfp=perf elseif (nbchan.eq.0) then nbchan=-1 perfp=max(perf,perfp) else nbchan=0 endif endif C* nbchan=0 endif kcourp=kcour iderac=min(iderac,il1-1) IF(IL2.LT.INO) GO TO 1 C ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF C ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE C INEG=INEG-NBLAG C on ne compte pas 2 fois les multiplicateurs qui vont etre C elimines lors de la resolution car mode d'ensemble INEG=INEG-(NBLAG-NENSLX) if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX 4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS', 1' DE LAGRANGE DETECTES') IF (IIMPI.EQ.1)WRITE(IOIMP,4821) NVSTOC 4821 FORMAT( ' CHOMOD NOMBRE DE VALEURS DANS LE PROFIL',I9) IF (IIMPI.EQ.1)WRITE(IOIMP,4822) NVSTOR 4822 FORMAT( ' CHOMOD NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I9) IF (IIMPI.EQ.1)WRITE(IOIMP,4823) NVaor 4823 FORMAT( ' CHOMOD NOMBRE DE VALEURS initiales',I9) INTERR(1)=NVSTOR reaerr(1)=nvstor/inc**(4./3) reaerr(2)=2*nbopit/1D6/max(1,(kcour-kcouri)) reaerr(3)=condmax/condmin ** write(6,*) ' chomod condmin condmax ',condmin,condmax IF (IPASV.EQ.0.or.reaerr(3).gt.1.D23) CALL ERREUR(-278) IPASV=1 call ooomru(0) if(lsgdes) then do ipv=1,ino lign=ilign(ipv) segdes lign enddo endif SEGDES,MINCPO SEGDES,MIMIK SEGDES,MMATRI SEGDES,MILIGN SEGDES,MDIAG SEGDES,SNTO SEGDES,SNTT * verif re SEGDES,XMATRI MMATRX=MMATRI SEGSUP KIVPO,KIVLO,ITMASQ segsup immt 9999 continue call ooomru(0) if (ithrd.eq.1) then call threadis call oooprl(0) endif RETURN END