1 : C LI2MAS SOURCE MAGN 09/07/30 21:19:04 6458 2 : SUBROUTINE LI2MAS(ICPCDB,ICDCDB,ICOGLO, 3 : $ LMPCDB,LMDCDB,LMACDB, 4 : $ MPCDB,MDCDB,IMTCDB, 5 : $ IMPR,IRET) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : C*********************************************************************** 9 : C NOM : LI2MAS 10 : C DESCRIPTION : Transformation des listes indexées résultats en 11 : C maillages et en matrices. 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 : ICPCDB, ICDCDB, ICOGLO, LMPCDB, LMDCDB, LMACDB 22 : C SORTIES : MPCDB, MDCDB, IMTCDB 23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 24 : C*********************************************************************** 25 : C VERSION : v1, 16/02/2000, version initiale 26 : C HISTORIQUE : v1, 16/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 SMELEME 36 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 37 : POINTEUR MPCDB.MELEME 38 : POINTEUR MDCDB.MELEME 39 : POINTEUR SMPCDB.MELEME 40 : POINTEUR SMDCDB.MELEME 41 : -INC SMMATRIK 42 : INTEGER NBME 43 : POINTEUR IMTCDB.IMATRI 44 : INTEGER NBEL,NP,MP 45 : POINTEUR SMTCDB.IZAFM 46 : -INC SMLMOTS 47 : POINTEUR ICOGLO.MLMOTS 48 : -INC SMLENTI 49 : POINTEUR ICPCDB.MLENTI 50 : POINTEUR NPLPRI.MLENTI 51 : POINTEUR NPLDUA.MLENTI 52 : INTEGER JG 53 : POINTEUR KCPLPD.MLENTI 54 : * Includes persos 55 : * Segment LSTIND (liste séquentielle indexée) 56 : SEGMENT LSTIND 57 : INTEGER IDX(NBM+1) 58 : INTEGER IVAL(NBTVAL) 59 : ENDSEGMENT 60 : *-INC SLSTIND 61 : POINTEUR ICDCDB.LSTIND 62 : POINTEUR LMPCDB.LSTIND 63 : POINTEUR LMDCDB.LSTIND 64 : INTEGER NBM,NBTVAL 65 : POINTEUR CPLEL.LSTIND 66 : SEGMENT LSRIND 67 : INTEGER IDXX(NBM+1) 68 : REAL*8 XVAL(NBTVAL) 69 : ENDSEGMENT 70 : POINTEUR SMACDB.LSRIND 71 : SEGMENT LLI 72 : POINTEUR LISLI(NBME).LSRIND 73 : ENDSEGMENT 74 : POINTEUR LMACDB.LLI 75 : * 76 : INTEGER IMPR,IRET 77 : * 78 : INTEGER IBCLPD,ILCDB,IIPRI,IMP,INP 79 : INTEGER NBCLPD,NLCDB,NIPRI 80 : INTEGER IVPLEL,IVSTRT,IVSTOP 81 : INTEGER IBME,IBSTRT,IBSTOP 82 : INTEGER JVPCDB,JVSTRT,JVSTOP 83 : INTEGER JVDCDB,JVPLEL 84 : INTEGER KVSTRT 85 : INTEGER NUEL,NUEL1,KICPD 86 : INTEGER ICPD,NPPCDB,NPDCDB,NTCLPD 87 : INTEGER MXPCDB,MXDCDB 88 : * 89 : * Executable statements 90 : * 91 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans li2mas.eso' 92 : * SEGPRT,ICPCDB 93 : * SEGPRT,ICDCDB 94 : * SEGPRT,ICOGLO 95 : * SEGPRT,LMPCDB 96 : * SEGPRT,LMDCDB 97 : * SEGPRT,LMACDB 98 : * SEGACT LMACDB 99 : * LSRIND=LMACDB.LISLI(1) 100 : * SEGPRT,LSRIND 101 : 102 : * 103 : * Il faut construire une partition de la matrice LMACDB 104 : * dont les supports primaux et duaux sont LMPCDB et LMDCDB 105 : * 106 : * Comptons le nb max. de points de LMPCDB et de LMDCDB pour 107 : * dimensionnement du tableau de repérage dans la partition : 108 : * On crée aussi les tableaux de nb. de points par éléments (plus 109 : * pratiques) 110 : SEGACT LMPCDB 111 : SEGACT LMDCDB 112 : NLCDB=LMPCDB.IDX(/1)-1 113 : * D'abord, on crée les tableaux de nb. de points par éléments (plus 114 : * pratiques) 115 : JG=NLCDB 116 : SEGINI NPLPRI 117 : SEGINI NPLDUA 118 : MXPCDB=0 119 : MXDCDB=0 120 : DO 1 ILCDB=1,NLCDB 121 : NPPCDB=LMPCDB.IDX(ILCDB+1)-LMPCDB.IDX(ILCDB) 122 : NPLPRI.LECT(ILCDB)=NPPCDB 123 : MXPCDB=MAX(MXPCDB,NPPCDB) 124 : NPDCDB=LMDCDB.IDX(ILCDB+1)-LMDCDB.IDX(ILCDB) 125 : NPLDUA.LECT(ILCDB)=NPDCDB 126 : MXDCDB=MAX(MXDCDB,NPDCDB) 127 : 1 CONTINUE 128 : SEGDES LMDCDB 129 : SEGDES LMPCDB 130 : * SEGPRT,NPLPRI 131 : * SEGPRT,NPLDUA 132 : * WRITE(IOIMP,*) 'MXPCDB=',MXPCDB 133 : * WRITE(IOIMP,*) 'MXDCDB=',MXDCDB 134 : * Dimension de l'espace des couples (nb. points primaux, nb. points 135 : * duaux) 136 : NTCLPD=MXPCDB*MXDCDB 137 : JG=NTCLPD 138 : SEGINI KCPLPD 139 : * Nb. de couples distincts et segment de repérage sur ces couples 140 : IBCLPD=0 141 : DO 2 ILCDB=1,NLCDB 142 : ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB) 143 : $ +NPLDUA.LECT(ILCDB) 144 : IF (KCPLPD.LECT(ICPD).EQ.0) THEN 145 : IBCLPD=IBCLPD+1 146 : KCPLPD.LECT(ICPD)=IBCLPD 147 : ENDIF 148 : 2 CONTINUE 149 : NBCLPD=IBCLPD 150 : * Création d'une liste indexée : 151 : * A chaque couple repéré par son numéro d'ordre, on associe 152 : * les numéros d'éléments ILCDB 153 : * Dimensionnement de CPLEL 154 : * Pour l'instant CPLEL.IDX(IBCLPD+1)=nombre d'éléments associés au 155 : * IBCLPDème couple. 156 : NBM=NBCLPD 157 : NBTVAL=0 158 : SEGINI CPLEL 159 : DO 3 ILCDB=1,NLCDB 160 : ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB) 161 : $ +NPLDUA.LECT(ILCDB) 162 : KICPD=KCPLPD.LECT(ICPD) 163 : CPLEL.IDX(KICPD+1)=CPLEL.IDX(KICPD+1)+1 164 : 3 CONTINUE 165 : * CPLEL.IDX est transformé en la liste d'indexation sur CPLEL.IVAL 166 : CPLEL.IDX(1)=1 167 : DO 4 IBCLPD=1,NBCLPD 168 : CPLEL.IDX(IBCLPD+1)=CPLEL.IDX(IBCLPD+1)+CPLEL.IDX(IBCLPD) 169 : 4 CONTINUE 170 : NBM=NBCLPD 171 : NBTVAL=CPLEL.IDX(NBCLPD+1)-1 172 : SEGADJ,CPLEL 173 : * CPLEL.IDX est désormais la liste des index courants sur 174 : * CPLEL.IVAL que l'on remplit. 175 : DO 5 ILCDB=1,NLCDB 176 : ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB) 177 : $ +NPLDUA.LECT(ILCDB) 178 : KICPD=KCPLPD.LECT(ICPD) 179 : CPLEL.IVAL(CPLEL.IDX(KICPD))=ILCDB 180 : CPLEL.IDX(KICPD)=CPLEL.IDX(KICPD)+1 181 : 5 CONTINUE 182 : * On restaure les valeurs de CPLEL.IDX 183 : DO 6 IBCLPD=NBCLPD,2,-1 184 : CPLEL.IDX(IBCLPD)=CPLEL.IDX(IBCLPD-1) 185 : 6 CONTINUE 186 : CPLEL.IDX(1)=1 187 : * 188 : * Création et remplissage de MPCDB 189 : * 190 : SEGACT LMPCDB 191 : NBNN=0 192 : NBELEM=0 193 : NBSOUS=NBCLPD 194 : NBREF=0 195 : C SEGINI MPCDB 196 : SEGINI MPCDB 197 : DO 7 IBCLPD=1,NBCLPD 198 : IVSTRT=CPLEL.IDX(IBCLPD) 199 : IVSTOP=CPLEL.IDX(IBCLPD+1)-1 200 : NUEL1=CPLEL.IVAL(IVSTRT) 201 : NBNN=NPLPRI.LECT(NUEL1) 202 : NBELEM=IVSTOP-IVSTRT+1 203 : NBSOUS=0 204 : NBREF=0 205 : SEGINI SMPCDB 206 : * Type d'élément : POLY (cf. bdata.eso) 207 : SMPCDB.ITYPEL=32 208 : DO 72 IVPLEL=IVSTRT,IVSTOP 209 : NUEL=CPLEL.IVAL(IVPLEL) 210 : JVSTRT=LMPCDB.IDX(NUEL) 211 : JVSTOP=LMPCDB.IDX(NUEL+1)-1 212 : DO 722 JVPCDB=JVSTRT,JVSTOP 213 : SMPCDB.NUM(JVPCDB-JVSTRT+1,IVPLEL-IVSTRT+1)= 214 : $ LMPCDB.IVAL(JVPCDB) 215 : 722 CONTINUE 216 : 72 CONTINUE 217 : SEGDES SMPCDB 218 : MPCDB.LISOUS(IBCLPD)=SMPCDB 219 : 7 CONTINUE 220 : IF (NBCLPD.EQ.1) THEN 221 : SMPCDB=MPCDB.LISOUS(1) 222 : SEGSUP MPCDB 223 : MPCDB=SMPCDB 224 : ELSE 225 : SEGDES MPCDB 226 : ENDIF 227 : SEGDES LMPCDB 228 : * 229 : * Création et remplissage de MDCDB 230 : * 231 : SEGACT LMDCDB 232 : NBNN=0 233 : NBELEM=0 234 : NBSOUS=NBCLPD 235 : NBREF=0 236 : C SEGINI MDCDB 237 : SEGINI MDCDB 238 : DO 8 IBCLPD=1,NBCLPD 239 : IVSTRT=CPLEL.IDX(IBCLPD) 240 : IVSTOP=CPLEL.IDX(IBCLPD+1)-1 241 : NUEL1=CPLEL.IVAL(IVSTRT) 242 : NBNN=NPLDUA.LECT(NUEL1) 243 : NBELEM=IVSTOP-IVSTRT+1 244 : NBSOUS=0 245 : NBREF=0 246 : SEGINI SMDCDB 247 : * Type d'élément : POLY (cf. bdata.eso) 248 : SMDCDB.ITYPEL=32 249 : DO 82 IVPLEL=IVSTRT,IVSTOP 250 : NUEL=CPLEL.IVAL(IVPLEL) 251 : JVSTRT=LMDCDB.IDX(NUEL) 252 : JVSTOP=LMDCDB.IDX(NUEL+1)-1 253 : DO 822 JVDCDB=JVSTRT,JVSTOP 254 : SMDCDB.NUM(JVDCDB-JVSTRT+1,IVPLEL-IVSTRT+1)= 255 : $ LMDCDB.IVAL(JVDCDB) 256 : 822 CONTINUE 257 : 82 CONTINUE 258 : SEGDES SMDCDB 259 : MDCDB.LISOUS(IBCLPD)=SMDCDB 260 : 8 CONTINUE 261 : IF (NBCLPD.EQ.1) THEN 262 : SMDCDB=MDCDB.LISOUS(1) 263 : SEGSUP MDCDB 264 : MDCDB=SMDCDB 265 : ELSE 266 : SEGDES MDCDB 267 : ENDIF 268 : SEGDES LMDCDB 269 : * 270 : * Création et remplissage de IMTCDB 271 : * 272 : SEGACT ICOGLO 273 : SEGACT ICPCDB 274 : SEGACT ICDCDB 275 : SEGACT LMPCDB 276 : SEGACT LMDCDB 277 : SEGACT LMACDB 278 : NBME=ICDCDB.IVAL(/1) 279 : NBSOUS=NBCLPD 280 : SEGINI IMTCDB 281 : NIPRI=ICPCDB.LECT(/1) 282 : DO 9 IIPRI=1,NIPRI 283 : IBSTRT=ICDCDB.IDX(IIPRI) 284 : IBSTOP=ICDCDB.IDX(IIPRI+1)-1 285 : DO 92 IBME=IBSTRT,IBSTOP 286 : IMTCDB.LISPRI(IBME)=ICOGLO.MOTS(ICPCDB.LECT(IIPRI)) 287 : IMTCDB.LISDUA(IBME)=ICOGLO.MOTS(ICDCDB.IVAL(IBME)) 288 : SMACDB=LMACDB.LISLI(IBME) 289 : SEGACT SMACDB 290 : DO 922 IBCLPD=1,NBCLPD 291 : JVSTRT=CPLEL.IDX(IBCLPD) 292 : JVSTOP=CPLEL.IDX(IBCLPD+1)-1 293 : NUEL1=CPLEL.IVAL(JVSTRT) 294 : NBEL=JVSTOP-JVSTRT+1 295 : NP=NPLPRI.LECT(NUEL1) 296 : MP=NPLDUA.LECT(NUEL1) 297 : SEGINI SMTCDB 298 : DO 9222 JVPLEL=JVSTRT,JVSTOP 299 : NUEL=CPLEL.IVAL(JVPLEL) 300 : KVSTRT=SMACDB.IDXX(NUEL) 301 : DO 92222 IMP=1,MP 302 : DO 92224 INP=1,NP 303 : SMTCDB.AM(JVPLEL-JVSTRT+1,INP,IMP)= 304 : $ SMACDB.XVAL(KVSTRT) 305 : KVSTRT=KVSTRT+1 306 : 92224 CONTINUE 307 : 92222 CONTINUE 308 : 9222 CONTINUE 309 : SEGDES SMTCDB 310 : IMTCDB.LIZAFM(IBCLPD,IBME)=SMTCDB 311 : 922 CONTINUE 312 : SEGDES SMACDB 313 : 92 CONTINUE 314 : 9 CONTINUE 315 : SEGDES IMTCDB 316 : SEGDES LMACDB 317 : SEGDES LMDCDB 318 : SEGDES LMPCDB 319 : SEGDES ICDCDB 320 : SEGDES ICPCDB 321 : SEGDES ICOGLO 322 : SEGSUP CPLEL 323 : SEGSUP KCPLPD 324 : SEGSUP NPLDUA 325 : SEGSUP NPLPRI 326 : * SEGPRT,MPCDB 327 : * SEGPRT,MDCDB 328 : * SEGPRT,IMTCDB 329 : * 330 : * Normal termination 331 : * 332 : IRET=0 333 : RETURN 334 : * 335 : * Format handling 336 : * 337 : * 338 : * Error handling 339 : * 340 : 9999 CONTINUE 341 : IRET=1 342 : WRITE(IOIMP,*) 'An error was detected in subroutine li2mas' 343 : RETURN 344 : * 345 : * End of subroutine LI2MAS 346 : * 347 : END 348 : 349 : 350 : 351 : 352 :
© Cast3M 2003 - All rights reserved.
Disclaimer