Sources Esope | Cast3M

rpenle
C RPENLE    SOURCE    CHAT      05/01/13    03:07:08     5004
      SUBROUTINE RPENLE(LENTI,KREF,NREF,
     $     LIREEN,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : RPENLE
C DESCRIPTION : On construit LIREEN :
C               LIREEN(IREF)=liste des entiers i
C                  tels que : KREF(LENTI(i))=IREF
C Construction d'un liste indexée qui, à un entier associe les positions
C des occurences de cet entier dans une liste d'entiers.
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            : LENTI, KREF, NREF
C SORTIES            : LIREEN
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 04/02/2000, version initiale
C HISTORIQUE : v1, 04/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 LENTI.MLENTI
      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 LIREEN.LSTIND
*
      INTEGER NREF
      INTEGER IMPR,IRET
*
      INTEGER NENTI
      INTEGER IENTI,IREF,IEGLO
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpenle.eso'
* Construction de l'indexation de la liste séquentielle
* Pour l'instant LIREEN.IDX(IREF+1)=nombre d'éléments de LENTI()
* tels que KREF(LENTI())=IREF
      SEGACT LENTI
      NENTI=LENTI.LECT(/1)
      SEGACT KREF
      NBM=NREF
      NBTVAL=0
      SEGINI LIREEN
      DO 1 IENTI=1,NENTI
         IEGLO=LENTI.LECT(IENTI)
         IREF=KREF.LECT(IEGLO)
         LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+1
 1    CONTINUE
*      SEGPRT,LIREEN
* LIREEN.IDX est transformé en la liste d'indexation sur
* LIREEN.IVAL
      LIREEN.IDX(1)=1
      DO 3 IREF=1,NREF
         LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+LIREEN.IDX(IREF)
 3    CONTINUE
      NBM=NREF
      NBTVAL=LIREEN.IDX(NREF+1)-1
      SEGADJ,LIREEN
*      SEGPRT,LIREEN
* LIREEN.IDX est désormais la liste des index courants sur
* LIREEN.IVAL que l'on remplit.
      DO 5 IENTI=1,NENTI
         IEGLO=LENTI.LECT(IENTI)
         IREF=KREF.LECT(IEGLO)
         LIREEN.IVAL(LIREEN.IDX(IREF))=IENTI
         LIREEN.IDX(IREF)=LIREEN.IDX(IREF)+1
 5    CONTINUE
*      SEGPRT,LIREEN
* On restaure les valeurs de LIREEN.IDX
       DO 7 IREF=NREF,2,-1
          LIREEN.IDX(IREF)=LIREEN.IDX(IREF-1)
 7     CONTINUE
       LIREEN.IDX(1)=1
       SEGDES LIREEN
       SEGDES LENTI
       SEGDES KREF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine rpenle'
      RETURN
*
* End of subroutine RPENLE
*
      END