C NUMOP1 SOURCE PV 20/03/30 21:21:40 10567 C RACINE DE LA NUMEROTATION POUR LA SORTIE SUR FAC C C methode utilisee: NESTED DISSECTION & MULTIFRONTALE C ce programme decompose un domaine d'etude par elements finis C et utilise ensuite la methode multifrontale. SUBROUTINE NUMOP1(MELEME,ICPR,NODES) IMPLICIT INTEGER(I-N) -INC SMELEME -INC SMCOORD -INC PPARAM -INC CCOPTIO SEGMENT JMEM(NODES+1),JMEMN(NODES+1) C JMEM et JMEMN contiennent le nombre d'elements auquel appartient C un noeud SEGMENT JNT(NODES),NUMERO(NODES) C JNT contient la nouvelle numerotation SEGMENT ICPR(nbpts) C ICPR au debut contient l'ancienne numerotation, C a la fin la nouvelle. SEGMENT IADJ(NODES+1),IVOIS(0) SEGMENT NPVOIS(2*NBENS),NVOIS(0) C IADJ(i) pointe sur IVOIS qui contient les voisins de i entre C IADJ(i) et IADJ(i+1)-1 SEGMENT LAGRAN(NB) C contient les noeud de lagrange et les noeuds les suivant directement C cf element de type 22 SEGMENT INVLAG(NB1) SEGMENT BOOLEEN LOGICAL BOOL(NODES) ENDSEGMENT C BOOL(i) = true si le noeud i a etait deja memtioner dans la liste C des voisin IVOIS SEGMENT IMEMOIR(NBV) C contient les element appartenant a chaque noeud,sous forme de liste, C au premier, puis au second, etc... INTEGER ELEM C nom d'un element INTEGER N,NBENS SEGMENT MASQUE LOGICAL MASQ(NODES) ENDSEGMENT C MASQ(X)=.TRUE. si le noeud X n'a pas ete renumerote; C .FALSE. si il l'a ete. INTEGER DIM,DIMSEP C DIM= nombre de noeuds renumerotes. INTEGER PIVOT C PIVOT est le noeud utile a la division du domaine. SEGMENT IPOS(NODES*2) C est le vecteur contenant la numerotation dans les deux sens,de 1 a NODES C puis de NODES+1 a 2* NODES, cf la subroutine SEPAR SEGMENT ICOMPT(NODES),IORDRE(2*NBENS) C initialisation C******************************* IENORM=2000000000 C norme d'erreur. NODES=nbpts SEGACT ICPR*MOD SEGACT MELEME C icpr: numero des noeuds. C meleme: objet de maillage (cf assem2.eso) DO 10 I=1,ICPR(/1) 10 ICPR(I)=0 IPT1=MELEME IKOU=0 NBV=0 NB1=0 NB2=0 DO 100 IO=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) THEN IPT1=LISOUS(IO) SEGACT IPT1 ENDIF C on cree la numerotation des noeuds. C 'nb noeuds/element'=IPT1.NUM(/1) C 'nb element'=IPT1.NUM(/2) IF(IPT1.ITYPEL.EQ.22) THEN NB1=NB1+IPT1.NUM(/2) NB2=MAX(NB2,IPT1.NUM(/1)) C NB1= nbre d'elements de type 22. C NB2=nbre de noeuds/element maximum parmi C les elements de type 22. ENDIF DO 150 I=1,IPT1.NUM(/1) DO 150 J=1,IPT1.NUM(/2) IJ=IPT1.NUM(I,J) C IJ est le Ieme noeud du Jeme element. IF (ICPR(IJ).NE.0) GOTO 150 C s'il est deja numerote, on ne fait rien. IKOU=IKOU+1 ICPR(IJ)=IKOU 150 CONTINUE NODES=IKOU C NODES= nbre de noeuds. 100 CONTINUE NB=NB2*NB1 C NB= dimension(LAGRAN). C***** initalisation des segments********* SEGINI IADJ,IVOIS,JMEM,JMEMN,LAGRAN SEGINI BOOLEEN,JNT DO 20 I=1,NODES+1 IADJ(I)=0 JMEM(I)=0 JMEMN(I)=0 20 CONTINUE C****************************************** IPT1=MELEME NGRAND=0 IADJ(1)=1 INC=0 DO 200 IO=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) THEN IPT1=LISOUS(IO) ENDIF DO 210 J=1,IPT1.NUM(/2) IF(IPT1.ITYPEL.EQ.22) THEN DO 220 I=1,IPT1.NUM(/1) C chaque element de type 22 a au plus NB2 noeuds. LAGRAN(INC*NB2+I)=ICPR(IPT1.NUM(I,J)) C les noeuds de l'elements de type 22 C sont ranges dans le vecteur LAGRAN. 220 CONTINUE DO 225 I=IPT1.NUM(/1)+1,NB2 LAGRAN(INC*NB2+I)=0 C comme on a alloue la place memeoire maximale, C on remplit les cases restantes avec des 0. 225 CONTINUE INC=INC+1 C INC=le nbre d'elements de type 22. ENDIF DO 230 I=1,IPT1.NUM(/1) IJ=ICPR(IPT1.NUM(I,J))+1 JMEM(IJ)=JMEM(IJ)+1 C JMEM(I+1): nb elements auquel le noeud I appartient 230 CONTINUE 210 CONTINUE NGRAND=MAX(NGRAND,IPT1.NUM(/2)) 200 CONTINUE NGRAND=NGRAND+1 JMEM(1)=1 DO 30 I=1,NODES JMEM(I+1)=JMEM(I)+JMEM(I+1) C JMEM(I+1)=indice de depart des elements C auxquels le noeud I appartient. 30 CONTINUE NBV=JMEM(NODES+1) C NBV= dimension de IMEMOIR. SEGINI IMEMOIR IPT1=MELEME IMATOT=LISOUS(/1)*(NGRAND+1) IF(IMATOT.GT.IENORM) THEN CALL ERREUR(382) RETURN ENDIF DO 300 IO=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) THEN IPT1=LISOUS(IO) ENDIF DO 350 I=1,IPT1.NUM(/1) DO 350 J=1,IPT1.NUM(/2) JMEMN(ICPR(IPT1.NUM(I,J))+1)=JMEMN(ICPR(IPT1.NUM(I,J))+1)+1 IMEMOIR(JMEM(ICPR(IPT1.NUM(I,J)))+ & JMEMN(ICPR(IPT1.NUM(I,J))+1)-1)=J+IO*NGRAND C on range dans IMEMOIR tous les elements des sous-objets C IO auxquels appartient le noeud ICPR(IPT1.NUM(I,J)). C On connait pour chaque element, le sous-objet auquel C il appartient. 350 CONTINUE 300 CONTINUE DO 400 I=1,NODES IADJ(I+1)=IADJ(I) DO 410 J=1,NODES BOOL(J)=.FALSE. 410 CONTINUE DO 420 J=JMEM(I),JMEM(I+1)-1 ELEM=IMEMOIR(J) C ELEM=element auquel appartient le noeud I. IPT1=MELEME IF (LISOUS(/1).NE.0) IPT1=LISOUS(ELEM/NGRAND) ELEM=MOD(ELEM,NGRAND) DO 430 K=1,IPT1.NUM(/1) C k representatif du nb de noeuds par elements. IK=ICPR(IPT1.NUM(K,ELEM)) IF ((I.NE.IK).AND. & (.NOT.(BOOL(IK)))) THEN C si i n'est pas egal a un des nouveaux numeros des noeuds C de l'element ELEM et si il n'appartient pas deja a l'ens des C voisins du noeud i(jadjc(i)),alors on le rajoute. C IVOIS(IADJ(I+1))=IK IVOIS(**)=IK IADJ(I+1)=IADJ(I+1)+1 BOOL(IK)=.TRUE. ENDIF 430 CONTINUE 420 CONTINUE 400 CONTINUE SEGSUP JMEM,JMEMN,BOOLEEN SEGSUP IMEMOIR C affectation C************************ N=NODES SEGINI IPOS,MASQUE DO 50 I=1,N MASQ(I)=.TRUE. IPOS(I)=0 IPOS(NODES+I)=0 50 CONTINUE C initialement, les noeuds ne sont pas masques,ont donc C une position nulle. DIM=0 C le nombre de noeuds renumerotes DIM est initialement egal a zero. C **************************************** C boucle principale MPOS=0 DO 500 I=1,N 550 IF(.NOT.MASQ(I)) GOTO 500 C si le noeud a ete renumerote, on passe au suivant. PIVOT=I C sinon, il devient PIVOT. CALL SEPAR(IADJ,IVOIS,PIVOT,MASQUE,DIMSEP,N,IPOS,NODES) C separe le domaine d'etude en 2 parties. C on decrit le domaine d'etude a partir du pivot et on cherche la C longueur maximale en decrivant les voisins de pivot, et leurs C voisins... jusqu'a rencontrer un voisin masque. On cree alors C une nouvelle separation. C les noeuds masques delimitent la separation du domaine. DIM=DIM+DIMSEP N=N-DIMSEP IF (DIM.GE.NODES) GOTO 600 C si tous les noeuds ont une position non nulle,on arrete. GOTO 550 500 CONTINUE 600 SEGSUP MASQUE SEGINI NUMERO CALL PREPA(IPOS,NPVOIS,NVOIS,NBENS,NUMERO,NODES,IADJ,IVOIS) C procedure donnant une nouvelle gestion de donnees. C NBENS= nbre d'ensembles. C un ensemble est compose de noeuds ayant meme NUMERO. C NPVOIS(I,2)-NPVOIS(I,1)-1=nbre d'ensemble voisins a l'ensemble I. C NVOIS(J), pour J compris entre NPVOIS(I,1) et NPVOIS(I,2)-1, C contient les ensembles voisins de I. CALL MINDEG(NPVOIS,NVOIS,NBENS,IORDRE) C on recherche l'ensemble de minimum degre. C on le numerote et on recommence. CALL SORTID(IADJ,IVOIS,IORDRE,NUMERO,NODES,NBENS,JNT) C JNT(I) est le nouveau numero du NOEUD I. SEGSUP IORDRE C****************************************************** C insertion des lagrangiens. C****************************************************** C principe: on cherche le premier noeud auquel s'applique les 2 C coefficients de lagrange, on les insere de part et d'autre de C ce noeud dans la numerotation. DO 1 I=1,NODES IPOS(JNT(I))=I 1 CONTINUE IF(NB2.NE.0) THEN N=NB/NB2 ELSE N=0 ENDIF NORME=0 DO 700 I=1,NODES NOEUD=IPOS(I) IF (NOEUD.EQ.0) GOTO 700 DO 750 J=0,N-1 IF(NOEUD.EQ.LAGRAN(J*NB2+1)) THEN NORME=NORME+1 IPOS(NODES+NOEUD)=0 GOTO 700 ENDIF IF(NOEUD.EQ.LAGRAN(J*NB2+2)) THEN NORME=NORME+1 IPOS(NODES+NOEUD)=0 GOTO 700 ENDIF 750 CONTINUE IPOS(NODES+NOEUD)=I-NORME C IPOS(NODES+NOEUD)= numero d'elimination obtenu en tenant C compte des lagrangiens. 700 CONTINUE NCOMPT=0 NORM=0 SEGINI ICOMPT,INVLAG DO 800 I=1,NODES NOEUD=IPOS(I) C NOEUD =Ieme noeud elimine. IF(IPOS(NODES+NOEUD).EQ.0) GOTO 800 ICOMPT(NOEUD)=0 DO 850 J=0,NB1-1 IF(LAGRAN(J*NB2+1).NE.0) THEN K=3 855 IF((K.LE.NB2).AND.(LAGRAN(J*NB2+K).NE.0)) THEN IF(NOEUD.EQ.LAGRAN(J*NB2+K)) THEN INVLAG(ICOMPT(NOEUD)+1)=J C INVLAG mémorise l'élément de type 22. C on change le numero d'élimination de noeud, C en insérant de part et d'autre les coef de lagrange. JNT(LAGRAN(J*NB2+1))= & IPOS(NOEUD+NODES)+NORM-ICOMPT(NOEUD) LAGRAN(J*NB2+1)=0 C permet de savoir si le lagrangien a ete insere. NORM=NORM+1 JNT(NOEUD)= & IPOS(NODES+NOEUD)+NORM-ICOMPT(NOEUD) C renumerotation de noeud. DO 852 IJ=1,ICOMPT(NOEUD) IL=INVLAG(IJ) JNT(LAGRAN(IL*NB2+2))=JNT(LAGRAN(IL*NB2+2))+1 852 CONTINUE NORM=NORM+1 JNT(LAGRAN(J*NB2+2))=IPOS(NODES+NOEUD)+NORM ICOMPT(NOEUD)=ICOMPT(NOEUD)+1 GOTO 850 ELSE K=K+1 GOTO 855 ENDIF ENDIF ENDIF 850 CONTINUE IF(ICOMPT(NOEUD).EQ.0) THEN JNT(NOEUD)=IPOS(NODES+NOEUD)+NORM ENDIF 800 CONTINUE SEGSUP INVLAG C****************************************************************** DO 860 I=1,nbpts IF(ICPR(I).NE.0) THEN ICPR(I)=JNT(ICPR(I)) C numerotation finale. ENDIF 860 CONTINUE SEGSUP IADJ,IVOIS,JNT,IPOS,ICOMPT,NUMERO SEGSUP LAGRAN,NPVOIS,NVOIS RETURN END