C PONBL2 SOURCE CHAT 05/01/13 02:17:31 5004 SUBROUTINE PONBL2(MAIL,KRIPO1,NPOMAX, $ PONBEL,IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : PONBL2 C DESCRIPTION : Maillage + tableau repérage de points => liste d'entiers C (un point)->(nb. d'éléments du maillage le contenant). C C Construit une liste d'entiers : PONBEL (type MLENTI) C PONBEL(i) est le nombre d'éléments de MAIL C contenant un point dont le numéro n C est tel que KRIPO1(n)=i. C La dimension de PONBEL est NPOMAX C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELE PAR : MAKPRM C*********************************************************************** C SYNTAXE GIBIANE : - C ENTREES : C ENTREES/SORTIES : - C SORTIES : PONBEL (type MLENTI) C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 20/05/99, version initiale C HISTORIQUE : v1, 20/05/99, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC SMELEME POINTEUR MAIL.MELEME POINTEUR SOUMAI.MELEME -INC SMLENTI INTEGER JG POINTEUR PONBEL.MLENTI POINTEUR KRIPO1.MLENTI * INTEGER IMPR,IRET INTEGER MAETA,KRETA,SMETA INTEGER INBEL,INBNO,INBSOU INTEGER NBEL, NBNO,NBSOUS,NUMNO,NLOCP1,NPOMAX * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ponbl2.eso' CALL OOOETA(KRIPO1,KRETA) IF (KRETA.NE.1) SEGACT KRIPO1 JG=NPOMAX SEGINI PONBEL * * Parcourons le maillage * CALL OOOETA(MAIL,MAETA) IF (MAETA.NE.1) SEGACT MAIL NBSOUS=MAX(1,MAIL.LISOUS(/1)) DO 1 INBSOU=1,NBSOUS IF (NBSOUS.EQ.1) THEN SOUMAI=MAIL ELSE SOUMAI=MAIL.LISOUS(INBSOU) CALL OOOETA(SOUMAI,SMETA) IF (SMETA.NE.1) SEGACT SOUMAI ENDIF NBNO=SOUMAI.NUM(/1) NBEL=SOUMAI.NUM(/2) DO 12 INBEL=1,NBEL DO 122 INBNO=1,NBNO NUMNO=SOUMAI.NUM(INBNO,INBEL) NLOCP1=KRIPO1.LECT(NUMNO) IF (NLOCP1.NE.0) THEN PONBEL.LECT(NLOCP1)=PONBEL.LECT(NLOCP1)+1 ENDIF 122 CONTINUE 12 CONTINUE IF (NBSOUS.NE.1.AND.SMETA.NE.1) SEGDES SOUMAI 1 CONTINUE IF (MAETA.NE.1) SEGDES MAIL IF (KRETA.NE.1) SEGDES KRIPO1 SEGDES PONBEL * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ponbl2' RETURN * * End of subroutine PONBL2 * END