Esope source files

   1 : C POINBL    SOURCE    CHAT      05/01/13    02:16:47     5004           
   2 :       SUBROUTINE POINBL(MCLAS,MCLPO1,
   3 :      $     PONBEL,IMPR,IRET)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 : C***********************************************************************
   7 : C NOM         : POINBL
   8 : C DESCRIPTION : Construit une liste d'entiers : PONBEL (type MLENTI)
   9 : C               PONBEL(i) est le nombre d'éléments de MCLAS
  10 : C               contenant le ieme point du maillage MCLPO1.
  11 : C               MCLPO1 est un maillage de POI1.
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : KRIPAD : MELEME -> (num. globale->locale)
  18 : C APPELES (E/S)    : -
  19 : C APPELES (BLAS)   : -
  20 : C APPELES (CALCUL) : -
  21 : C APPELE PAR       : POIELE, ELPOEL
  22 : C***********************************************************************
  23 : C SYNTAXE GIBIANE    : -
  24 : C ENTREES            : MCLAS (type MELEME)  : maillage de classe de 
  25 : C                                             points (sommet, face) par
  26 : C                                             élément (MMAIL,ELTFA)
  27 : C                      MCLPO1 (type MELEME) : maillage de points
  28 : C                                             correspondant à MCLAS
  29 : C ENTREES/SORTIES    : -
  30 : C SORTIES            : PONBEL (type MLENTI)
  31 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32 : C***********************************************************************
  33 : C VERSION    : v1, 29/10/98, version initiale
  34 : C HISTORIQUE : v1, 29/10/98, création
  35 : C HISTORIQUE :
  36 : C HISTORIQUE :
  37 : C***********************************************************************
  38 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  39 : C en cas de modification de ce sous-programme afin de faciliter
  40 : C la maintenance !
  41 : C***********************************************************************
  42 : -INC CCOPTIO
  43 : -INC SMELEME
  44 :       POINTEUR MCLAS.MELEME
  45 :       POINTEUR MCLPO1.MELEME
  46 : -INC SMLENTI
  47 :       POINTEUR PONBEL.MLENTI
  48 :       POINTEUR KRIPO1.MLENTI
  49 : *
  50 : * Executable statements
  51 : *
  52 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poinbl.eso' 
  53 :       SEGACT MCLPO1
  54 :       NBSOUS=MCLPO1.LISOUS(/1)
  55 :       NOTYP =MCLPO1.ITYPEL
  56 :       IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN
  57 :          WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements'
  58 :          GOTO 9999
  59 :       ENDIF
  60 : C     In KRIPAD : SEGINI KRIPO1
  60 :       CALL KRIPAD(MCLPO1,KRIPO1)
  61 :       NBPOI1=MCLPO1.NUM(/2)
  62 :       SEGDES MCLPO1
  63 :       JG=NBPOI1
  64 :       SEGINI PONBEL
  65 : *
  66 : *   Parcourons le maillage géométrique des classes de points
  67 : *
  68 :       SEGACT MCLAS
  69 :       NBSOUS=MCLAS.LISOUS(/1)
  70 :       IF (NBSOUS.EQ.0) NBSOUS=1
  71 :       DO 1 INBSOU=1,NBSOUS
  72 :          IF (NBSOUS.GT.1) THEN
  73 :             IPT1=MCLAS.LISOUS(INBSOU)
  74 :             SEGACT IPT1
  75 :          ELSE
  76 :             IPT1=MCLAS
  77 :          ENDIF
  78 :          NBPOEL=IPT1.NUM(/1)
  79 :          NBELEM=IPT1.NUM(/2)
  80 :          DO 12 INBEL=1,NBELEM
  81 :             DO 122 INBPO=1,NBPOEL
  82 :                NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL))
  83 :                IF (NOPOI1.NE.0) THEN
  84 :                   PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1
  85 :                ELSE
  86 :                   WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas'
  87 :                   WRITE(IOIMP,*) 'le maillage de points correspondant'
  88 :                   WRITE(IOIMP,*) 'à MCLAS.'
  89 :                   GOTO 9999
  90 :                ENDIF
  91 :  122        CONTINUE
  92 :  12      CONTINUE
  93 :          IF (NBSOUS.GT.1) SEGDES IPT1
  94 :  1    CONTINUE
  95 :       SEGDES MCLAS
  96 :       SEGSUP KRIPO1
  97 :       IF (IMPR.GT.2) THEN
  98 :          WRITE(IOIMP,*) 'On a créé PONBEL=',PONBEL
  99 :          IF (IMPR.GT.3) THEN
 100 :             WRITE(IOIMP,4000) 'PONBEL',NBPOI1
 101 :             WRITE(IOIMP,5000) (PONBEL.LECT(I),I=1,NBPOI1)
 102 :          ENDIF
 103 :       ENDIF
 104 :       SEGDES PONBEL
 105 : *
 106 : * Normal termination
 107 : *
 108 :       IRET=0
 109 :       RETURN
 110 : *
 111 : * Format handling
 112 : *
 113 :  4000  FORMAT (A,'(1..',I8,')')
 114 :  5000  FORMAT (8(1X,I8))
 115 : *
 116 : * Error handling
 117 : *
 118 :  9999 CONTINUE
 119 :       IRET=1
 120 :       WRITE(IOIMP,*) 'An error was detected in subroutine poinbl'
 121 :       RETURN
 122 : *
 123 : * End of subroutine POINBL
 124 : *
 125 :       END
 126 : 
 127 :  
 128 :