Esope source files

   1 : C POPOIN    SOURCE    CHAT      05/01/13    02:17:47     5004           
   2 :       SUBROUTINE POPOIN(P2ELPR,MELDUA,POPPOD,
   3 :      $     LPPPD,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : POPOIN
   9 : C DESCRIPTION : Maillage + liste indexée d'entiers (poelm2) + liste
  10 : C               d'entiers (ponbpo) => liste indexée d'entiers (un
  11 : C               point)->(numéro des points adjacents). 
  12 : C
  13 : C     - Construire la liste indexée suivante (LPPPD) :
  14 : C         * Nombre de multiplets = nb points P1 de MELPRI
  15 : C         * pour chaque P1 : numéro des points P2 de MELDUA avec
  16 : C           lesquels il a une liaison.
  17 : C
  18 : C LANGAGE     : ESOPE
  19 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  20 : C               mél : gounand@semt2.smts.cea.fr
  21 : C***********************************************************************
  22 : C APPELES (ESOPE)  : OOOETA
  23 : C APPELES          : ACTMEL, INIRPL, RPELEM, DESMEL
  24 : C APPELE PAR       : MAKPRM
  25 : C***********************************************************************
  26 : C ENTREES            : P2ELPR, MELDUA, POPPOD
  27 : C SORTIES            : LPPPD
  28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29 : C***********************************************************************
  30 : C VERSION    : v2, 15/12/99
  31 : C HISTORIQUE : v1, 06/10/99, création
  32 : C HISTORIQUE : v2, 15/12/99, utilisation de liste chaînées
  33 : C HISTORIQUE :
  34 : C HISTORIQUE :
  35 : C***********************************************************************
  36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37 : C en cas de modification de ce sous-programme afin de faciliter
  38 : C la maintenance !
  39 : C***********************************************************************
  40 : -INC CCOPTIO
  41 : -INC SMCOORD
  42 : -INC SMELEME
  43 :       POINTEUR MELDUA.MELEME
  44 :       POINTEUR SOUMDU.MELEME
  45 : -INC SMLENTI
  46 :       INTEGER JG
  47 :       POINTEUR POPPOD.MLENTI
  48 :       POINTEUR RPDUAL.MLENTI
  49 :       POINTEUR IWORK.MLENTI
  50 : *
  51 : * Includes persos
  52 : *
  53 : *-INC SLSTIND
  54 : *
  55 : *     Segment LSTIND (liste séquentielle indexée)
  56 : *
  57 :       SEGMENT LSTIND
  58 :       INTEGER IDX(NBM+1)
  59 :       INTEGER IVAL(NBTVAL)
  60 :       ENDSEGMENT
  61 : *
  62 : *     LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  63 : *
  64 : *     NBM      : NOMBRE DE MULTIPLETS
  65 : *     NBTVAL   : NOMBRE TOTAL DE VALEURS 
  66 : *     IDX(I)   : INDICE DE LA PREMIERE VALEUR DU IEME 
  67 : *                MULTIPLET DANS LE TABLEAU IVAL
  68 : *     IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  69 :       POINTEUR P2ELPR.LSTIND
  70 :       POINTEUR LPPPD.LSTIND
  71 : *
  72 :       INTEGER IMPR,IRET
  73 : *
  74 :       INTEGER POETA,P2LETA
  75 :       INTEGER ILPPPD,IDEPA,IELDUA,IPLDU,IPPRI
  76 :       INTEGER NBTVAL,NOELDU,NOSODU,NPODUA,NBPLDU,NPPRI,NUMELD,NBM
  77 : *
  78 : * Executable statements
  79 : *
  80 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans popoin.eso' 
  80 :       CALL OOOETA(POPPOD,POETA)
  81 :       IF (POETA.NE.1) SEGACT POPPOD
  82 :       NPPRI=POPPOD.LECT(/1)
  83 : C   On initialise le segment LPPPD
  84 :       NBM=NPPRI
  85 :       NBTVAL=0
  86 :       SEGINI LPPPD
  87 :       IDEPA=1
  88 :       DO 2 IPPRI=1,NPPRI
  89 :          LPPPD.IDX(IPPRI)=IDEPA
  90 :          IDEPA=IDEPA+POPPOD.LECT(IPPRI)
  91 :  2    CONTINUE
  92 :       LPPPD.IDX(NPPRI+1)=IDEPA
  93 :       IF (POETA.NE.1) SEGDES POPPOD
  94 :       NBTVAL=IDEPA-1
  95 :       SEGADJ LPPPD
  96 : * Activations
  96 :       CALL OOOETA(P2ELPR,P2LETA)
  97 :       IF (P2LETA.NE.1) SEGACT P2ELPR
  98 :       JG=XCOOR(/1)/(IDIM+1)
  99 :       SEGINI IWORK
  99 :       CALL ACTMEL(MELDUA)
 100 : * In INIRPL : SEGINI RPDUAL
 100 :       CALL INIRPL(MELDUA,
 101 :      $     RPDUAL,
 102 :      $     IMPR,IRET)
 103 :       IF (IRET.NE.0) GOTO 9999
 104 : *
 105 : *   Parcourons le maillage
 106 : *
 107 :       DO 5 IPPRI=1,NPPRI
 108 :          ILPPPD=LPPPD.IDX(IPPRI)-1
 109 :          DO 52 IELDUA=P2ELPR.IDX(IPPRI),
 110 :      $                P2ELPR.IDX(IPPRI+1)-1
 111 :             NUMELD=P2ELPR.IVAL(IELDUA)
 111 :             CALL RPELEM(NUMELD,RPDUAL,
 112 :      $           NOSODU,NOELDU,
 113 :      $           IMPR,IRET)
 114 :             IF (IRET.NE.0) GOTO 9999
 115 :             IF (NOSODU.NE.0) THEN
 116 :                SOUMDU=MELDUA.LISOUS(NOSODU)
 117 :             ELSE 
 118 :                SOUMDU=MELDUA
 119 :             ENDIF
 120 :             NBPLDU=SOUMDU.NUM(/1)
 121 :             DO 522 IPLDU=1,NBPLDU
 122 :                NPODUA=SOUMDU.NUM(IPLDU,NOELDU)
 123 :                IF (IWORK.LECT(NPODUA).EQ.0) THEN
 124 :                   ILPPPD=ILPPPD+1
 125 :                   LPPPD.IVAL(ILPPPD)=NPODUA
 126 :                   IWORK.LECT(NPODUA)=ILPPPD
 127 :                ENDIF
 128 :  522        CONTINUE
 129 :  52      CONTINUE
 130 : *     On remet le segment de travail à zéro
 131 :          DO 54 ILPPPD=LPPPD.IDX(IPPRI),LPPPD.IDX(IPPRI+1)-1
 132 :             IWORK.LECT(LPPPD.IVAL(ILPPPD))=0
 133 :  54      CONTINUE
 134 :  5    CONTINUE
 135 :       SEGSUP RPDUAL
 135 :       CALL DESMEL(MELDUA)
 136 :       SEGSUP IWORK
 137 :       IF (P2LETA.NE.1) SEGDES P2ELPR
 138 :       SEGDES LPPPD
 139 : *
 140 : * Normal termination
 141 : *
 142 :       IRET=0
 143 :       RETURN
 144 : *
 145 : * Format handling
 146 : *
 147 : *
 148 : * Error handling
 149 : *
 150 :  9999 CONTINUE
 151 :       IRET=1
 152 :       WRITE(IOIMP,*) 'An error was detected in subroutine popoin'
 153 :       RETURN
 154 : *
 155 : * End of subroutine POPOIN
 156 : *
 157 :       END
 158 : 
 159 :  
 160 :