1 : C MKLBLC SOURCE PV 06/04/16 21:16:53 5405 2 : SUBROUTINE MKLBLC(LMPRIB,KRMPRI,LIPNLC,NELC, 3 : $ LILBLC, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : MKLBLC 9 : C DESCRIPTION : Construction d'une liste indexée de correspondance : 10 : C matrice élémentaire B -> liste des matrices élémentaires 11 : C ayant un point de leurs maillages primaux en commun. 12 : C 13 : C 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 : LMPRIB, KRMPRI, LIPNLC, NELC 23 : C SORTIES : LILBLC 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 07/02/2000, version initiale 27 : C HISTORIQUE : v1, 07/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 KRMPRI.MLENTI 38 : INTEGER JG 39 : POINTEUR KRELC.MLENTI 40 : * Includes persos 41 : * Segment LSTIND (liste séquentielle indexée) 42 : INTEGER NBM,NBTVAL 43 : SEGMENT LSTIND 44 : INTEGER IDX(NBM+1) 45 : INTEGER IVAL(NBTVAL) 46 : ENDSEGMENT 47 : *-INC SLSTIND 48 : POINTEUR LMPRIB.LSTIND 49 : POINTEUR LIPNLC.LSTIND 50 : POINTEUR LILBLC.LSTIND 51 : * 52 : INTEGER NELC 53 : INTEGER IMPR,IRET 54 : * 55 : INTEGER LDG,NELB 56 : INTEGER IDG,IELB,IELC,ILPOPB 57 : INTEGER IVPRIB,IVSTRT,IVSTOP 58 : INTEGER JVPNLC,JVSTRT,JVSTOP 59 : INTEGER IVLBLC,LAST,PREC 60 : * 61 : * Executable statements 62 : * 63 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mklblc.eso' 64 : * Dimensionnement de LILBLC 65 : * Pour l'instant LILBLC.IDX(IELB+1)=nombre de matrices élémentaires de 66 : * IMATC reliées à la IELBème matrice élémentaire de IMATB 67 : SEGACT LMPRIB 68 : NELB=LMPRIB.IDX(/1)-1 69 : SEGACT KRMPRI 70 : SEGACT LIPNLC 71 : JG=NELC 72 : SEGINI KRELC 73 : NBM=NELB 74 : NBTVAL=0 75 : SEGINI LILBLC 76 : DO 1 IELB=1,NELB 77 : * Degré et fin de la liste chaînée 78 : LDG=0 79 : LAST=-1 80 : IVSTRT=LMPRIB.IDX(IELB) 81 : IVSTOP=LMPRIB.IDX(IELB+1)-1 82 : DO 12 IVPRIB=IVSTRT,IVSTOP 83 : ILPOPB=KRMPRI.LECT(LMPRIB.IVAL(IVPRIB)) 84 : ** pv que faire si ilpopb=0 ????? 85 : if (ilpopb.eq.0) goto 12 86 : JVSTRT=LIPNLC.IDX(ILPOPB) 87 : JVSTOP=LIPNLC.IDX(ILPOPB+1)-1 88 : DO 122 JVPNLC=JVSTRT,JVSTOP 89 : IELC=LIPNLC.IVAL(JVPNLC) 90 : IF (KRELC.LECT(IELC).EQ.0) THEN 91 : LDG=LDG+1 92 : KRELC.LECT(IELC)=LAST 93 : LAST=IELC 94 : ENDIF 95 : 122 CONTINUE 96 : 12 CONTINUE 97 : LILBLC.IDX(IELB+1)=LDG 98 : * Remise à zéro de la liste chaînée 99 : DO 14 IDG=1,LDG 100 : PREC=KRELC.LECT(LAST) 101 : KRELC.LECT(LAST)=0 102 : LAST=PREC 103 : 14 CONTINUE 104 : 1 CONTINUE 105 : * LILBLC.IDX est transformé en la liste d'indexation sur 106 : * LILBLC.IVAL 107 : LILBLC.IDX(1)=1 108 : DO 3 IELB=1,NELB 109 : LILBLC.IDX(IELB+1)=LILBLC.IDX(IELB+1)+LILBLC.IDX(IELB) 110 : 3 CONTINUE 111 : NBM=NELB 112 : NBTVAL=LILBLC.IDX(NELB+1)-1 113 : SEGADJ,LILBLC 114 : * Remplissage de LILBLC 115 : IVLBLC=0 116 : DO 5 IELB=1,NELB 117 : * Degré et fin de la liste chaînée 118 : LDG=0 119 : LAST=-1 120 : IVSTRT=LMPRIB.IDX(IELB) 121 : IVSTOP=LMPRIB.IDX(IELB+1)-1 122 : DO 52 IVPRIB=IVSTRT,IVSTOP 123 : ILPOPB=KRMPRI.LECT(LMPRIB.IVAL(IVPRIB)) 124 : ** pv que faire si ilpopb=0 ????? 125 : if (ilpopb.eq.0) goto 52 126 : JVSTRT=LIPNLC.IDX(ILPOPB) 127 : JVSTOP=LIPNLC.IDX(ILPOPB+1)-1 128 : DO 522 JVPNLC=JVSTRT,JVSTOP 129 : IELC=LIPNLC.IVAL(JVPNLC) 130 : IF (KRELC.LECT(IELC).EQ.0) THEN 131 : LDG=LDG+1 132 : KRELC.LECT(IELC)=LAST 133 : LAST=IELC 134 : ENDIF 135 : 522 CONTINUE 136 : 52 CONTINUE 137 : * Remise à zéro de la liste chaînée et vidage dans LILBLC 138 : DO 54 IDG=1,LDG 139 : PREC=KRELC.LECT(LAST) 140 : IVLBLC=IVLBLC+1 141 : LILBLC.IVAL(IVLBLC)=LAST 142 : KRELC.LECT(LAST)=0 143 : LAST=PREC 144 : 54 CONTINUE 145 : 5 CONTINUE 146 : SEGDES LILBLC 147 : SEGSUP KRELC 148 : SEGDES LIPNLC 149 : SEGDES KRMPRI 150 : SEGDES LMPRIB 151 : * 152 : * Normal termination 153 : * 154 : IRET=0 155 : RETURN 156 : * 157 : * Format handling 158 : * 159 : * 160 : * Error handling 161 : * 162 : 9999 CONTINUE 163 : IRET=1 164 : WRITE(IOIMP,*) 'An error was detected in subroutine mklblc' 165 : RETURN 166 : * 167 : * End of subroutine MKLBLC 168 : * 169 : END 170 : 171 : 172 : 173 :
© Cast3M 2003 - All rights reserved.
Disclaimer