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