1 : C CALNU4 SOURCE GOUNAND 11/04/29 21:15:11 6947 2 : SUBROUTINE CALNU4(LITYP,LINIV,KMINCT,PMTOT, 3 : $ IRENU, 4 : $ NEWNUM, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CALNU4 10 : C PROJET : Noyau linéaire NLIN 11 : C DESCRIPTION : Calcul d'une renumérotation avec minimisation d'un 12 : C profil PUIS placement des inconnues suivant l'ordre 13 : C donné par LIORD 14 : C Dans calnum, on effectuait les choses suivantes : 15 : C - minimisation du profil sur les ddl sans les ML. 16 : C - insertion des ML dans la nouvelle numérotation 17 : C Maintenant, on essaie la chose suivante : 18 : C - minimisation du profil sur les ddl AVEC les ML.; 19 : C - retrait des ML de la numérotation ; 20 : C - réinsertion des ML pour les placer après les ddl non 21 : C ML auxquels ils sont liés. 22 : C 23 : C IRENU=1 'RIEN' : pas de renumérotation 24 : C 2 'SLOA' : algorithme de chez Sloan 25 : C 3 'GIPR' : Gibbs-King (profile reduction) 26 : C 4 'GIBA' : Gibbs-Poole-Stockmeyer (bandwidth reduction) 27 : C 28 : C LANGAGE : ESOPE 29 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 30 : C mél : gounand@semt2.smts.cea.fr 31 : C*********************************************************************** 32 : C APPELES : RENUME 33 : C APPELES (UTIL.) : ISETI, ISHELI, RSETXI 34 : C APPELE PAR : PRASEM 35 : C*********************************************************************** 36 : C ENTREES : KMINCT, PMTOT, IRENU 37 : C SORTIES : NEWNUM 38 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 39 : C*********************************************************************** 40 : C VERSION : v1, 01/04/04, version initiale 41 : C HISTORIQUE : v1, 01/04/04, création 42 : C HISTORIQUE : 43 : C HISTORIQUE : 44 : C*********************************************************************** 45 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 46 : C en cas de modification de ce sous-programme afin de faciliter 47 : C la maintenance ! 48 : C*********************************************************************** 49 : -INC CCOPTIO 50 : -INC SMMATRIK 51 : POINTEUR KMINCT.MINC 52 : POINTEUR PMTOT.PMORS 53 : -INC SMLENTI 54 : INTEGER JG 55 : POINTEUR LITYP.MLENTI 56 : POINTEUR LINIV.MLENTI 57 : POINTEUR DDLINC.MLENTI 58 : *inu POINTEUR DDLPT.MLENTI 59 : POINTEUR NEWNUM.MLENTI 60 : POINTEUR KRDDL.MLENTI 61 : POINTEUR NNUTOT.MLENTI 62 : POINTEUR PRMDDL.MLENTI 63 : SEGMENT LML 64 : POINTEUR ML(NINC).MLENTI 65 : ENDSEGMENT 66 : POINTEUR DDLDIM.MLENTI 67 : POINTEUR ITTDDL.MLENTI 68 : POINTEUR INUDDL.MLENTI 69 : POINTEUR LDD.LML 70 : POINTEUR LDDI.MLENTI 71 : POINTEUR NNU.LML 72 : POINTEUR NNUI.MLENTI 73 : POINTEUR NNUJ.MLENTI 74 : POINTEUR NNUK.MLENTI 75 : POINTEUR PRM.LML 76 : POINTEUR PRMI.MLENTI 77 : *-INC SMLLOGI 78 : SEGMENT MLLOGI 79 : LOGICAL LOGI(JG) 80 : ENDSEGMENT 81 : POINTEUR DDLOK.MLLOGI 82 : * POINTEUR PTLAG.MLLOGI 83 : POINTEUR DDLLAG.MLLOGI 84 : * 85 : *STAT-INC SMSTAT 86 : * 87 : INTEGER IMPR,IRET 88 : INTEGER IRENU 89 : * 90 : INTEGER ITOTPO,JTTDDL 91 : INTEGER NTOTPO,NTTDDL 92 : LOGICAL LLAG,LRELA 93 : * 94 : * Executable statements 95 : * 96 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calnu4' 97 : * 98 : * Construction de DDLINC : c'est un tableau d'entiers tel que : 99 : * DDLINC(jttddl) = ordre du ddl 100 : * 101 : * SEGPRT,KMINCT 102 : * SEGPRT,PMTOT 103 : * SEGPRT,LITYP 104 : * SEGPRT,LINIV 105 : SEGACT KMINCT 106 : SEGACT LITYP 107 : SEGACT LINIV 108 : NINC=KMINCT.LISINC(/2) 109 : MAXNIV=0 110 : DO IINC=1,NINC 111 : MAXNIV=MAX(MAXNIV,LINIV.LECT(IINC)) 112 : ENDDO 113 : * 114 : * Construction de DDLINC et DDLPT : sorte de segment réciproque 115 : * de KMINCT 116 : * En fait, DDLPT est inutile pour la suite. 117 : * Construction de DDLLAG : liste des ddl de niveau > 1 118 : * 119 : NTOTPO=KMINCT.NPOS(/1)-1 120 : NTTDDL=KMINCT.NPOS(NTOTPO+1)-1 121 : JG=NTTDDL 122 : SEGINI DDLINC 123 : *inu JG=NTTDDL 124 : *inu SEGINI DDLPT 125 : JG=NTTDDL 126 : * Initialisé à .FALSE. 127 : SEGINI DDLLAG 128 : LRELA=.FALSE. 129 : DO ITOTPO=1,NTOTPO 130 : DO IINC=1,NINC 131 : IPOS=KMINCT.MPOS(ITOTPO,IINC) 132 : IF (IPOS.NE.0) THEN 133 : JPOS=KMINCT.NPOS(ITOTPO)+IPOS-1 134 : DDLINC.LECT(JPOS)=IINC 135 : *inu DDLPT.LECT(JPOS)=ITOTPO 136 : * Non ! IF (LITYP.LECT(IINC).LE.2) THEN 137 : IF (LINIV.LECT(IINC).GE.2) THEN 138 : DDLLAG.LOGI(JPOS)=.TRUE. 139 : LRELA=.TRUE. 140 : ENDIF 141 : ENDIF 142 : ENDDO 143 : ENDDO 144 : * SEGPRT,DDLINC 145 : *inu SEGPRT,DDLPT 146 : * SEGPRT,DDLLAG 147 : * DO ITTDDL=1,NTTDDL 147 : * CALL DDL2PI(ITTDDL,KMINCT, 148 : * $ IPT,IBI, 149 : * $ IMPR,IRET) 150 : * IF (IRET.NE.0) GOTO 9999 151 : * WRITE(IOIMP,*) 'ddl ',ITTDDL,' = IPT=',IPT, 152 : * $ ' inconnue ',KMINCT.LISINC(IBI) 153 : * ENDDO 154 : *inu SEGSUP DDLPT 155 : * 156 : * Construction des tableaux d'entiers suivants : 157 : * LDD.IINC(1..NTTINC) liste des ddl de l'inconnue iinc 158 : * DDLINC(JTTDDL)=IINC : numéro de l'inconnue du ddl de numéro jttddl 159 : * KRDDL(JTTDDL)=ITTINC avec LDD.IINC(ITTINC) 160 : * 161 : SEGINI LDD 162 : JG=NINC 163 : SEGINI DDLDIM 164 : DO IINC=1,NINC 165 : JG=0 166 : SEGINI LDDI 167 : LDD.ML(IINC)=LDDI 168 : ENDDO 169 : JG=NTTDDL 170 : SEGINI KRDDL 171 : DO JTTDDL=1,NTTDDL 172 : IINC=DDLINC.LECT(JTTDDL) 173 : LDDI=LDD.ML(IINC) 174 : ITTINC=DDLDIM.LECT(IINC)+1 175 : LDDI.LECT(**)=JTTDDL 176 : KRDDL.LECT(JTTDDL)=ITTINC 177 : DDLDIM.LECT(IINC)=ITTINC 178 : ENDDO 179 : C SEGPRT,DDLDIM 180 : C SEGPRT,LDD 181 : C DO IINC=1,NINC 182 : C LDDI=LDD.ML(IINC) 183 : C SEGPRT,LDDI 184 : C ENDDO 185 : C SEGPRT,KRDDL 185 : *STAT CALL PRMSTA(' Préparation renume divers',MSTAT,IMPR) 186 : * 187 : * Obtention de la nouvelle numérotation des ddl 188 : * In RENUME : SEGINI NNUTOT 189 : * In RENUME : SEGDES NNUTOT 189 : CALL RENUME(PMTOT,IRENU,NNUTOT,IMPR,IRET) 190 : IF (IRET.NE.0) GOTO 9999 191 : C SEGPRT,NNUTOT 191 : *STAT CALL PRMSTA(' Après renume',MSTAT,IMPR) 192 : * 193 : * Construction des NNUs pour les points qui ne sont pas dans 194 : * DDLLAG 195 : * 196 : SEGACT,NNUTOT 197 : * NINC=NINC 198 : SEGINI NNU 199 : DO IINC=1,NINC 200 : JG=DDLDIM.LECT(IINC) 201 : SEGINI NNUI 202 : NNU.ML(IINC)=NNUI 203 : ENDDO 204 : DO ITOTPO=1,NTOTPO 205 : DO IINC=1,NINC 206 : IPOS=KMINCT.MPOS(ITOTPO,IINC) 207 : IF (IPOS.NE.0) THEN 208 : JPOS=KMINCT.NPOS(ITOTPO)+IPOS-1 209 : IF (.NOT.DDLLAG.LOGI(JPOS)) THEN 210 : INNU=NNUTOT.LECT(JPOS) 211 : NNUI=NNU.ML(IINC) 212 : KRNNUI=KRDDL.LECT(JPOS) 213 : NNUI.LECT(KRNNUI)=INNU 214 : ENDIF 215 : ENDIF 216 : ENDDO 217 : ENDDO 218 : SEGSUP NNUTOT 219 : * SEGPRT,NNU 220 : * DO IINC=1,NINC 221 : * NNUI=NNU.ML(IINC) 222 : * SEGPRT,NNUI 223 : * ENDDO 224 : 225 : IF (LRELA) THEN 226 : C 227 : C Obtention des numéros des ddl portant sur des points 228 : C où il n'y a que des multiplicateurs de Lagrange 229 : C le max ou le min des ddl de niveau INIV-1 qui lui sont 230 : C reliés 231 : C 232 : SEGACT PMTOT 233 : DO INIV=2,MAXNIV 234 : DO IINC=1,NINC 235 : JNIV=LINIV.LECT(IINC) 236 : IF (JNIV.EQ.INIV) THEN 237 : JTYP=LITYP.LECT(IINC) 238 : DO ITOTPO=1,NTOTPO 239 : IPOS=KMINCT.MPOS(ITOTPO,IINC) 240 : IF (IPOS.NE.0) THEN 241 : JTTDDL=KMINCT.NPOS(ITOTPO)+IPOS-1 242 : IF (DDLLAG.LOGI(JTTDDL)) THEN 243 : * WRITE(IOIMP,*) 'Lagrange JTTDDL=',JTTDDL 244 : JNNU=0 245 : KSTRT=PMTOT.IA(JTTDDL) 246 : KSTOP=PMTOT.IA(JTTDDL+1)-1 247 : * WRITE(IOIMP,*) 'iniv-1=',INIV-1 248 : * WRITE(IOIMP,*) 'kstrt=',kstrt 249 : * WRITE(IOIMP,*) 'kstop=',kstop 250 : DO KIND=KSTRT,KSTOP 251 : KTTDDL=PMTOT.JA(KIND) 252 : KINC=DDLINC.LECT(KTTDDL) 253 : KNIV=LINIV.LECT(KINC) 254 : * WRITE(IOIMP,*) 'kniv=',KNIV 255 : IF (KNIV.LE.INIV-1) THEN 256 : NNUK=NNU.ML(KINC) 257 : KRNNUK=KRDDL.LECT(KTTDDL) 258 : KNNU=NNUK.LECT(KRNNUK) 259 : * WRITE(IOIMP,*) 'ok knnu=',KNNU 260 : IF (KNNU.EQ.0) THEN 261 : WRITE(IOIMP,*) 'Erreur trop grave' 262 : GOTO 9999 263 : ENDIF 264 : IF (JNNU.EQ.0) THEN 265 : JNNU=KNNU 266 : ELSE 267 : IF (JTYP.EQ.4) THEN 268 : JNNU=MIN(JNNU,KNNU) 269 : *! ELSEIF (JTYP.EQ.3) THEN 270 : ELSEIF (JTYP.EQ.3.OR.JTYP.EQ.2) THEN 271 : JNNU=MAX(JNNU,KNNU) 272 : ELSE 273 : WRITE(IOIMP,*) 'Erreur grave 1.2' 274 : GOTO 9999 275 : ENDIF 276 : ENDIF 277 : ENDIF 278 : ENDDO 279 : IF (JNNU.EQ.0) THEN 280 : WRITE(IOIMP,*) 'INIV=',INIV 281 : WRITE(IOIMP,*) 'IINC=',IINC 282 : WRITE(IOIMP,*) 'JTYP=',JTYP 283 : WRITE(IOIMP,*) 'JTTDDL=',JTTDDL 284 : DO KIND=KSTRT,KSTOP 285 : KTTDDL=PMTOT.JA(KIND) 286 : WRITE(IOIMP,*) 'KTTDDL=',KTTDDL 287 : KINC=DDLINC.LECT(KTTDDL) 288 : KNIV=LINIV.LECT(KINC) 289 : WRITE(IOIMP,*) 'KINC=',KINC 290 : WRITE(IOIMP,*) 'KNIV=',KNIV 291 : ENDDO 292 : WRITE(IOIMP,*) 'Erreur grave 1.5' 293 : GOTO 9999 294 : ENDIF 295 : NNUJ=NNU.ML(IINC) 296 : KRNNUJ=KRDDL.LECT(JTTDDL) 297 : NNUJ.LECT(KRNNUJ)=JNNU 298 : ENDIF 299 : ENDIF 300 : ENDDO 301 : ENDIF 302 : ENDDO 303 : ENDDO 304 : SEGDES PMTOT 305 : ENDIF 306 : C SEGPRT,NNU 307 : C DO IINC=1,NINC 308 : C NNUI=NNU.ML(IINC) 309 : C SEGPRT,NNUI 310 : C ENDDO 311 : SEGSUP KRDDL 312 : SEGSUP DDLLAG 313 : SEGSUP DDLINC 314 : SEGDES LINIV 315 : SEGDES LITYP 316 : SEGDES KMINCT 317 : * 318 : * 1 On calcule les permutations qui permettent de trier NNU 319 : * par ordre croissant de nouveau numéro. 320 : * 321 : SEGINI PRM 322 : DO IINC=1,NINC 323 : NTTINC=DDLDIM.LECT(IINC) 324 : JG=NTTINC 325 : SEGINI PRMI 325 : CALL ISETI(PRMI.LECT,NTTINC) 326 : PRM.ML(IINC)=PRMI 327 : NNUI=NNU.ML(IINC) 327 : CALL ISHELI(NTTINC,PRMI.LECT,NTTINC,NNUI.LECT, 328 : $ IMPR,IRET) 329 : IF (IRET.NE.0) GOTO 9999 330 : ENDDO 331 : C SEGPRT,PRM 332 : C DO IORD=1,NORD 333 : C PRMI=PRM.ML(IORD) 334 : C SEGPRT,PRMI 335 : C ENDDO 336 : * 337 : * 3 En "merge"ant les listes précédentes, on obtient 338 : * la permutation réciproque de la nouvelle numérotation 339 : * totale que l'on cherche (si, si !) 340 : * 341 : JG=NTTDDL 342 : SEGINI PRMDDL 343 : JG=NINC 344 : SEGINI ITTDDL 345 : DO IINC=1,NINC 346 : ITTDDL.LECT(IINC)=1 347 : ENDDO 348 : JG=NINC 349 : SEGINI DDLOK 350 : DO IINC=1,NINC 351 : DDLOK.LOGI(IINC)=(ITTDDL.LECT(IINC).LE.DDLDIM.LECT(IINC)) 352 : ENDDO 353 : JG=NINC 354 : SEGINI INUDDL 355 : DO IINC=1,NINC 356 : IF (DDLOK.LOGI(IINC)) THEN 357 : NNUI=NNU.ML(IINC) 358 : PRMI=PRM.ML(IINC) 359 : * IITT=ITTDDL.LECT(IORD) 360 : * IPRM=PRM1.LECT(IITT) 361 : * INNU=NNU1.LECT(IPRM) 362 : INUDDL.LECT(IINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(IINC))) 363 : ENDIF 364 : ENDDO 365 : DO JTTDDL=1,NTTDDL 366 : JNUMIN=0 367 : JINC=0 368 : DO IINC=1,NINC 369 : IF (DDLOK.LOGI(IINC)) THEN 370 : IF (JNUMIN.EQ.0) THEN 371 : JNUMIN=INUDDL.LECT(IINC) 372 : JINC=IINC 373 : ELSE 374 : KNUMIN=INUDDL.LECT(IINC) 375 : IF (KNUMIN.LT.JNUMIN) THEN 376 : JNUMIN=KNUMIN 377 : JINC=IINC 378 : ENDIF 379 : ENDIF 380 : ENDIF 381 : ENDDO 382 : IF ((JNUMIN.EQ.0).OR.(JINC.EQ.0)) THEN 383 : WRITE(IOIMP,*) 'Erreur trop grave 2' 384 : GOTO 9999 385 : ENDIF 386 : LDDI=LDD.ML(JINC) 387 : NNUI=NNU.ML(JINC) 388 : PRMI=PRM.ML(JINC) 389 : KTTDDL=ITTDDL.LECT(JINC) 390 : PRMDDL.LECT(JTTDDL)=LDDI.LECT(PRMI.LECT(KTTDDL)) 391 : ITTDDL.LECT(JINC)=KTTDDL+1 392 : DDLOK.LOGI(JINC)=(ITTDDL.LECT(JINC).LE.DDLDIM.LECT(JINC)) 393 : IF (DDLOK.LOGI(JINC)) THEN 394 : NNUI=NNU.ML(JINC) 395 : PRMI=PRM.ML(JINC) 396 : INUDDL.LECT(JINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(JINC))) 397 : ENDIF 398 : ENDDO 399 : SEGSUP INUDDL 400 : SEGSUP DDLOK 401 : SEGSUP ITTDDL 402 : DO IINC=1,NINC 403 : PRMI=PRM.ML(IINC) 404 : SEGSUP PRMI 405 : ENDDO 406 : SEGSUP PRM 407 : DO IINC=1,NINC 408 : NNUI=NNU.ML(IINC) 409 : SEGSUP NNUI 410 : ENDDO 411 : SEGSUP NNU 412 : SEGSUP DDLDIM 413 : DO IINC=1,NINC 414 : LDDI=LDD.ML(IINC) 415 : SEGSUP LDDI 416 : ENDDO 417 : SEGSUP LDD 418 : * SEGPRT,PRMDDL 419 : * 420 : * D'où la nouvelle numérotation : 421 : * 422 : JG=NTTDDL 423 : SEGINI NEWNUM 423 : CALL RSETXI(NEWNUM.LECT,PRMDDL.LECT,NTTDDL) 424 : SEGDES NEWNUM 425 : SEGSUP PRMDDL 425 : *STAT CALL PRMSTA(' Merge et obtention NEWNUM',MSTAT,IMPR) 426 : * SEGPRT,NEWNUM 427 : * STOP 16 428 : * 429 : * Normal termination 430 : * 431 : IRET=0 432 : RETURN 433 : * 434 : * Format handling 435 : * 436 : * 437 : * Error handling 438 : * 439 : 9999 CONTINUE 440 : IRET=1 441 : WRITE(IOIMP,*) 'An error was detected in subroutine calnu4' 442 : RETURN 443 : * 444 : * End of subroutine CALNU4 445 : * 446 : END 447 : 448 : 449 : 450 : 451 : 452 :
© Cast3M 2003 - All rights reserved.
Disclaimer