1 : C RPENLE SOURCE CHAT 05/01/13 03:07:08 5004 2 : SUBROUTINE RPENLE(LENTI,KREF,NREF, 3 : $ LIREEN, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : RPENLE 9 : C DESCRIPTION : On construit LIREEN : 10 : C LIREEN(IREF)=liste des entiers i 11 : C tels que : KREF(LENTI(i))=IREF 12 : C Construction d'un liste indexée qui, à un entier associe les positions 13 : C des occurences de cet entier dans une liste d'entiers. 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C APPELES : - 20 : C APPELE PAR : PROMAT 21 : C*********************************************************************** 22 : C ENTREES : LENTI, KREF, NREF 23 : C SORTIES : LIREEN 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 04/02/2000, version initiale 27 : C HISTORIQUE : v1, 04/02/2000, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : -INC SMLENTI 37 : POINTEUR LENTI.MLENTI 38 : POINTEUR KREF.MLENTI 39 : * Includes persos 40 : * Segment LSTIND (liste séquentielle indexée) 41 : INTEGER NBM,NBTVAL 42 : SEGMENT LSTIND 43 : INTEGER IDX(NBM+1) 44 : INTEGER IVAL(NBTVAL) 45 : ENDSEGMENT 46 : *-INC SLSTIND 47 : POINTEUR LIREEN.LSTIND 48 : * 49 : INTEGER NREF 50 : INTEGER IMPR,IRET 51 : * 52 : INTEGER NENTI 53 : INTEGER IENTI,IREF,IEGLO 54 : * 55 : * Executable statements 56 : * 57 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpenle.eso' 58 : * Construction de l'indexation de la liste séquentielle 59 : * Pour l'instant LIREEN.IDX(IREF+1)=nombre d'éléments de LENTI() 60 : * tels que KREF(LENTI())=IREF 61 : SEGACT LENTI 62 : NENTI=LENTI.LECT(/1) 63 : SEGACT KREF 64 : NBM=NREF 65 : NBTVAL=0 66 : SEGINI LIREEN 67 : DO 1 IENTI=1,NENTI 68 : IEGLO=LENTI.LECT(IENTI) 69 : IREF=KREF.LECT(IEGLO) 70 : LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+1 71 : 1 CONTINUE 72 : * SEGPRT,LIREEN 73 : * LIREEN.IDX est transformé en la liste d'indexation sur 74 : * LIREEN.IVAL 75 : LIREEN.IDX(1)=1 76 : DO 3 IREF=1,NREF 77 : LIREEN.IDX(IREF+1)=LIREEN.IDX(IREF+1)+LIREEN.IDX(IREF) 78 : 3 CONTINUE 79 : NBM=NREF 80 : NBTVAL=LIREEN.IDX(NREF+1)-1 81 : SEGADJ,LIREEN 82 : * SEGPRT,LIREEN 83 : * LIREEN.IDX est désormais la liste des index courants sur 84 : * LIREEN.IVAL que l'on remplit. 85 : DO 5 IENTI=1,NENTI 86 : IEGLO=LENTI.LECT(IENTI) 87 : IREF=KREF.LECT(IEGLO) 88 : LIREEN.IVAL(LIREEN.IDX(IREF))=IENTI 89 : LIREEN.IDX(IREF)=LIREEN.IDX(IREF)+1 90 : 5 CONTINUE 91 : * SEGPRT,LIREEN 92 : * On restaure les valeurs de LIREEN.IDX 93 : DO 7 IREF=NREF,2,-1 94 : LIREEN.IDX(IREF)=LIREEN.IDX(IREF-1) 95 : 7 CONTINUE 96 : LIREEN.IDX(1)=1 97 : SEGDES LIREEN 98 : SEGDES LENTI 99 : SEGDES KREF 100 : * 101 : * Normal termination 102 : * 103 : IRET=0 104 : RETURN 105 : * 106 : * Format handling 107 : * 108 : * 109 : * Error handling 110 : * 111 : 9999 CONTINUE 112 : IRET=1 113 : WRITE(IOIMP,*) 'An error was detected in subroutine rpenle' 114 : RETURN 115 : * 116 : * End of subroutine RPENLE 117 : * 118 : END 119 : 120 : 121 :
© Cast3M 2003 - All rights reserved.
Disclaimer