C TOPDI2 SOURCE GOUNAND 25/11/24 21:15:18 12406 SUBROUTINE TOPDI2(TRAVJ,TRAVX) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : TOPDI2 C DESCRIPTION : Etant donné une liste de numéros d'éléments à C extraire, on les retire d'une topologie et de son inverse. C C On essaie d'accélérer TOPDIF lorsque nexto est grand car cela a C ete identifie comme une source de lenteur par gprof C repris de topdif C C On utilise JNBL comme segment inverse de NEXTO C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : C*********************************************************************** C SYNTAXE GIBIANE : C ENTREES : JELEM C ENTREES/SORTIES : JCOORD, JTOPO C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 18/12/2017, version initiale C HISTORIQUE : v1, 18/12/2017, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC TMATOP2 -INC SMLENTI POINTEUR NEXTO.MLENTI POINTEUR JNBL.MLENTI -INC SMELEME * * Le nombre d'éléments de JTOPO et le nombre de points de JCOORD * vont être variables. Pour ne pas avoir à ajuster ces segments en * permanence, on va dimensionner plus large, mais du coup, il faut * aussi maintenir à la main le nombre de noeuds et d'éléments * courants. * * Le nombre d'éléments courants est NVCOU et le nombre d'éléments * max est NVMAX. Idem pour le nombre de noeuds courants et max : * NPCOU et NPMAX. * * Numerotation locale des éléments JTOPO.NUM(NBNN,NBELEM) * INTEGER NVCOU,NVMAX POINTEUR JTOPO.MELEME -INC TMATOP1 *-INC STOPINV *-INC STRAVJ POINTEUR TRAVX.TRAVJ * logical lchang * * Executable statements * if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topdi2.eso' * JTOPO=TRAVJ.TOPO TOPINV=TRAVJ.TOPI NEXTO=TRAVX.NBL JNBL=TRAVJ.NBL IDIMP=IDIM+1 *tst write(ioimp,*) 'DIFF avant' *tst call ecmai1(jtopo,0) *tst write(ioimp,*) 'Elements de la topologie extraits :' *tst write(ioimp,187) (nexto.lect(I),I=1,travx.nvcou) *tst segact jtopo*mod *tst call ectopi(topinv,1) *tst call ectopi(topinv,2) * tst segact topinv*mod * Init JNBL do ielx=1,travx.nvcou jnbl.lect(nexto.lect(ielx))=1 enddo * Mise à jour de TOPINV * Seuls les noeuds appartenant à jexto sont susceptibles d'être * impactés. On utilise le signe de ldg pour savoir si on a déjà * corrigé la liste chaînée du noeud * On parcourt les éléments à l'envers, comme la liste chaînée. do ielx=travx.nvcou,1,-1 * do ielx=1,travx.nvcou do inox=1,IDIMP ip=JTOPO.NUM(inox,nexto.lect(ielx)) * Parcours de la liste chaînée ip si pas deja fait ldg=tdc(ip) *tst write(ioimp,185) 'ip,ldg=',ip,ldg if (ldg.gt.0) then lastp=0 last=tic(ip) * jelx=ielx * nelx=nexto.lect(jelx) * idgx=1 ldgx=ldg *tst write(ioimp,185) 'idg,lastp,last,nelx=',0,lastp,last *tst $ ,nelx do 77 idg=1,ldg iel=((last-1)/idimp)+1 *tst write(ioimp,185) 'idg,nelx,iel,last=',idg,nelx,iel *tst $ ,last if (jnbl.lect(iel).eq.1) then * 771 continue * if (iel.eq.nelx) then lastn=tlc(last) *tst write(ioimp,185) 'idg,nelx,lastp,last,lastn=' *tst $ ,idg,nelx,lastp,last,lastn * suppression d'un indice de la chaîne if (lastp.eq.0) then tic(ip)=lastn else tlc(lastp)=lastn endif tlc(last)=0 last=lastn ldgx=ldgx-1 * jelx=jelx-1 * if (jelx.lt.1) then * goto 78 * else * nelx=nexto.lect(jelx) * endif * elseif (iel.lt.nelx) then * jelx=jelx-1 * if (jelx.lt.1) then * goto 78 * else * nelx=nexto.lect(jelx) * endif * goto 771 * Si nelx