1 : C CALNU5 SOURCE MAGN 09/07/30 21:15:23 6458 2 : SUBROUTINE CALNU5(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 : CALNU5 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 : * 84 : *STAT-INC SMSTAT 85 : * 86 : INTEGER IMPR,IRET 87 : INTEGER IRENU 88 : * 89 : INTEGER ITOTPO,JTTDDL 90 : INTEGER NTOTPO,NTTDDL 91 : LOGICAL LLAG,LRELA 92 : * 93 : * Executable statements 94 : * 95 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calnu5' 96 : * 97 : * Construction de DDLINC : c'est un tableau d'entiers tel que : 98 : * DDLINC(jttddl) = ordre du ddl 99 : * 100 : C SEGPRT,KMINCT 101 : C SEGPRT,LITYP 102 : C SEGPRT,LINIV 103 : SEGACT KMINCT 104 : SEGACT LITYP 105 : SEGACT LINIV 106 : NINC=KMINCT.LISINC(/2) 107 : MAXNIV=0 108 : DO IINC=1,NINC 109 : MAXNIV=MAX(MAXNIV,LINIV.LECT(IINC)) 110 : ENDDO 111 : * 112 : * Construction de DDLINC et DDLPT : sorte de segment réciproque 113 : * de KMINCT 114 : * En fait, DDLPT est inutile pour la suite. 115 : * Construction de PTLAG : liste des points sur lesquels 116 : * il n'y a que des inconnues de niveau > 1 117 : *!* Non ! il n'y a que des multiplicateurs de Lagrange 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=NTOTPO 126 : SEGINI PTLAG 127 : LRELA=.FALSE. 128 : DO ITOTPO=1,NTOTPO 129 : LLAG=.TRUE. 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).LT.2) THEN 138 : LLAG=.FALSE. 139 : ENDIF 140 : ENDIF 141 : ENDDO 142 : PTLAG.LOGI(ITOTPO)=LLAG 143 : LRELA=LRELA.OR.LLAG 144 : ENDDO 145 : C SEGPRT,DDLINC 146 : C SEGPRT,DDLPT 147 : C SEGPRT,PTLAG 148 : *inu SEGSUP DDLPT 149 : * 150 : * Construction des tableaux d'entiers suivants : 151 : * LDD.IINC(1..NTTINC) liste des ddl de l'inconnue iinc 152 : * DDLINC(JTTDDL)=IINC : numéro de l'inconnue du ddl de numéro jttddl 153 : * KRDDL(JTTDDL)=ITTINC avec LDD.IINC(ITTINC) 154 : * 155 : SEGINI LDD 156 : JG=NINC 157 : SEGINI DDLDIM 158 : DO IINC=1,NINC 159 : JG=0 160 : SEGINI LDDI 161 : LDD.ML(IINC)=LDDI 162 : ENDDO 163 : JG=NTTDDL 164 : SEGINI KRDDL 165 : DO JTTDDL=1,NTTDDL 166 : IINC=DDLINC.LECT(JTTDDL) 167 : LDDI=LDD.ML(IINC) 168 : ITTINC=DDLDIM.LECT(IINC)+1 169 : LDDI.LECT(**)=JTTDDL 170 : KRDDL.LECT(JTTDDL)=ITTINC 171 : DDLDIM.LECT(IINC)=ITTINC 172 : ENDDO 173 : C SEGPRT,DDLDIM 174 : C SEGPRT,LDD 175 : C DO IINC=1,NINC 176 : C LDDI=LDD.ML(IINC) 177 : C SEGPRT,LDDI 178 : C ENDDO 179 : C SEGPRT,KRDDL 179 : *STAT CALL PRMSTA(' Préparation renume divers',MSTAT,IMPR) 180 : * 181 : * Obtention de la nouvelle numérotation des ddl 182 : * In RENUME : SEGINI NNUTOT 183 : * In RENUME : SEGDES NNUTOT 183 : CALL RENUME(PMTOT,IRENU,NNUTOT,IMPR,IRET) 184 : IF (IRET.NE.0) GOTO 9999 185 : C SEGPRT,NNUTOT 185 : *STAT CALL PRMSTA(' Après renume',MSTAT,IMPR) 186 : * 187 : * Construction des NNUs pour les points où il n'y a pas de 188 : * multiplicateurs de Lagrange 189 : * 190 : SEGACT,NNUTOT 191 : * NINC=NINC 192 : SEGINI NNU 193 : DO IINC=1,NINC 194 : JG=DDLDIM.LECT(IINC) 195 : SEGINI NNUI 196 : NNU.ML(IINC)=NNUI 197 : ENDDO 198 : DO ITOTPO=1,NTOTPO 199 : IF (.NOT.PTLAG.LOGI(ITOTPO)) THEN 200 : INNU=0 201 : DO IINC=1,NINC 202 : IPOS=KMINCT.MPOS(ITOTPO,IINC) 203 : IF (IPOS.NE.0) THEN 204 : JPOS=KMINCT.NPOS(ITOTPO)+IPOS-1 205 : IF (INNU.EQ.0) THEN 206 : INNU=NNUTOT.LECT(JPOS) 207 : ENDIF 208 : NNUI=NNU.ML(IINC) 209 : KRNNUI=KRDDL.LECT(JPOS) 210 : NNUI.LECT(KRNNUI)=INNU 211 : ENDIF 212 : ENDDO 213 : ENDIF 214 : ENDDO 215 : SEGSUP NNUTOT 216 : C SEGPRT,NNU 217 : C DO IINC=1,NINC 218 : C NNUI=NNU.ML(IINC) 219 : C SEGPRT,NNUI 220 : C ENDDO 221 : IF (LRELA) THEN 222 : C 223 : C Obtention des numéros des ddl portant sur des points 224 : C où il n'y a que des multiplicateurs de Lagrange 225 : C le max ou le min des ddl de niveau INIV-1 qui lui sont 226 : C reliés 227 : C 228 : SEGACT PMTOT 229 : DO INIV=2,MAXNIV 230 : DO IINC=1,NINC 231 : JNIV=LINIV.LECT(IINC) 232 : IF (JNIV.EQ.INIV) THEN 233 : JTYP=LITYP.LECT(IINC) 234 : DO ITOTPO=1,NTOTPO 235 : IF (PTLAG.LOGI(ITOTPO)) THEN 236 : IPOS=KMINCT.MPOS(ITOTPO,IINC) 237 : IF (IPOS.NE.0) THEN 238 : JTTDDL=KMINCT.NPOS(ITOTPO)+IPOS-1 239 : JNNU=0 240 : KSTRT=PMTOT.IA(JTTDDL) 241 : KSTOP=PMTOT.IA(JTTDDL+1)-1 242 : DO KIND=KSTRT,KSTOP 243 : KTTDDL=PMTOT.JA(KIND) 244 : KINC=DDLINC.LECT(KTTDDL) 245 : KNIV=LINIV.LECT(KINC) 246 : IF (KNIV.EQ.INIV-1) THEN 247 : NNUK=NNU.ML(KINC) 248 : KRNNUK=KRDDL.LECT(KTTDDL) 249 : KNNU=NNUK.LECT(KRNNUK) 250 : IF (KNNU.EQ.0) THEN 251 : WRITE(IOIMP,*) 'Erreur trop grave' 252 : GOTO 9999 253 : ENDIF 254 : IF (JNNU.EQ.0) THEN 255 : JNNU=KNNU 256 : ELSE 257 : IF (JTYP.EQ.4) THEN 258 : JNNU=MIN(JNNU,KNNU) 259 : *! ELSEIF (JTYP.EQ.3) THEN 260 : ELSEIF (JTYP.EQ.3.OR.JTYP.EQ.2) THEN 261 : JNNU=MAX(JNNU,KNNU) 262 : ELSE 263 : WRITE(IOIMP,*) 'Erreur grave 1.2' 264 : GOTO 9999 265 : ENDIF 266 : ENDIF 267 : ENDIF 268 : ENDDO 269 : ENDIF 270 : ENDIF 271 : ENDDO 272 : IF (JNNU.EQ.0) THEN 273 : WRITE(IOIMP,*) 'Erreur grave 1.5' 274 : GOTO 9999 275 : ENDIF 276 : NNUJ=NNU.ML(IINC) 277 : KRNNUJ=KRDDL.LECT(JTTDDL) 278 : NNUJ.LECT(KRNNUJ)=JNNU 279 : ENDIF 280 : ENDDO 281 : ENDDO 282 : SEGDES PMTOT 283 : ENDIF 284 : SEGSUP KRDDL 285 : SEGSUP PTLAG 286 : SEGSUP DDLINC 287 : SEGDES LINIV 288 : SEGDES LITYP 289 : SEGDES KMINCT 290 : C SEGPRT,NNU 291 : C DO IINC=1,NINC 292 : C NNUI=NNU.ML(IINC) 293 : C SEGPRT,NNUI 294 : C ENDDO 295 : * 296 : * 1 On calcule les permutations qui permettent de trier NNU 297 : * par ordre croissant de nouveau numéro. 298 : * 299 : SEGINI PRM 300 : DO IINC=1,NINC 301 : NTTINC=DDLDIM.LECT(IINC) 302 : JG=NTTINC 303 : SEGINI PRMI 303 : CALL ISETI(PRMI.LECT,NTTINC) 304 : PRM.ML(IINC)=PRMI 305 : NNUI=NNU.ML(IINC) 305 : CALL ISHELI(NTTINC,PRMI.LECT,NTTINC,NNUI.LECT, 306 : $ IMPR,IRET) 307 : IF (IRET.NE.0) GOTO 9999 308 : ENDDO 309 : C SEGPRT,PRM 310 : C DO IORD=1,NORD 311 : C PRMI=PRM.ML(IORD) 312 : C SEGPRT,PRMI 313 : C ENDDO 314 : * 315 : * 3 En "merge"ant les listes précédentes, on obtient 316 : * la permutation réciproque de la nouvelle numérotation 317 : * totale que l'on cherche (si, si !) 318 : * 319 : JG=NTTDDL 320 : SEGINI PRMDDL 321 : JG=NINC 322 : SEGINI ITTDDL 323 : DO IINC=1,NINC 324 : ITTDDL.LECT(IINC)=1 325 : ENDDO 326 : JG=NINC 327 : SEGINI DDLOK 328 : DO IINC=1,NINC 329 : DDLOK.LOGI(IINC)=(ITTDDL.LECT(IINC).LE.DDLDIM.LECT(IINC)) 330 : ENDDO 331 : JG=NINC 332 : SEGINI INUDDL 333 : DO IINC=1,NINC 334 : IF (DDLOK.LOGI(IINC)) THEN 335 : NNUI=NNU.ML(IINC) 336 : PRMI=PRM.ML(IINC) 337 : * IITT=ITTDDL.LECT(IORD) 338 : * IPRM=PRM1.LECT(IITT) 339 : * INNU=NNU1.LECT(IPRM) 340 : INUDDL.LECT(IINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(IINC))) 341 : ENDIF 342 : ENDDO 343 : DO JTTDDL=1,NTTDDL 344 : JNUMIN=0 345 : JINC=0 346 : DO IINC=1,NINC 347 : IF (DDLOK.LOGI(IINC)) THEN 348 : IF (JNUMIN.EQ.0) THEN 349 : JNUMIN=INUDDL.LECT(IINC) 350 : JINC=IINC 351 : ELSE 352 : KNUMIN=INUDDL.LECT(IINC) 353 : IF (KNUMIN.LT.JNUMIN) THEN 354 : JNUMIN=KNUMIN 355 : JINC=IINC 356 : ENDIF 357 : ENDIF 358 : ENDIF 359 : ENDDO 360 : IF ((JNUMIN.EQ.0).OR.(JINC.EQ.0)) THEN 361 : WRITE(IOIMP,*) 'Erreur trop grave 2' 362 : GOTO 9999 363 : ENDIF 364 : LDDI=LDD.ML(JINC) 365 : NNUI=NNU.ML(JINC) 366 : PRMI=PRM.ML(JINC) 367 : KTTDDL=ITTDDL.LECT(JINC) 368 : PRMDDL.LECT(JTTDDL)=LDDI.LECT(PRMI.LECT(KTTDDL)) 369 : ITTDDL.LECT(JINC)=KTTDDL+1 370 : DDLOK.LOGI(JINC)=(ITTDDL.LECT(JINC).LE.DDLDIM.LECT(JINC)) 371 : IF (DDLOK.LOGI(JINC)) THEN 372 : NNUI=NNU.ML(JINC) 373 : PRMI=PRM.ML(JINC) 374 : INUDDL.LECT(JINC)=NNUI.LECT(PRMI.LECT(ITTDDL.LECT(JINC))) 375 : ENDIF 376 : ENDDO 377 : SEGSUP INUDDL 378 : SEGSUP DDLOK 379 : SEGSUP ITTDDL 380 : DO IINC=1,NINC 381 : PRMI=PRM.ML(IINC) 382 : SEGSUP PRMI 383 : ENDDO 384 : SEGSUP PRM 385 : DO IINC=1,NINC 386 : NNUI=NNU.ML(IINC) 387 : SEGSUP NNUI 388 : ENDDO 389 : SEGSUP NNU 390 : SEGSUP DDLDIM 391 : DO IINC=1,NINC 392 : LDDI=LDD.ML(IINC) 393 : SEGSUP LDDI 394 : ENDDO 395 : SEGSUP LDD 396 : * SEGPRT,PRMDDL 397 : * 398 : * D'où la nouvelle numérotation : 399 : * 400 : JG=NTTDDL 401 : SEGINI NEWNUM 401 : CALL RSETXI(NEWNUM.LECT,PRMDDL.LECT,NTTDDL) 402 : SEGDES NEWNUM 403 : SEGSUP PRMDDL 403 : *STAT CALL PRMSTA(' Merge et obtention NEWNUM',MSTAT,IMPR) 404 : * SEGPRT,NEWNUM 405 : * STOP 16 406 : * 407 : * Normal termination 408 : * 409 : IRET=0 410 : RETURN 411 : * 412 : * Format handling 413 : * 414 : * 415 : * Error handling 416 : * 417 : 9999 CONTINUE 418 : IRET=1 419 : WRITE(IOIMP,*) 'An error was detected in subroutine calnu5' 420 : RETURN 421 : * 422 : * End of subroutine CALNU5 423 : * 424 : END 425 : 426 : 427 : 428 : 429 :
© Cast3M 2003 - All rights reserved.
Disclaimer