Esope source files

   1 : C POELM2    SOURCE    CHAT      05/01/13    02:16:26     5004           
   2 :       SUBROUTINE POELM2(MAIL,KRIPO1,PONBEL,
   3 :      $     LSTPL,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : POELM2
   9 : C DESCRIPTION : Maillage + tableau de repérage de points + liste
  10 : C               d'entiers (ponbl2) => liste indexée d'entiers (un
  11 : C               point)->(numéro des éléments du maillage le contenant).   
  12 : C 
  13 : C         Construit une liste indexée LSTPL (type LSTIND)
  14 : C         * Nombre de multiplets = nb d'éléments de PONBEL ;
  15 : C         * chaque multiplet i : numéros des éléments de 
  16 : C           MAIL contenant un point dont le numéro n 
  17 : C           est tel que KRIPO1(n)=i. 
  18 : C       (Le nombre de ces éléments est PONBEL(i), cf. ponbl2).
  19 : C
  20 : C LANGAGE     : ESOPE
  21 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  22 : C               mél : gounand@semt2.smts.cea.fr
  23 : C***********************************************************************
  24 : C APPELES (ESOPE)  : OOOETA
  25 : C APPELE PAR       : MAKPRM
  26 : C***********************************************************************
  27 : C SYNTAXE GIBIANE    : -
  28 : C ENTREES            :
  29 : C ENTREES/SORTIES    : -
  30 : C SORTIES            : LSTPL (type LSTIND)
  31 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32 : C***********************************************************************
  33 : C VERSION    : v1, 20/05/99, version initiale
  34 : C HISTORIQUE : v1, 20/05/99, 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 MAIL.MELEME
  45 :       POINTEUR SOUMAI.MELEME
  46 : -INC SMLENTI
  47 :       POINTEUR PONBEL.MLENTI
  48 :       POINTEUR KRIPO1.MLENTI
  49 : *
  50 : *     Segment LSTIND (liste séquentielle indexée)
  51 : *
  52 :       SEGMENT LSTIND
  53 :       INTEGER IDX(NBM+1)
  54 :       INTEGER IVAL(NBTVAL)
  55 :       ENDSEGMENT
  56 : *
  57 : *     LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  58 : *
  59 : *     NBL      : NOMBRE DE MULTIPLETS
  60 : *     NBTVAL   : NOMBRE TOTAL DE VALEURS 
  61 : *     IDX(I)   : INDICE DE LA PREMIERE VALEUR DU IEME 
  62 : *                MULTIPLET DANS LE TABLEAU IVAL
  63 : *     IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  64 : *
  65 : *-INC SLSTIND
  66 :       POINTEUR LSTPL.LSTIND
  67 :       POINTEUR ICOUR.LSTIND
  68 : *
  69 :       INTEGER IMPR,IRET
  70 :       INTEGER MAETA,KRETA,POETA,SMETA
  71 :       INTEGER INBEL,INBM,INBNO,INBSOU,IDEPA,IDXCOU
  72 :       INTEGER  NBEL, NBM, NBNO,NBSOUS
  73 :       INTEGER NBTVAL,NLOCP1,NPONB,NUELMA,NUMNO
  74 : *
  75 : * Executable statements
  76 : *
  77 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans poelm2.eso' 
  77 :       CALL OOOETA(PONBEL,POETA)
  78 :       IF (POETA.NE.1) SEGACT PONBEL
  79 :       NPONB=PONBEL.LECT(/1)
  80 : C   On initialise le segment LSTPL
  81 : C              et le segment ICOUR
  82 : C     dans ICOUR, seul le tableau IDX nous intéresse
  83 :       NBM=NPONB
  84 :       NBTVAL=0
  85 :       SEGINI LSTPL
  86 :       IDEPA=1
  87 :       DO 2 INBM=1,NBM
  88 :          LSTPL.IDX(INBM)=IDEPA
  89 :          IDEPA=IDEPA+PONBEL.LECT(INBM)
  90 :  2    CONTINUE
  91 :       LSTPL.IDX(NBM+1)=IDEPA
  92 :       IF (POETA.NE.1) SEGDES PONBEL
  93 :       SEGINI,ICOUR=LSTPL
  94 :       NBTVAL=IDEPA-1
  95 :       SEGADJ LSTPL
  95 :       CALL OOOETA(KRIPO1,KRETA)
  96 :       IF (KRETA.NE.1) SEGACT KRIPO1
  97 : *
  98 : *   Parcourons le maillage
  99 : *
 100 :       NUELMA=0
 100 :       CALL OOOETA(MAIL,MAETA)
 101 :       IF (MAETA.NE.1) SEGACT MAIL
 102 :       NBSOUS=MAX(1,MAIL.LISOUS(/1))
 103 :       DO 4 INBSOU=1,NBSOUS
 104 :          IF (NBSOUS.EQ.1) THEN
 105 :             SOUMAI=MAIL
 106 :          ELSE
 107 :             SOUMAI=MAIL.LISOUS(INBSOU)
 107 :             CALL OOOETA(SOUMAI,SMETA)
 108 :             IF (SMETA.NE.1) SEGACT SOUMAI
 109 :          ENDIF
 110 :          NBNO=SOUMAI.NUM(/1)
 111 :          NBEL=SOUMAI.NUM(/2)
 112 :          DO 42 INBEL=1,NBEL
 113 :             NUELMA=NUELMA+1
 114 :             DO 422 INBNO=1,NBNO
 115 :                NUMNO=SOUMAI.NUM(INBNO,INBEL)
 116 :                NLOCP1=KRIPO1.LECT(NUMNO)
 117 :                IF (NLOCP1.NE.0) THEN
 118 :                   IDXCOU=ICOUR.IDX(NLOCP1)
 119 :                   LSTPL.IVAL(IDXCOU)=NUELMA
 120 :                   ICOUR.IDX(NLOCP1)=IDXCOU+1
 121 :                ENDIF
 122 :  422        CONTINUE
 123 :  42      CONTINUE
 124 :          IF (NBSOUS.NE.1.AND.SMETA.NE.1) SEGDES SOUMAI
 125 :  4    CONTINUE
 126 :       IF (MAETA.NE.1) SEGDES MAIL
 127 :       IF (KRETA.NE.1) SEGDES KRIPO1
 128 :       SEGDES LSTPL
 129 :       SEGSUP ICOUR
 130 : *
 131 : * Normal termination
 132 : *
 133 :       IRET=0
 134 :       RETURN
 135 : *
 136 : * Format handling
 137 : *
 138 : *
 139 : * Error handling
 140 : *
 141 :  9999 CONTINUE
 142 :       IRET=1
 143 :       WRITE(IOIMP,*) 'An error was detected in subroutine poelm2'
 144 :       RETURN
 145 : *
 146 : * End of subroutine POELM2
 147 : *
 148 :       END
 149 : 
 150 :  
 151 :