1 : C MENAG2 SOURCE PV 12/12/17 21:15:17 7625 2 : C SUPPRIMER LES SEGMENTS INDESIRABLES 3 : C DESACTIVER LES AUTRES 4 : C 5 : SUBROUTINE MENAG2(ISLIS,ICOLAC) 6 : 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : 10 : C======================================================================= 11 : C TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL 12 : C======================================================================= 13 : 14 : CHARACTER*8 MODYN 15 : 16 : SEGMENT ISLIS(NP) 17 : SEGMENT IBLIS(ISLIS(/1)) 18 : * SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES 19 : * DECLARATION 20 : SEGMENT ISEG(0) 21 : * 22 : -INC CCOPTIO 23 : -INC TMCOLAC 24 : *-INC SMCOORD 25 : *-INC SMELEME 26 : -INC SMCHPOI 27 : -INC SMRIGID 28 : *-INC SMCLSTR 29 : *-INC SMELSTR 30 : -INC SMSTRUC 31 : *-INC SMTABLE 32 : -INC SMINTE 33 : -INC SMATTAC 34 : -INC SMMATRI 35 : -INC SMSOLUT 36 : *-INC SMSUPER 37 : -INC SMTEXTE 38 : *-INC SMDEFOR 39 : -INC CCASSIS 40 : -INC TMVECRIG 41 : 42 : MODYN='DYNAMIQU' 43 : 44 : ILISSE=ILISSG 45 : NP=ILISEG(/1) 46 : SEGINI ISLIS 47 : * A TOUT HASARD SAUVER LA CONFIGURATION COURANTE 48 : ISLIS((MCOORD-1)/npgcd)=1 49 : 50 : SEGACT ICOLAC 51 : * 52 : * CAS DES MELEME 53 : * 54 : ITLACC=KCOLA(1) 55 : IF (ITLAC(/1).EQ.0) GOTO 20 56 : DO 12 I=1,ITLAC(/1) 57 : ISEG=ITLAC(I) 58 : IF (ISEG.NE.0) THEN 59 : ISLIS((ISEG-1)/npgcd)=1 60 : SEGDES ISEG 61 : ENDIF 62 : 12 CONTINUE 63 : 20 CONTINUE 64 : * 65 : * CAS DES CHPOINT 66 : * 67 : ITLACC=KCOLA(2) 68 : IF (ITLAC(/1).EQ.0) GOTO 30 69 : DO 21 I=1,ITLAC(/1) 70 : MCHPOI=ITLAC(I) 71 : IF (MCHPOI.EQ.0) GOTO 21 72 : ISLIS((MCHPOI-1)/npgcd)=1 73 : SEGACT MCHPOI 74 : if (ipchp(/1).gt.1000.or.ipchp(/1).lt.0) then 75 : write (6,*) ' menag2 chpo incorrect ', 76 : > mchpoi,j,ipchp(/1),msoupo 77 : goto 21 78 : endif 79 : DO 22 J=1,IPCHP(/1) 80 : MSOUPO=IPCHP(J) 81 : if (msoupo.eq.0) goto 22 82 : if (msoupo.le.100) then 83 : write (6,*) ' menag2 chpo incorrect ', 84 : > mchpoi,j,ipchp(/1),msoupo 85 : goto 21 86 : endif 87 : ISLIS((MSOUPO-1)/npgcd)=1 88 : SEGACT MSOUPO 89 : MPOVAL=IPOVAL 90 : C 91 : C BIZARRE : DANS UN ATTACH, ON TROUVE UN CHPOI SANS MPOVAL ? 92 : IF(MPOVAL.NE.0) THEN 93 : ISLIS((MPOVAL-1)/npgcd)=1 94 : SEGDES MPOVAL 95 : ENDIF 96 : SEGDES MSOUPO 97 : 22 CONTINUE 98 : SEGDES MCHPOI 99 : 21 CONTINUE 100 : 30 CONTINUE 101 : * 102 : * CAS DES MRIGID (ON REMPLIT MMATRI CAR CA N'A PAS L'AIR FAIT DANS 103 : * FILLPO 104 : * 105 : ITLACC=KCOLA(3) 106 : ITLAC1=KCOLA(16) 107 : IF (ITLAC(/1).EQ.0) GOTO 40 108 : DO 31 I=1,ITLAC(/1) 109 : MRIGID=ITLAC(I) 110 : ISLIS((MRIGID-1)/npgcd)=1 111 : SEGACT MRIGID 112 : * IF (ICHOLE.NE.0) ITLAC1.ITLAC(**)=ICHOLE 113 : IMGEOD=IMGEO1 114 : IF (IMGEOD.NE.0) THEN 115 : ISLIS((IMGEOD-1)/npgcd)=1 116 : SEGDES IMGEOD 117 : ENDIF 118 : IF(IVECRI.NE.0) then 119 : ISLIS((IVECRI-1)/npgcd)=1 120 : MVECRI=IVECRI 121 : SEGDES MVECRI 122 : ENDIF 123 : DO 32 J=1,IRIGEL(/2) 124 : DESCR=IRIGEL(3,J) 125 : ISLIS((DESCR-1)/npgcd)=1 126 : SEGDES DESCR 127 : xmatri=irigel(4,j) 128 : islis((xmatri-1)/npgcd)=1 129 : segdes xmatri 130 : 32 CONTINUE 131 : SEGDES MRIGID 132 : 31 CONTINUE 133 : 40 CONTINUE 134 : * 135 : * CAS DES BLOQ STRUC 136 : * 137 : ITLACC=KCOLA(6) 138 : IF (ITLAC(/1).EQ.0) GOTO 70 139 : DO 61 I=1,ITLAC(/1) 140 : * MCLSTR=ITLAC(I) 141 : * ISLIS((MCLSTR-1)/npgcd)=1 142 : * SEGDES MCLSTR 143 : ISEG=ITLAC(I) 144 : ISLIS((ISEG-1)/npgcd)=1 145 : SEGDES ISEG 146 : 61 CONTINUE 147 : 70 CONTINUE 148 : * 149 : * CAS DES ELEM STRUC 150 : * 151 : ITLACC=KCOLA(7) 152 : IF (ITLAC(/1).EQ.0) GOTO 80 153 : DO 71 I=1,ITLAC(/1) 154 : * MELSTR=ITLAC(I) 155 : * ISLIS((MELSTR-1)/npgcd)=1 156 : * SEGDES MELSTR 157 : ISEG=ITLAC(I) 158 : ISLIS((ISEG-1)/npgcd)=1 159 : SEGDES ISEG 160 : 71 CONTINUE 161 : 80 CONTINUE 162 : * 163 : * CAS DES MSOLUT 164 : * 165 : ITLACC=KCOLA(8) 166 : SEGACT ITLACC 167 : IF (ITLAC(/1).EQ.0) GOTO 90 168 : DO 81 I=1,ITLAC(/1) 169 : MSOLUT=ITLAC(I) 170 : ISLIS((MSOLUT-1)/npgcd)=1 171 : SEGACT MSOLUT 172 : C 173 : C ZONE COMMUNE PAS SI COMMUNE QUE CA | 174 : C 175 : IF(ITYSOL.EQ.MODYN) THEN 176 : MSOLRE=MSOLIS(1) 177 : ISLIS((MSOLRE-1)/npgcd)=1 178 : SEGDES MSOLRE 179 : MSOLEN=MSOLIS(2) 180 : IF(MSOLEN.NE.0) THEN 181 : ISLIS((MSOLEN-1)/npgcd)=1 182 : SEGDES MSOLEN 183 : ENDIF 184 : ENDIF 185 : ISEG=MSOLIS(3) 186 : IF(ISEG.NE.0) THEN 187 : ISLIS((ISEG-1)/npgcd)=1 188 : SEGDES ISEG 189 : ENDIF 190 : MSOLEN=MSOLIS(4) 191 : IF(MSOLEN.NE.0) THEN 192 : ISLIS((MSOLEN-1)/npgcd)=1 193 : SEGACT MSOLEN 194 : DO 82 NS=1,ISOLEN(/1) 195 : MMODE=ISOLEN(NS) 196 : ISLIS((MMODE-1)/npgcd)=1 197 : SEGDES MMODE 198 : 82 CONTINUE 199 : SEGDES MSOLEN 200 : ENDIF 201 : C 202 : NIPO=MSOLIS(/1) 203 : DO 83 J=5,NIPO 204 : MSOLEN=MSOLIS(J) 205 : IF(MSOLEN.NE.0) THEN 206 : ISLIS((MSOLEN-1)/npgcd)=1 207 : SEGDES MSOLEN 208 : ENDIF 209 : 83 CONTINUE 210 : SEGDES MSOLUT 211 : 81 CONTINUE 212 : 90 CONTINUE 213 : * 214 : * CAS DES MSTRUC 215 : * 216 : ITLACC=KCOLA(9) 217 : IF (ITLAC(/1).EQ.0) GOTO 100 218 : DO 91 I=1,ITLAC(/1) 219 : MSTRUC=ITLAC(I) 220 : ISLIS((MSTRUC-1)/npgcd)=1 221 : SEGDES MSTRUC 222 : 91 CONTINUE 223 : 100 CONTINUE 224 : * 225 : * CAS DES MTABLE 226 : * 227 : ITLACC=KCOLA(10) 228 : IF (ITLAC(/1).EQ.0) GOTO 110 229 : DO 101 I=1,ITLAC(/1) 230 : * MTABLE=ITLAC(I) 231 : * ISLIS((**-1)/npgcd)=MTABLE 232 : * SEGDES MTABLE 233 : ISEG=ITLAC(I) 234 : ISLIS((ISEG-1)/npgcd)=1 235 : SEGDES ISEG 236 : 101 CONTINUE 237 : 110 CONTINUE 238 : * 239 : * CAS DES MSOSTU 240 : * 241 : ITLACC=KCOLA(12) 242 : IF (ITLAC(/1).EQ.0) GOTO 130 243 : DO 121 I=1,ITLAC(/1) 244 : MSOSTU=ITLAC(I) 245 : ISLIS((MSOSTU-1)/npgcd)=1 246 : SEGDES MSOSTU 247 : 121 CONTINUE 248 : 130 CONTINUE 249 : * 250 : * CAS DES IMATRI ( n'existe plus) 251 : * 252 : * ITLACC=KCOLA(13) 253 : * IF (ITLAC(/1).EQ.0) GOTO 140 254 : * DO 131 I=1,ITLAC(/1) 255 : * IMATRI=ITLAC(I) 256 : * ISLIS((IMATRI-1)/npgcd)=1 257 : * SEGACT IMATRI 258 : * DO 132 K=1,IMATTT(/1) 259 : * XMATRI=IMATTT(K) 260 : * ISLIS((XMATRI-1)/npgcd)=1 261 : * SEGDES XMATRI 262 : * 132 CONTINUE 263 : * SEGDES IMATRI 264 : * 131 CONTINUE 265 : * 140 CONTINUE 266 : * 267 : * CAS DES MJONCT 268 : * 269 : ITLACC=KCOLA(14) 270 : IF (ITLAC(/1).EQ.0) GOTO 150 271 : DO 141 I=1,ITLAC(/1) 272 : MJONCT=ITLAC(I) 273 : ISLIS((MJONCT-1)/npgcd)=1 274 : SEGDES MJONCT 275 : 141 CONTINUE 276 : 150 CONTINUE 277 : * 278 : * CAS DES MATTAC 279 : * 280 : ITLACC=KCOLA(15) 281 : SEGACT ITLACC 282 : IF (ITLAC(/1).EQ.0) GOTO 160 283 : DO 151 I=1,ITLAC(/1) 284 : MATTAC=ITLAC(I) 285 : SEGACT MATTAC 286 : ISLIS((MATTAC-1)/npgcd)=1 287 : DO 152 NM=1,LISATT(/1) 288 : MSOUMA=LISATT(NM) 289 : if (MSOUMA.gt.0) then 290 : ISLIS((MSOUMA-1)/npgcd)=1 291 : SEGACT MSOUMA 292 : MPHYCH=IPHYCH 293 : if (MPHYCH.gt.0) then 294 : ISLIS((MPHYCH-1)/npgcd)=1 295 : SEGDES MPHYCH 296 : endif 297 : MGEOCH=IGEOCH 298 : ISLIS((MGEOCH-1)/npgcd)=1 299 : SEGDES MGEOCH 300 : DO 153 NATR=1,IATREL(/1) 301 : MJONCT=IATREL(NATR) 302 : ISLIS((MJONCT-1)/npgcd)=1 303 : C 304 : SEGDES MJONCT 305 : 153 CONTINUE 306 : SEGDES MSOUMA 307 : endif 308 : 152 CONTINUE 309 : SEGDES MATTAC 310 : 151 CONTINUE 311 : 160 CONTINUE 312 : * 313 : * CAS DES MMATRI : LES MMATRI N'ETANT PAS REMPLI DANS LE PROCESSUS 314 : * NORMAL : FILLPO ON LES REMPLI AU NIVEAU DE MRIGID 315 : * ON EST EGALEMENT CONTRAINT DE SAUVER IGEOMA (MELEME) CAR CE N'EST 316 : * PAS FAIT AUTOMATIQUEMENT 317 : * 318 : ITLACC=KCOLA(16) 319 : IF (ITLAC(/1).EQ.0) GOTO 170 320 : DO 161 I=1,ITLAC(/1) 321 : MMATRI=ITLAC(I) 322 : ISLIS((MMATRI-1)/npgcd)=1 323 : SEGACT MMATRI 324 : ISEG=IGEOMA 325 : ISLIS((ISEG-1)/npgcd)=1 326 : SEGDES ISEG 327 : MDIAG=IDIAG 328 : ISLIS((MDIAG-1)/npgcd)=1 329 : SEGDES MDIAG 330 : MINCPO=IINCPO 331 : ISLIS((MINCPO-1)/npgcd)=1 332 : SEGDES MINCPO 333 : IF(IDUAPO.GT.0) THEN 334 : MINCPO=IDUAPO 335 : ISLIS((MINCPO-1)/npgcd)=1 336 : SEGDES MINCPO 337 : ENDIF 338 : MIDUA=IIDUA 339 : ISLIS((MIDUA-1)/npgcd)=1 340 : SEGDES MIDUA 341 : MIMIK=IIMIK 342 : ISLIS((MIMIK-1)/npgcd)=1 343 : SEGDES MIMIK 344 : MDNOR=IDNORM 345 : ISLIS((MDNOR-1)/npgcd)=1 346 : SEGDES MDNOR 347 : MHARK=IHARK 348 : ISLIS((MHARK-1)/npgcd)=1 349 : SEGDES MHARK 350 : IF(IHARDU.GT.0) THEN 351 : MHARK=IHARDU 352 : ISLIS((MHARK-1)/npgcd)=1 353 : SEGDES MHARK 354 : ENDIF 355 : IF(IDNORD.GT.0) THEN 356 : MDNO1=IDNORD 357 : ISLIS((MDNO1-1)/npgcd)=1 358 : SEGDES MDNO1 359 : ENDIF 360 : 361 : MILIGN=IILIGN 362 : ISLIS((MILIGN-1)/npgcd)=1 363 : SEGACT MILIGN 364 : DO 162 J=1,ILIGN(/1) 365 : LIGN=ILIGN(J) 366 : ISLIS((LIGN-1)/npgcd)=1 367 : SEGDES LIGN 368 : 162 CONTINUE 369 : SEGDES MILIGN 370 : 371 : IF(IILIGS.NE.0) THEN 372 : MILIGN=IILIGS 373 : ISLIS((MILIGN-1)/npgcd)=1 374 : SEGACT MILIGN 375 : DO 163 J=1,ILIGN(/1) 376 : LIGN=ILIGN(J) 377 : ISLIS((LIGN-1)/npgcd)=1 378 : SEGDES LIGN 379 : 163 CONTINUE 380 : SEGDES MILIGN 381 : ENDIF 382 : IF(IASLIG.NE.0) THEN 383 : ISLIS((IASLIG-1)/npgcd)=1 384 : MILIGN=IASLIG 385 : SEGACT MILIGN 386 : DO 164 J=1,ILIGN(/1) 387 : LIGN=ILIGN(J) 388 : ISLIS((LIGN-1)/npgcd)=1 389 : SEGDES LIGN 390 : 164 CONTINUE 391 : SEGDES MILIGN 392 : MDIAG=IASDIA 393 : ISLIS((MDIAG-1)/npgcd)=1 394 : SEGDES MDIAG 395 : ENDIF 396 : SEGDES MMATRI 397 : 161 CONTINUE 398 : 170 CONTINUE 399 : * 400 : * CAS DES MDEFOR 401 : * 402 : ITLACC=KCOLA(17) 403 : IF (ITLAC(/1).EQ.0) GOTO 180 404 : DO 171 I=1,ITLAC(/1) 405 : * MDEFOR=ITLAC(I) 406 : * ISLIS((MDEFOR-1)/npgcd)=1 407 : * SEGDES MDEFOR 408 : ISEG=ITLAC(I) 409 : ISLIS((ISEG-1)/npgcd)=1 410 : SEGDES ISEG 411 : 171 CONTINUE 412 : 180 CONTINUE 413 : * 414 : * LA SUITE EST DANS MENAG6 415 : * 415 : CALL MENAG6(ILISSE,ISLIS,ICOLAC) 416 : * 417 : * ORDONNER LES SEGMENTS 418 : * 419 : NP=0 420 : DO 11 I=1,ISLIS(/1) 421 : IF( ISLIS(I).NE.0) THEN 422 : NP=NP+1 423 : ISLIS(NP)=I*npgcd+1 424 : ENDIF 425 : 11 CONTINUE 426 : SEGADJ ISLIS 427 : * SEGINI IBLIS 427 : * CALL TRIENT(ISLIS(1),IBLIS(1),ISLIS(/1)) 428 : * SEGSUP IBLIS 429 : 430 : RETURN 431 : END 432 : 433 : 434 : 435 :
© Cast3M 2003 - All rights reserved.
Disclaimer