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