Sources Esope | Cast3M

rpelle
C RPELLE    SOURCE    CHAT      05/01/13    03:06:54     5004
      SUBROUTINE RPELLE(LMAIL,KREF,NREF,
     $     LIRFLM,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : RPELLE
C DESCRIPTION : Construction d'un liste indexée qui, à un point associe
C               les numéros des éléments qui contiennent ce point.
C               Les éléments sont stockés dans une liste indexée.
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : -
C APPELE PAR       : PROMAT
C***********************************************************************
C ENTREES            : LMAIL, KREF, NREF
C SORTIES            : LIRFLM
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 09/02/2000, version initiale
C HISTORIQUE : v1, 09/02/2000, création
C HISTORIQUE :
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 PPARAM
-INC CCOPTIO
-INC SMLENTI
      POINTEUR KREF.MLENTI
* Includes persos
*     Segment LSTIND (liste séquentielle indexée)
      INTEGER NBM,NBTVAL
      SEGMENT LSTIND
      INTEGER IDX(NBM+1)
      INTEGER IVAL(NBTVAL)
      ENDSEGMENT
*-INC SLSTIND
      POINTEUR LMAIL.LSTIND
      POINTEUR LIRFLM.LSTIND
*
      INTEGER NREF
      INTEGER IMPR,IRET
*
      INTEGER IREF,IEL
      INTEGER      NEL
      INTEGER NONOEU,NOSTRT,NOSTOP
      INTEGER NUNOEU
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpelle.eso'
* Construction de l'indexation de la liste séquentielle
* Pour l'instant LIRFLM.IDX(IREF+1)=nombre d'éléments de LMAIL
* tels que il existe un point KREF(point)=IREF
* On a supposé qu'il n'y avait pas de noeuds doubles dans les élément.
      SEGACT LMAIL
      NEL=LMAIL.IDX(/1)-1
      SEGACT KREF
      NBM=NREF
      NBTVAL=0
      SEGINI LIRFLM
      DO 1 IEL=1,NEL
         NOSTRT=LMAIL.IDX(IEL)
         NOSTOP=LMAIL.IDX(IEL+1)-1
         DO 12 NONOEU=NOSTRT,NOSTOP
            NUNOEU=LMAIL.IVAL(NONOEU)
            IREF=KREF.LECT(NUNOEU)
            IF (IREF.NE.0) THEN
               LIRFLM.IDX(IREF+1)=LIRFLM.IDX(IREF+1)+1
            ENDIF
 12      CONTINUE
 1    CONTINUE
*      SEGPRT,LIRFLM
* LIRFLM.IDX est transformé en la liste d'indexation sur
* LIRFLM.IVAL
      LIRFLM.IDX(1)=1
      DO 3 IREF=1,NREF
         LIRFLM.IDX(IREF+1)=LIRFLM.IDX(IREF+1)+LIRFLM.IDX(IREF)
 3    CONTINUE
      NBM=NREF
      NBTVAL=LIRFLM.IDX(NREF+1)-1
      SEGADJ,LIRFLM
*      SEGPRT,LIRFLM
* LIRFLM.IDX est désormais la liste des index courants sur
* LIRFLM.IVAL que l'on remplit.
      DO 5 IEL=1,NEL
         NOSTRT=LMAIL.IDX(IEL)
         NOSTOP=LMAIL.IDX(IEL+1)-1
         DO 52 NONOEU=NOSTRT,NOSTOP
            NUNOEU=LMAIL.IVAL(NONOEU)
            IREF=KREF.LECT(NUNOEU)
            IF (IREF.NE.0) THEN
               LIRFLM.IVAL(LIRFLM.IDX(IREF))=IEL
               LIRFLM.IDX(IREF)=LIRFLM.IDX(IREF)+1
            ENDIF
 52      CONTINUE
 5    CONTINUE
*      SEGPRT,LIRFLM
* On restaure les valeurs de LIRFLM.IDX
       DO 7 IREF=NREF,2,-1
          LIRFLM.IDX(IREF)=LIRFLM.IDX(IREF-1)
 7     CONTINUE
       LIRFLM.IDX(1)=1
       SEGDES LIRFLM
       SEGDES KREF
       SEGDES LMAIL
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine rpelle'
      RETURN
*
* End of subroutine RPELLE
*
      END