1 : C NUGCNU SOURCE CHAT 06/03/29 21:28:32 5360 2 : C 3 : C 4 : SUBROUTINE NUGCNU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX, 5 : > NOETRI,NOEMAX,NBE,COORD,IDIMC,NBP, 6 : > ITVL,NITMAX,iarr) 7 : C ***************************************************************** 8 : C OBJET NUGCNU : GARBAGE COLLECTOR ELEMENTS ET POINTS 9 : C OBJET SUPPRIME LES ELEMENTS NULS ET LES POINTS ISOLES 10 : C OBJET LES POINTS ET LES ELEMENTS SONT RENUMEROTES !!! 11 : C 12 : C EN ENTREE: 13 : C ITRNOE,NBNMAX,ITRITRI,NBCMAX,NOETRI,NOEMAX,NBE : LE MAILLAGE 14 : C NBNMAX: SI NBNMAX = 0 ALORS ITRNOE N'EST PAS CONSIDERE 15 : C NOEMAX: SI NOEMAX = 0 ALORS NOETRI N'EST PAS CONSIDERE 16 : C COORD,NBP : COORDONNEES ET NOMBRE DE NOEUDS 17 : C IDIMC : DIMENSION DE L'ESPACE, SI IDIMC = 0 ALORS ON NE COMPRIME 18 : C PAS LES NOEUDS. 19 : C 20 : C ITVL(NITMAX) : TABLEAU DE TRAVAIL (ENTIERS), SA TAILLE EST DE 21 : C 2*NBP POUR LA RENUMEROTATION DES NOEUDS 22 : C + 2*NBE POUR LA RENUMEROTATION DES ELEMENTS 23 : C + NBP SI NOETRI N4EST PAS DONNE (NOEMAX=0) 24 : C 25 : C EN SORTIE: 26 : C ITRNOE,NBE,ITRTRI,NOETRI,COORD,NBN : MIS A JOUR 27 : C 28 : C CONDITION D'APPLICATION : TOUT MAILLAGE 29 : C ***************************************************************** 30 : IMPLICIT INTEGER(I-N) 31 : INTEGER IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX 32 : INTEGER NOETRI(*),NOEMAX,NBE 33 : REAL*8 COORD(*) 34 : INTEGER IDIMC,NBP,ITVL(*),NITMAX,iarr 35 : C 36 : INTEGER I,J,NUM,ITRAMA,NUM1,NBISOL,NBENUL 37 : INTEGER NOETR2 38 : C 39 : NUM = 1 40 : NBISOL = 0 41 : NBENUL = 0 42 : IF(IDIMC.EQ.0)GOTO 40 43 : C ============================ 44 : C --- 1. COMPRESSION DES NOEUDS --- 45 : C ============================ 46 : IF( NOEMAX.EQ. 0 )THEN 47 : NOETR2 = 0 48 : NUM = NBP + NOETR2 49 : ENDIF 50 : ITRAMA = NUM + NBP 51 : IF( NITMAX .LT. ITRAMA+NBP )THEN 52 : iarr = -2 52 : CALL DSERRE(1,iarr,'NUCGNU',' POUR COMPRIMER LES NOEUDS') 52 : CALL ESEINT(1,'PLACE NECESSAIRE : ',ITRAMA+NBP,1) 52 : CALL ESEINT(1,'PLACE DISPONIBLE : ',NITMAX,1) 53 : GOTO 9999 54 : ENDIF 55 : C 56 : C ---- RECHERCHE DES NOEUDS CONNECTES ---- 57 : C -------------------------------- 58 : IF( NOEMAX.EQ. 0 )THEN 59 : DO 105 I=1,NBP 60 : ITVL(NOETR2+I) = 0 61 : 105 CONTINUE 62 : DO 120 I=1,NBE 63 : DO 110 J=1,NBNMAX 64 : NUM1 = ITRNOE((I-1)*NBNMAX+J) 65 : IF( NUM1.NE.0 )ITVL(NOETR2+NUM1) = I 66 : 110 CONTINUE 67 : 120 CONTINUE 68 : C 68 : CALL NUNISO(ITVL(NOETR2+1),NBP,ITVL(NUM+1),NBISOL,iarr) 69 : ELSE 70 : C 70 : CALL NUNISO(NOETRI,NBP,ITVL(NUM+1),NBISOL,iarr) 71 : ENDIF 72 : C 73 : IF( iarr.NE. 0 )THEN 73 : CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUNISO ') 74 : GOTO 9999 75 : ENDIF 76 : C 77 : C ---- SUPPRESSION DES NOEUDS PAS CONNECTES ---- 78 : C -------------------------------------- 78 : CALL NUNONU(ITRNOE,NBNMAX,NOETRI,NOEMAX,NBE, 79 : > COORD,IDIMC, 80 : > ITVL(NUM+1),NBP,ITVL(ITRAMA+1),iarr) 81 : IF( iarr.NE. 0 )THEN 81 : CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUNONU ') 82 : GOTO 9999 83 : ENDIF 84 : NBP = NBP - NBISOL 85 : C 86 : C ============================== 87 : C --- 2. COMPRESSION DES ELEMENTS --- 88 : C ============================== 89 : C 90 : 40 IF( IDE.EQ. 0 )GOTO 9999 90 : CALL NUENUL(ITRNOE,NBNMAX,NBE,ITVL(NUM+1),NBENUL,iarr) 91 : IF( iarr.NE. 0 )THEN 91 : CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUENUL ') 92 : GOTO 9999 93 : ENDIF 94 : C 95 : ITRAMA = NUM + NBE 95 : CALL NURENU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI, 96 : > NOEMAX,NBE,ITVL(NUM+1),ITVL(ITRAMA+1),iarr) 97 : C 98 : IF( iarr.NE. 0 )THEN 98 : CALL DSERRE(1,iarr,'NUCGNU',' APPEL NURENU ') 99 : GOTO 9999 100 : ENDIF 101 : C 102 : NBE = NBE - NBENUL 103 : C 104 : C 105 : 9999 END 106 : 107 : 108 :
© Cast3M 2003 - All rights reserved.
Disclaimer