C POINB2 SOURCE CHAT 05/01/13 02:16:43 5004 SUBROUTINE POINB2(MCLAS,MCONT,MCLPO1,PONBEL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : POINB2 C DESCRIPTION : Construit une liste d'entiers : PONBEL (type MLENTI) C PONBEL(i) est le nombre d'éléments de MCLAS et MCONT C contenant le ieme point du maillage MCLPO1. C MCLPO1 est un maillage de POI1. 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 APPELES (Outils) : KRIPAD : MELEME -> (num. globale->locale), ERREUR C APPELES (E/S) : - C APPELES (BLAS) : - C APPELES (CALCUL) : - C*********************************************************************** C SYNTAXE GIBIANE : - C ENTREES : MCLAS (type MELEME) : maillage de classe de C points (sommet, face) par C élément (MMAIL,ELTFA) C MCONT (type MELEME) : maillage de classe de C points (face du contour) C par élément (MMAIL,ELTFA) C MCLPO1 (type MELEME) : maillage de points C correspondant à MCLAS C ENTREES/SORTIES : - C SORTIES : PONBEL (type MLENTI) C CAB CAB N.B.: dans mon cas particulier: CAB CAB MCLAS (type MELEME) : maillage "elts + sommets" CAB CAB MCONT (type MELEME) : maillage "sommets + CAB "centre de face" CAB sur le contour CAB CAB MCLPO1 (type MELEME) : maillage de points CAB "sommets" CAB CAB PONBEL(i) = nombre de voisins "centre d'elt" et CAB "centre de face de bord" du i-eme CAB sommet CAB C*********************************************************************** C VERSION : v1, 29/10/98, version initiale C HISTORIQUE : v1, 29/10/98, création C HISTORIQUE : 07/04/00, ajout de petits commentaires, A. BECCANTINI 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 MCLAS.MELEME POINTEUR MCONT.MELEME POINTEUR MCLPO1.MELEME -INC SMLENTI POINTEUR PONBEL.MLENTI POINTEUR KRIPO1.MLENTI C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV C INTEGER NBSOUS, NBELEM, NOTYP, NBPOI1, JG, INBSOU & , INBEL, INBPO, NOPOI1, NBPOEL, NBPOM1 C * * Executable statements * SEGACT MCLPO1 NBSOUS=MCLPO1.LISOUS(/1) NOTYP =MCLPO1.ITYPEL IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN C C 'MCLPO1 must contain only POI1 elements' C C******* Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = 'Subroutine poinb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF C In KRIPAD : SEGINI KRIPO1 CALL KRIPAD(MCLPO1,KRIPO1) NBPOI1=MCLPO1.NUM(/2) SEGDES MCLPO1 JG=NBPOI1 SEGINI PONBEL C C*** Dim(PONBEL) = DIM(MCLPOI1) C * * Parcourons le maillage géométrique des classes de points MCLAS * N.B. On contolle aussi la compatibilité des SPG * SEGACT MCLAS NBSOUS=MCLAS.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 DO 1 INBSOU=1,NBSOUS IF (NBSOUS.GT.1) THEN IPT1=MCLAS.LISOUS(INBSOU) SEGACT IPT1 ELSE IPT1=MCLAS ENDIF NBPOEL=IPT1.NUM(/1) C C******* NBPOEL = nombre de points dans l'elt C NBELEM=IPT1.NUM(/2) DO 12 INBEL=1,NBELEM DO 122 INBPO=1,NBPOEL NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) C C************* NOPOI1 = numero local de IPT1.NUM(INBPO,INBEL) C dans le maillage MCLPO1 C IF (NOPOI1.NE.0) THEN PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1 ELSE C C**************** 'Erreur grave MCLPO1 n''est pas' C 'le maillage de points correspondant' C 'à MCLAS.' C C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = $ 'Subroutine poinb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF 122 CONTINUE 12 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 1 CONTINUE SEGDES MCLAS * * Parcourons le maillage géométrique des classes de points MCONT * SEGACT MCONT NBSOUS=MCONT.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 DO 2 INBSOU=1,NBSOUS IF (NBSOUS.GT.1) THEN IPT1=MCONT.LISOUS(INBSOU) SEGACT IPT1 ELSE IPT1=MCONT ENDIF NBPOEL=IPT1.NUM(/1) NBPOM1= NBPOEL - 1 NBELEM=IPT1.NUM(/2) DO 22 INBEL=1,NBELEM C C************* N.B. :IPT1.NUM(NBPOEL,INBEL) contient le centre de face C de la face de bord MCONT C C IF(KRIPO1.LECT(IPT1.NUM(NBPOEL,INBEL)) .NE. 0) C & CALL ERREUR(5) C DO 222 INBPO=1,NBPOM1 NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) IF (NOPOI1.NE.0) THEN PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1 ELSE C C**************** 'Erreur grave MCLPO1 n''est pas' C 'le maillage de points correspondant' C 'à MCLAS.' C C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = $ 'Subroutine poinb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF 222 CONTINUE C 22 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 2 CONTINUE SEGDES MCONT SEGSUP KRIPO1 C C**** Test C C WRITE(6,*) 'On a créé PONBEL=',PONBEL C WRITE(6,*) 'PONBEL',NBPOI1 C WRITE(6,*) (PONBEL.LECT(I),I=1,NBPOI1) C SEGDES PONBEL C 9999 CONTINUE RETURN END