Esope source files

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