1 : C DEVSO4 SOURCE FANDEUR 13/01/16 21:15:09 7666 2 : SUBROUTINE DEVSO4(KTRES,KTLIAA,KTLIAB,KTNUM,NINS, 3 : & ICHAIN,MTABLE,REPRIS,LMODYN,ITDYN,ITSORT) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Creation et remplissage de la table resultat * 12 : * * 13 : * Parametres: * 14 : * * 15 : * e KTRES segment de sauvegarde des resultats * 16 : * e KTLIAA segment descriptif des liaisons en base A * 17 : * e KTLIAB segment descriptif des liaisons en base B * 18 : * e KTNUM segment contenant les parametres numeriques * 19 : * e NINS on veut une sortie tous les NINS pas de calcul * 20 : * e ICHAIN Segment MLENTI (ACTIF) contenant les adresses des * 21 : * chaines dans la pile des mots de CCNOYAU * 22 : * s MTABLE table resultat de l'operateur DYNE * 23 : * e REPRIS vrai si reprise de calcul, faux sinon * 24 : * * 25 : * Auteur, date de creation : * 26 : * * 27 : * Denis ROBERT-MOUGIN, le 11 aout 1989. * 28 : * IBRAHIM PINTO, 05/97 , LIAISONS SEGEMENT_CERCLE * 29 : *--------------------------------------------------------------------* 30 : -INC CCOPTIO 31 : -INC SMTABLE 32 : -INC SMLREEL 33 : -INC SMLENTI 34 : -INC SMCHPOI 35 : * 36 : SEGMENT,MTLIAA 37 : INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) 38 : REAL*8 XPALA(NLIAA,NXPALA) 39 : ENDSEGMENT 40 : SEGMENT,MTLIAB 41 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 42 : REAL*8 XPALB(NLIAB,NXPALB) 43 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 44 : ENDSEGMENT 45 : SEGMENT,MTRES 46 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) 47 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) 48 : REAL*8 XMREP(NLIAB,4,IDIMB) 49 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) 50 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) 51 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) 52 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) 53 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) 54 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) 55 : INTEGER ILPOLA(NLIAA,2) 56 : ENDSEGMENT 57 : SEGMENT,MTNUM 58 : REAL*8 XDT(NPC1),XTEMPS(NPC1) 59 : ENDSEGMENT 60 : * 61 : POINTEUR LCHAIN.MLENTI 62 : POINTEUR MTABU.MTABLE, MTAB4.MTABLE 63 : * 64 : INTEGER ipotab(8) 65 : LOGICAL L0,L1,REPRIS,LMODYN 66 : CHARACTER*8 TYPRET,TYPOBJ 67 : CHARACTER*72 CHARRE,CHARRI 68 : * 69 : MTRES = KTRES 70 : MTLIAA = KTLIAA 71 : MTLIAB = KTLIAB 72 : MTNUM = KTNUM 73 : NRES = XRES(/1) 74 : NCRES = XRES(/2) 75 : NPRES = XRES(/3) 76 : NREP = XREP(/1) 77 : NLSA = XRESLA(/1) 78 : NLSB = XRESLB(/1) 79 : NTVAR = ILIREB(/2) 80 : NLIAB = XMREP(/1) 81 : NLIAA = ILPOLA(/1) 82 : IF (MTLIAA.NE.0) THEN 83 : NPLAA = IPLIA(/2) 84 : NXPALA = XPALA(/2) 85 : ELSE 86 : NPLAA = 0 87 : NXPALA = 0 88 : ENDIF 89 : NPLB = JPLIB(/1) 90 : IDIMB = XMREP(/3) 91 : LCHAIN = ICHAIN 92 : INDC10 = -12345 93 : MTAB1 = -6661 94 : MTAB3 = -6663 95 : 96 : IF (ITSORT.EQ.INDC10) GOTO 1234 97 : * 98 : *---------- Cr{ation de la table r{sultat : ---------- 99 : * 100 : M = 3 + NLSA + NLSB 101 : IF (NRES.NE.0) THEN 102 : M = M + NPRES 103 : ENDIF 104 : SEGINI,MTABLE 105 : MLOTAB = M 106 : 107 : * 108 : * Sous-typage de la table r{sultat: 109 : * 110 : MTABTI(1) = 'MOT' 111 : ICHA6 = LCHAIN.LECT(6) 112 : MTABII(1) = ICHA6 113 : MTABTV(1) = 'MOT' 114 : ICHA1 = LCHAIN.LECT(1) 115 : MTABIV(1) = ICHA1 116 : * 117 : *---------- Cr{ation de la liste des temps ---------- 118 : * 119 : IINS = 1 120 : IF ( REPRIS ) IINS = NINS + 1 121 : MLREEL = IPOLR(1) 122 : segact mlreel*mod 123 : DO 10 IRES = 1,NPRES 124 : PROG(IRES) = XTEMPS(IINS) 125 : IINS = IINS + NINS 126 : 10 CONTINUE 127 : * end do 128 : SEGDES,MLREEL 129 : * 130 : * Ecriture de la liste des temps de sortie dans la table r{sultat 131 : * 132 : MTABTI(2) = 'MOT' 133 : ICHA3 = LCHAIN.LECT(3) 134 : MTABII(2) = ICHA3 135 : MTABTV(2) = 'LISTREEL' 136 : MTABIV(2) = MLREEL 137 : * 138 : *---------- Cr{ation du bloc de reprise : ---------- 139 : *+* SOUSTYPE / TEMPS_DE_REPRISE / variables "principales" 140 : M = NREP + 2 141 : IF (NLIAA.NE.0) THEN 142 : IPOLY = 0 143 : DO 180 I = 1,NLIAA 144 : IF (ILPOLA(I,1).NE.0) IPOLY = IPOLY + 1 145 : 180 CONTINUE 146 : IF (IPOLY.NE.0) M = M + 1 147 : ENDIF 148 : IF (NLIAB.NE.0) M = M + 1 149 : SEGINI,MTAB2 150 : MTAB2.MLOTAB = M 151 : * 152 : * Sous-typage du bloc de reprise: 153 : * 154 : MTAB2.MTABTI(1) = 'MOT' 155 : ICHA6 = LCHAIN.LECT(6) 156 : MTAB2.MTABII(1) = ICHA6 157 : MTAB2.MTABTV(1) = 'MOT' 158 : ICHA5 = LCHAIN.LECT(5) 159 : MTAB2.MTABIV(1) = ICHA5 160 : * 161 : * Ecriture du temps de reprise: 162 : * 163 : TREPRI = XTEMPS(IINS-NINS) 164 : MTAB2.MTABTI(2) = 'MOT' 165 : ICHA4 = LCHAIN.LECT(4) 166 : MTAB2.MTABII(2) = ICHA4 167 : MTAB2.MTABTV(2) = 'FLOTTANT' 168 : MTAB2.RMTABV(2) = TREPRI 169 : * 170 : * Ecriture des CHPOINTs de reprise: 171 : * 172 : J2 = 2 173 : DO 20 J = 1,NREP 174 : J2 = J2 + 1 175 : MTAB2.MTABTI(J2) = 'MOT' 176 : ICHAR = LCHAIN.LECT(6+J) 177 : * chpoints des travaux 178 : IF (J.GT.8) ICHAR = LCHAIN.LECT(74+J) 179 : 180 : MTAB2.MTABII(J2) = ICHAR 181 : MTAB2.MTABTV(J2) = 'CHPOINT' 182 : MTAB2.MTABIV(J2) = IPOREP(J) 183 : 20 CONTINUE 184 : * end do 185 : * 186 : * Ecriture des variables de liaison en base A 187 : * 188 : IF (NLIAA.NE.0) THEN 189 : * 190 : * A ce jour, seule la liaison POLYNOMIALE est concernee 191 : * 192 : IF (IIMPI.EQ.333) THEN 193 : WRITE(IOIMP,*)'DEVSO4 : bloc reprise liaison POLYNOMIALE' 194 : WRITE(IOIMP,*)'Nombre de liaisons a sauver : ',IPOLY 195 : ENDIF 196 : IF (IPOLY.NE.0) THEN 197 : M = IPOLY 198 : SEGINI,MTAB1 199 : MTAB1.MLOTAB = M 200 : II = 0 201 : DO 200 I = 1,NLIAA 202 : IF (IIMPI.EQ.333) THEN 203 : WRITE(IOIMP,*)'I = ',I,' ILPOLA = ',ILPOLA(I,1) 204 : ENDIF 205 : * indice du numero de liaison base A 206 : * II = II + 1 207 : IF (ILPOLA(I,1).NE.0) THEN 208 : * indice du numero de liaison POLY 209 : II = II + 1 210 : M = 3 211 : SEGINI MTAB3 212 : MTAB3.MLOTAB = M 213 : * 214 : MTAB1.MTABTI(II) = 'ENTIER' 215 : MTAB1.MTABII(II) = II 216 : MTAB1.MTABTV(II) = 'TABLE' 217 : MTAB1.MTABIV(II) = MTAB3 218 : * 219 : MTAB3.MTABTI(1) = 'MOT' 220 : ICHAR = LCHAIN.LECT(40) 221 : MTAB3.MTABII(1) = ICHAR 222 : MTAB3.MTABTV(1) = 'ENTIER' 223 : MTAB3.MTABIV(1) = 6 224 : * 225 : MLENTI = ILPOLA(I,1) 226 : IPLEN1 = MLENTI 227 : DO 220 J = 1,NPLAA 228 : K = (J*2) - 1 229 : IPP = IPLIA(I,J) 230 : LECT(K) = JPLIA(IPP) 231 : K = J * 2 232 : LECT(K) = IPP 233 : 220 CONTINUE 234 : IF (IIMPI.EQ.333) THEN 235 : NPLA2 = NPLAA * 2 236 : DO 221 K=1,NPLA2 237 : WRITE(IOIMP,*)'DEVSO4 : LECT(',K,')=',LECT(K) 238 : 221 CONTINUE 239 : ENDIF 240 : SEGDES MLENTI 241 : * 242 : MTAB3.MTABTI(2) = 'MOT' 243 : ICHAR = LCHAIN.LECT(78) 244 : MTAB3.MTABII(2) = ICHAR 245 : MTAB3.MTABTV(2) = 'LISTENTI' 246 : MTAB3.MTABIV(2) = IPLEN1 247 : * 248 : MLREEL = ILPOLA(I,2) 249 : IPLRE1 = MLREEL 250 : DO 230 J = 1,NXPALA 251 : PROG(J) = XPALA(I,J) 252 : IF (IIMPI.EQ.333) THEN 253 : WRITE(IOIMP,*)'DEVSO4 : PROG(',J,') = ',PROG(J) 254 : ENDIF 255 : 230 CONTINUE 256 : SEGDES MLREEL 257 : * 258 : MTAB3.MTABTI(3) = 'MOT' 259 : ICHAR = LCHAIN.LECT(79) 260 : MTAB3.MTABII(3) = ICHAR 261 : MTAB3.MTABTV(3) = 'LISTREEL' 262 : MTAB3.MTABIV(3) = IPLRE1 263 : SEGDES MTAB3 264 : ENDIF 265 : 200 CONTINUE 266 : SEGDES MTAB1 267 : * 268 : * Bloc des variables internes liaison A ---> bloc de reprise 269 : * 270 : J2 = J2 + 1 271 : MTAB2.MTABTI(J2) = 'MOT' 272 : ICHAR = LCHAIN.LECT(80) 273 : MTAB2.MTABII(J2) = ICHAR 274 : MTAB2.MTABTV(J2) = 'TABLE' 275 : MTAB2.MTABIV(J2) = MTAB1 276 : ENDIF 277 : ENDIF 278 : * 279 : * Ecriture des variables de liaison en base B 280 : * 281 : IF (NLIAB.NE.0) THEN 282 : M = NLIAB 283 : SEGINI,MTAB1 284 : MTAB1.MLOTAB = M 285 : * 286 : DO 100 I = 1,NLIAB 287 : ITYP = IMREP(I,1) 288 : IF (ITYP.EQ.23 .OR. 289 : & ITYP.EQ.24 .OR. ITYP.EQ.3 .OR. ITYP.EQ.103 .OR. 290 : & ITYP.EQ.13 .OR. ITYP.EQ.113 .OR. ITYP.EQ.5 .OR. 291 : & ITYP.EQ.6 .OR. ITYP.EQ.33 .OR. ITYP.EQ.34 292 : & .OR.ITYP.EQ.-13) THEN 293 : M = 5 294 : SEGINI,MTAB3 295 : MTAB3.MLOTAB = M 296 : * 297 : MTAB1.MTABTI(I) = 'ENTIER' 298 : MTAB1.MTABII(I) = I 299 : MTAB1.MTABTV(I) = 'TABLE' 300 : MTAB1.MTABIV(I) = MTAB3 301 : * 302 : MTAB3.MTABTI(1) = 'MOT' 303 : ICHAR = LCHAIN.LECT(40) 304 : MTAB3.MTABII(1) = ICHAR 305 : MTAB3.MTABTV(1) = 'ENTIER' 306 : MTAB3.MTABIV(1) = ITYP 307 : * 308 : MTAB3.MTABTI(2) = 'MOT' 309 : ICHAR = LCHAIN.LECT(43) 310 : MTAB3.MTABII(2) = ICHAR 311 : MTAB3.MTABTV(2) = 'ENTIER' 312 : MTAB3.MTABIV(2) = IMREP(I,2) 313 : * 314 : MTAB3.MTABTI(3) = 'MOT' 315 : ICHAR = LCHAIN.LECT(41) 316 : MTAB3.MTABII(3) = ICHAR 317 : MTAB3.MTABTV(3) = 'POINT' 318 : MTAB3.MTABIV(3) = IPPREP(I,1) 319 : * 320 : MTAB3.MTABTI(4) = 'MOT' 321 : ICHAR = LCHAIN.LECT(42) 322 : MTAB3.MTABII(4) = ICHAR 323 : MTAB3.MTABTV(4) = 'POINT' 324 : MTAB3.MTABIV(4) = IPPREP(I,2) 325 : * 326 : MTAB3.MTABTI(5) = 'MOT' 327 : ICHAR = LCHAIN.LECT(37) 328 : MTAB3.MTABII(5) = ICHAR 329 : MTAB3.MTABTV(5) = 'POINT' 330 : MTAB3.MTABIV(5) = IPPREP(I,3) 331 : 332 : ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN 333 : 334 : M = 6 335 : SEGINI,MTAB3 336 : MTAB3.MLOTAB = M 337 : * 338 : MTAB1.MTABTI(I) = 'ENTIER' 339 : MTAB1.MTABII(I) = I 340 : MTAB1.MTABTV(I) = 'TABLE' 341 : MTAB1.MTABIV(I) = MTAB3 342 : * 343 : MTAB3.MTABTI(1) = 'MOT' 344 : ICHAR = LCHAIN.LECT(40) 345 : MTAB3.MTABII(1) = ICHAR 346 : MTAB3.MTABTV(1) = 'ENTIER' 347 : MTAB3.MTABIV(1) = ITYP 348 : * 349 : MTAB3.MTABTI(2) = 'MOT' 350 : ICHAR = LCHAIN.LECT(43) 351 : MTAB3.MTABII(2) = ICHAR 352 : MTAB3.MTABTV(2) = 'ENTIER' 353 : MTAB3.MTABIV(2) = IMREP(I,2) 354 : * 355 : MTAB3.MTABTI(3) = 'MOT' 356 : ICHAR = LCHAIN.LECT(41) 357 : MTAB3.MTABII(3) = ICHAR 358 : MTAB3.MTABTV(3) = 'POINT' 359 : MTAB3.MTABIV(3) = IPPREP(I,1) 360 : * 361 : MTAB3.MTABTI(4) = 'MOT' 362 : ICHAR = LCHAIN.LECT(42) 363 : MTAB3.MTABII(4) = ICHAR 364 : MTAB3.MTABTV(4) = 'POINT' 365 : MTAB3.MTABIV(4) = IPPREP(I,2) 366 : * 367 : MTAB3.MTABTI(5) = 'MOT' 368 : ICHAR = LCHAIN.LECT(37) 369 : MTAB3.MTABII(5) = ICHAR 370 : MTAB3.MTABTV(5) = 'POINT' 371 : MTAB3.MTABIV(5) = IPPREP(I,3) 372 : 373 : MTAB3.MTABTI(6) = 'MOT' 374 : ICHAR = LCHAIN.LECT(120) 375 : MTAB3.MTABII(6) = ICHAR 376 : MTAB3.MTABTV(6) = 'POINT' 377 : MTAB3.MTABIV(6) = IPPREP(I,4) 378 : 379 : ELSE IF (ITYP.EQ.35 .OR. ITYP.EQ.36 .OR. ITYP.EQ.37 380 : &.OR. ITYP.EQ.38 .OR. ITYP.EQ.39 .OR. ITYP.EQ.40 ) THEN 381 : M = 3 382 : SEGINI,MTAB3 383 : MTAB3.MLOTAB = M 384 : * 385 : MTAB1.MTABTI(I) = 'ENTIER' 386 : MTAB1.MTABII(I) = I 387 : MTAB1.MTABTV(I) = 'TABLE' 388 : MTAB1.MTABIV(I) = MTAB3 389 : * 390 : MTAB3.MTABTI(1) = 'MOT' 391 : ICHAR = LCHAIN.LECT(40) 392 : MTAB3.MTABII(1) = ICHAR 393 : MTAB3.MTABTV(1) = 'ENTIER' 394 : MTAB3.MTABIV(1) = ITYP 395 : * 396 : MTAB3.MTABTI(2) = 'MOT' 397 : ICHAR = LCHAIN.LECT(43) 398 : MTAB3.MTABII(2) = ICHAR 399 : MTAB3.MTABTV(2) = 'ENTIER' 400 : MTAB3.MTABIV(2) = IMREP(I,2) 401 : * 402 : * 403 : * noeud voisin 404 : * cr�ation du list entier contenant les noeuds voisins 405 : NNOEMA = IPALB(I,21) 406 : NNOEES = IPALB(I,22) 407 : JG = (NNOEMA+NNOEES) 408 : SEGINI,MLENTI 409 : DO 120 IVOIS=1,(NNOEMA+NNOEES) 410 : LECT(IVOIS)=IPALB(I,26+IVOIS) 411 : 120 CONTINUE 412 : IVOIS1=MLENTI 413 : SEGDES,MLENTI 414 : MTAB3.MTABTI(3) = 'MOT' 415 : ICHAR = LCHAIN.LECT(103) 416 : MTAB3.MTABII(3) = ICHAR 417 : MTAB3.MTABTV(3) = 'LISTENTI' 418 : MTAB3.MTABIV(3) = IVOIS1 419 : * 420 : ELSE IF (ITYP.EQ.7) THEN 421 : M = 4 422 : SEGINI,MTAB3 423 : MTAB3.MLOTAB = M 424 : * 425 : MTAB1.MTABTI(I) = 'ENTIER' 426 : MTAB1.MTABII(I) = I 427 : MTAB1.MTABTV(I) = 'TABLE' 428 : MTAB1.MTABIV(I) = MTAB3 429 : * 430 : MTAB3.MTABTI(1) = 'MOT' 431 : ICHAR = LCHAIN.LECT(40) 432 : MTAB3.MTABII(1) = ICHAR 433 : MTAB3.MTABTV(1) = 'ENTIER' 434 : MTAB3.MTABIV(1) = ITYP 435 : * 436 : MTAB3.MTABTI(2) = 'MOT' 437 : ICHAR = LCHAIN.LECT(9) 438 : MTAB3.MTABII(2) = ICHAR 439 : MTAB3.MTABTV(2) = 'POINT' 440 : MTAB3.MTABIV(2) = IPPREP(I,1) 441 : * 442 : MTAB3.MTABTI(3) = 'MOT' 443 : ICHAR = LCHAIN.LECT(10) 444 : MTAB3.MTABII(3) = ICHAR 445 : MTAB3.MTABTV(3) = 'POINT' 446 : MTAB3.MTABIV(3) = IPPREP(I,2) 447 : * 448 : MTAB3.MTABTI(4) = 'MOT' 449 : ICHAR = LCHAIN.LECT(12) 450 : MTAB3.MTABII(4) = ICHAR 451 : MTAB3.MTABTV(4) = 'POINT' 452 : MTAB3.MTABIV(4) = IPPREP(I,3) 453 : ** ianis 454 : ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101) THEN 455 : M = 2 456 : SEGINI,MTAB3 457 : MTAB3.MLOTAB = M 458 : * 459 : MTAB1.MTABTI(I) = 'ENTIER' 460 : MTAB1.MTABII(I) = I 461 : MTAB1.MTABTV(I) = 'TABLE' 462 : MTAB1.MTABIV(I) = MTAB3 463 : * 464 : MTAB3.MTABTI(1) = 'MOT' 465 : ICHAR = LCHAIN.LECT(40) 466 : MTAB3.MTABII(1) = ICHAR 467 : MTAB3.MTABTV(1) = 'ENTIER' 468 : MTAB3.MTABIV(1) = ITYP 469 : * 470 : IDIM = IPALB(I,3) 471 : id1 = 4 472 : MTAB3.MTABTI(2) = 'MOT' 473 : ICHAR = LCHAIN.LECT(82) 474 : MTAB3.MTABII(2) = ICHAR 475 : MTAB3.MTABTV(2) = 'FLOTTANT' 476 : MTAB3.RMTABV(2) = XPALB(I,id1+idim+1) 477 : * 478 : C NW 479 : ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN 480 : M = 4 481 : SEGINI,MTAB3 482 : MTAB3.MLOTAB = M 483 : * 484 : MTAB1.MTABTI(I) = 'ENTIER' 485 : MTAB1.MTABII(I) = I 486 : MTAB1.MTABTV(I) = 'TABLE' 487 : MTAB1.MTABIV(I) = MTAB3 488 : * 489 : MTAB3.MTABTI(1) = 'MOT' 490 : ICHAR = LCHAIN.LECT(40) 491 : MTAB3.MTABII(1) = ICHAR 492 : MTAB3.MTABTV(1) = 'ENTIER' 493 : MTAB3.MTABIV(1) = ITYP 494 : 495 : * 496 : idim = IPALB(I,3) 497 : if (ityp.eq.16) nn = 4 + idim 498 : if (ityp.eq.17) nn = 5 + idim 499 : MTAB3.MTABTI(2) = 'MOT' 500 : ICHAR = LCHAIN.LECT(82) 501 : MTAB3.MTABII(2) = ICHAR 502 : MTAB3.MTABTV(2) = 'FLOTTANT' 503 : MTAB3.RMTABV(2) = XPALB(I,NN-2) 504 : 505 : MTAB3.MTABTI(3) = 'MOT' 506 : ICHAR = LCHAIN.LECT(100) 507 : MTAB3.MTABII(3) = ICHAR 508 : MTAB3.MTABTV(3) = 'FLOTTANT' 509 : MTAB3.RMTABV(3) = XPALB(I,NN-1) 510 : 511 : MTAB3.MTABTI(4) = 'MOT' 512 : ICHAR = LCHAIN.LECT(111) 513 : MTAB3.MTABII(4) = ICHAR 514 : MTAB3.MTABTV(4) = 'FLOTTANT' 515 : MTAB3.RMTABV(4) = XPALB(I,NN) 516 : 517 : * 518 : ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN 519 : M = 4 520 : SEGINI,MTAB3 521 : MTAB3.MLOTAB = M 522 : * 523 : MTAB1.MTABTI(I) = 'ENTIER' 524 : MTAB1.MTABII(I) = I 525 : MTAB1.MTABTV(I) = 'TABLE' 526 : MTAB1.MTABIV(I) = MTAB3 527 : * 528 : MTAB3.MTABTI(1) = 'MOT' 529 : ICHAR = LCHAIN.LECT(40) 530 : MTAB3.MTABII(1) = ICHAR 531 : MTAB3.MTABTV(1) = 'ENTIER' 532 : MTAB3.MTABIV(1) = ITYP 533 : * 534 : idim = IPALB(I,3) 535 : if (ityp.eq.50) nn = 4 + idim 536 : if (ityp.eq.51) nn = 5 + idim 537 : MTAB3.MTABTI(2) = 'MOT' 538 : ICHAR = LCHAIN.LECT(102) 539 : MTAB3.MTABII(2) = ICHAR 540 : MTAB3.MTABTV(2) = 'FLOTTANT' 541 : MTAB3.RMTABV(2) = XPALB(I,NN-2) 542 : 543 : MTAB3.MTABTI(3) = 'MOT' 544 : ICHAR = LCHAIN.LECT(99) 545 : MTAB3.MTABII(3) = ICHAR 546 : MTAB3.MTABTV(3) = 'FLOTTANT' 547 : MTAB3.RMTABV(3) = XPALB(I,NN-1) 548 : 549 : MTAB3.MTABTI(4) = 'MOT' 550 : ICHAR = LCHAIN.LECT(112) 551 : MTAB3.MTABII(4) = ICHAR 552 : MTAB3.MTABTV(4) = 'FLOTTANT' 553 : MTAB3.RMTABV(4) = XPALB(I,NN) 554 : * 555 : ELSE 556 : M = 1 557 : SEGINI,MTAB3 558 : MTAB3.MLOTAB = M 559 : * 560 : MTAB1.MTABTI(I) = 'ENTIER' 561 : MTAB1.MTABII(I) = I 562 : MTAB1.MTABTV(I) = 'TABLE' 563 : MTAB1.MTABIV(I) = MTAB3 564 : * 565 : MTAB3.MTABTI(1) = 'MOT' 566 : ICHAR = LCHAIN.LECT(40) 567 : MTAB3.MTABII(1) = ICHAR 568 : MTAB3.MTABTV(1) = 'ENTIER' 569 : MTAB3.MTABIV(1) = ITYP 570 : ENDIF 571 : * 572 : SEGDES,MTAB3 573 : 100 CONTINUE 574 : * end do 575 : SEGDES,MTAB1 576 : * 577 : * Ecriture du bloc des variables de liaison dans le bloc reprise 578 : * 579 : J2 = J2 + 1 580 : MTAB2.MTABTI(J2) = 'MOT' 581 : ICHAR = LCHAIN.LECT(44) 582 : MTAB2.MTABII(J2) = ICHAR 583 : MTAB2.MTABTV(J2) = 'TABLE' 584 : MTAB2.MTABIV(J2) = MTAB1 585 : ENDIF 586 : * 587 : SEGDES,MTAB2 588 : * 589 : * Ecriture du bloc de reprise dans la table r{sultat: 590 : * 591 : 592 : IF (LMODYN) THEN 593 : iptlar = mtab2 593 : CALL ECCTAB(ITDYN,'MOT',0,0.D0,'REPRISE_DYNE',.TRUE.,0, 594 : # 'TABLE',0,0.D0,CHARRE,.TRUE.,iptlar) 595 : ELSE 596 : MTABTI(3) = 'MOT' 597 : ICHA5 = LCHAIN.LECT(5) 598 : MTABII(3) = ICHA5 599 : MTABTV(3) = 'TABLE' 600 : MTABIV(3) = MTAB2 601 : ENDIF 602 : * 603 : IRE2 = 3 604 : * 605 : *---------- Cr{ation des tables aux pas de sortie ---------- 606 : * 607 : IF (LMODYN) THEN 608 : * 609 : typobj = ' ' 609 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'TEMPS',L0,IP0, 610 : & typobj,np,X1,CHARRE,L1,IPTEMP) 611 : M = 1 612 : segini MTABU 613 : MTABU.MLOTAB = 1 614 : if (iptemp.gt.0.and.typobj(1:8).eq.'TABLE') then 614 : call dimen7(iptemp,idimen) 615 : indi1 = idimen - 1 616 : DO ISOR = 1 , 8 617 : IF (ICHRES(ISOR).EQ.1) THEN 618 : ICHAR = LCHAIN.LECT(6+ISOR) 619 : IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR) 620 : segact MTABU*mod 621 : MTABU.MTABTI(1) = 'ENTIER' 622 : MTABU.MTABII(1) = 1 623 : MTABU.MTABTV(1) = 'MOT' 624 : MTABU.MTABIV(1) = ICHAR 625 : typret=' ' 625 : CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0, 626 : & typret,IUI,X1,CHARRE,L1,IP1) 627 : if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES' 628 : if (CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS' 628 : CALL ACCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0, 629 : # 'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP) 630 : ipotab(isor) = IPTCHP 631 : ENDIF 632 : ENDDO 633 : 634 : else 635 : 635 : CALL CRTABL(IPTEMP) 635 : CALL ECCTAB(ITDYN,'MOT',0,0.D0,'TEMPS',.TRUE.,0, 636 : # 'TABLE',0,0.D0,CHARRE,.TRUE.,iptemp) 637 : indi1 = -1 638 : DO ISOR = 1 , 8 639 : IF (ICHRES(ISOR).EQ.1) THEN 639 : CALL CRTABL(IPTCHP) 640 : ipotab(isor) = IPTCHP 641 : ICHAR = LCHAIN.LECT(6+ISOR) 642 : IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR) 643 : segact MTABU*mod 644 : MTABU.MTABTI(1) = 'ENTIER' 645 : MTABU.MTABII(1) = 1 646 : MTABU.MTABTV(1) = 'MOT' 647 : MTABU.MTABIV(1) = ICHAR 648 : typret=' ' 648 : CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0, 649 : & typret,IUI,X1,CHARRE,L1,IP1) 650 : 651 : if (CHARRE.EQ.'VITESSE') CHARRE = 'VITESSES' 652 : if (CHARRE.EQ.'DEPLACEMENT') CHARRE = 'DEPLACEMENTS' 652 : CALL ECCTAB(ITDYN,'MOT',0,0.D0,CHARRE,.TRUE.,0, 653 : # 'TABLE',0,0.D0,CHARRI,.TRUE.,IPTCHP) 654 : ENDIF 655 : ENDDO 656 : segsup MTABU 657 : endif 658 : MLREEL = IPOLR(1) 659 : segact mlreel 660 : indi0 = indi1 661 : 662 : DO ires = 1,npres 663 : indi1 = indi1 + 1 664 : xtemp1 = prog(ires) 665 : * temps calcules 665 : CALL ECCTAB(IPTEMP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0, 666 : # 'FLOTTANT',0,xtemp1,CHARRE,.TRUE.,IP1) 667 : ENDDO 668 : ENDIF 669 : 670 : IF (NRES.NE.0) THEN 671 : IF (LMODYN) THEN 672 : indi1 = indi0 673 : DO ires = 1,npres 674 : indi1 = indi1 + 1 675 : IVAR = 0 676 : DO isor = 1,8 677 : * champs en sortie 678 : IF (ICHRES(ISOR).EQ.1) THEN 679 : IVAR = IVAR + 1 680 : IPTCHP = ipotab(isor) 681 : ipch1 = IPORES(IVAR,IRES) 681 : CALL ECCTAB(IPTCHP,'ENTIER',INDI1,0.D0,CHARRI,.TRUE.,IP0, 682 : # 'CHPOINT',0,0.D0,CHARRE,.TRUE.,ipch1) 683 : 684 : ENDIF 685 : ENDDO 686 : 687 : ENDDO 688 : * 689 : ELSE 690 : * 691 : DO 30 IRES = 1 , NPRES 692 : * 693 : * Cr{ation de la table au pas de sortie IRES: 694 : * 695 : M = NRES + 1 696 : SEGINI,MTAB1 697 : MTAB1.MLOTAB = M 698 : * 699 : * Sous-typage de la table au pas de sortie IRES: 700 : * 701 : MTAB1.MTABTI(1) = 'MOT' 702 : ICHA6 = LCHAIN.LECT(6) 703 : MTAB1.MTABII(1) = ICHA6 704 : MTAB1.MTABTV(1) = 'MOT' 705 : ICHA2 = LCHAIN.LECT(2) 706 : MTAB1.MTABIV(1) = ICHA2 707 : * 708 : * Ecriture des CHPOINTs r{sultats: 709 : * 710 : IVA2 = 1 711 : IVAR = 0 712 : DO 40 ISOR = 1 , 8 713 : IF (ICHRES(ISOR).EQ.1) THEN 714 : IVA2 = IVA2 + 1 715 : IVAR = IVAR + 1 716 : MTAB1.MTABTI(IVA2) = 'MOT' 717 : ICHAR = LCHAIN.LECT(6+ISOR) 718 : * chpoints de travaux 719 : IF(ISOR.GT.6) ICHAR = LCHAIN.LECT(76+ISOR) 720 : MTAB1.MTABII(IVA2) = ICHAR 721 : MTAB1.MTABTV(IVA2) = 'CHPOINT' 722 : MTAB1.MTABIV(IVA2) = IPORES(IVAR,IRES) 723 : ENDIF 724 : 40 CONTINUE 725 : * end do 726 : SEGDES,MTAB1 727 : * 728 : * Ecriture de la table au pas IRES dans la table r{sultat: 729 : * 730 : IRE2 = IRE2 + 1 731 : MTABTI(IRE2) = 'ENTIER' 732 : MTABII(IRE2) = IRES 733 : MTABTV(IRE2) = 'TABLE' 734 : MTABIV(IRE2) = MTAB1 735 : 30 CONTINUE 736 : * end do 737 : ENDIF 738 : ENDIF 739 : 740 : 1234 CONTINUE 741 : * 742 : *----- Cr{ation des tables de liaisons aux pas de sortie ----- 743 : * 744 : IPTLA1 = 0 745 : IF (LMODYN) THEN 746 : IF (NLSA.NE.0.OR.NLSB.NE.0) THEN 747 : typobj = ' ' 747 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'LIAISONS',L0,IP0, 748 : & typobj,np,X1,CHARRE,L1,IPTLA1) 749 : if (iptla1.gt.0.and.typobj(1:8).eq.'TABLE') then 749 : call dimen7(iptla1,idimen) 750 : indi1 = idimen - 1 751 : else 751 : CALL CRTABL(IPTLA1) 752 : c* idimen = 0 753 : c* indi1 = -1 753 : CALL ECCTAB(ITDYN,'MOT',0,0.D0,'LIAISONS',.TRUE.,0, 754 : # 'TABLE',0,0.D0,CHARRE,.TRUE.,IPTLA1) 755 : ENDIF 756 : ENDIF 757 : ENDIF 758 : * 759 : MTABU = 0 760 : M = 1 761 : segini MTABU 762 : MTABU.MLOTAB = 1 763 : 764 : IF (NLSA.NE.0) THEN 765 : DO 50 IL = 1,NLSA 766 : * 767 : * Cr{ation de la table pour la liaison IL : 768 : * 769 : NVAR = ICHRES(10 + IL) 770 : M = NVAR + 1 771 : SEGINI,MTAB3 772 : MTAB3.MLOTAB = M 773 : * 774 : * Sous-typage de la table pour la liaison IL : 775 : * 776 : ID = 1 777 : MTAB3.MTABTI(ID) = 'MOT' 778 : ICHA6 = LCHAIN.LECT(6) 779 : MTAB3.MTABII(ID) = ICHA6 780 : MTAB3.MTABTV(ID) = 'MOT' 781 : ICHA1 = LCHAIN.LECT(ID) 782 : MTAB3.MTABIV(ID) = ICHA1 783 : * 784 : IPTLA3 = 0 785 : IF (LMODYN) THEN 786 : itmodl = IPOLA(IL) 787 : typobj = ' ' 787 : CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl, 788 : & typobj,np,X1,CHARRI,L1,IPTLA3) 789 : 790 : if (typobj.eq.'TABLE'.and.iptla3.gt.0) then 791 : ipta3 = 0 792 : else 793 : iptla3 = 0 794 : ipta3 = mtab3 794 : CALL ECCTAB(IPTLA1,'MMODEL ',0,0.D0,CHARRE,.TRUE.,itmodl, 795 : # 'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3) 796 : endif 797 : ELSE 798 : * 799 : * Ecriture de la table de liaison dans la table r{sultat: 800 : * 801 : IRE2 = IRE2 + 1 802 : MTABTI(IRE2) = 'TABLE' 803 : MTABII(IRE2) = IPOLA(IL) 804 : MTABTV(IRE2) = 'TABLE' 805 : MTABIV(IRE2) = MTAB3 806 : * 807 : ENDIF 808 : * 809 : II = 0 810 : IF (IIMPI.EQ.333) THEN 811 : WRITE(IOIMP,*)'DEVSO4 : creation table liaison ',IL 812 : WRITE(IOIMP,*)'DEVSO4 : longueur table = ',M 813 : WRITE(IOIMP,*)'DEVSO4 : !!! NTVAR = ',NTVAR 814 : ENDIF 815 : DO 52 IV = 1,NTVAR 816 : IF (ILIREA(IL,IV).EQ.1) THEN 817 : II = II + 1 818 : ICHA = ILIRNA(IL,IV) 819 : MLREEL = IPLRLA(IL,II) 820 : DO 54 IRES = 1 , NPRES 821 : PROG(IRES) = XRESLA(IL,IRES,II) 822 : 54 CONTINUE 823 : * end do 824 : ipl2 = mlreel 825 : SEGDES,MLREEL 826 : * 827 : * Ecriture de la liste de r{els dans la table MTAB3 : 828 : * 829 : ID = ID + 1 830 : MTAB3.MTABTI(ID) = 'MOT' 831 : MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA) 832 : MTAB3.MTABTV(ID) = 'LISTREEL' 833 : MTAB3.MTABIV(ID) = MLREEL 834 : ENDIF 835 : 52 CONTINUE 836 : * end do 837 : if (IPTLA3.gt.0.and.ILIREA(IL,IV).EQ.1) then 838 : ICHAR = LCHAIN.LECT(ICHA) 839 : segact MTABU*mod 840 : MTABU.MTABTI(1) = 'ENTIER' 841 : MTABU.MTABII(1) = 1 842 : MTABU.MTABTV(1) = 'MOT' 843 : MTABU.MTABIV(1) = ICHAR 844 : typret=' ' 844 : CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0, 845 : & typret,IUI,X1,CHARRE,L1,IP1) 846 : typret=' ' 846 : CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0, 847 : # typret,0,0.D0,CHARRI,.TRUE.,IPTC3) 848 : if (typret.eq.'LISTREEL') then 848 : call fuspro(iptc3,ipl2,ipl3) 848 : CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0, 849 : # typret,0,0.D0,CHARRI,.TRUE.,ipl3) 850 : else if (typret.eq.'TABLE') then 851 : MTAB4 = IPTC3 852 : segact MTAB4,MTAB1 853 : M4 = MTAB4.MLOTAB 854 : do IRES = 1,NPRES 855 : ipch3 = MTAB1.MTABIV(IRES) 855 : CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0, 856 : # 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3) 857 : 858 : enddo 859 : segsup MTAB1 860 : segdes MTAB4 861 : else 862 : endif 863 : 864 : endif 865 : SEGDES,MTAB3 866 : if (IPTLA3.gt.0) segsup MTAB3 867 : * 868 : 50 CONTINUE 869 : * end do 870 : ENDIF 871 : IF (NLSB.NE.0) THEN 872 : DO 60 IL = 1,NLSB 873 : * 874 : * Cr{ation de la table pour la liaison IL : 875 : * 876 : NVAR = ICHRES(10 + IL + NLSA) 877 : M = NVAR + 1 878 : SEGINI,MTAB3 879 : MTAB3.MLOTAB = M 880 : * 881 : * Sous-typage de la table pour la liaison IL : 882 : * 883 : ID = 1 884 : MTAB3.MTABTI(ID) = 'MOT' 885 : ICHA6 = LCHAIN.LECT(6) 886 : MTAB3.MTABII(ID) = ICHA6 887 : MTAB3.MTABTV(ID) = 'MOT' 888 : ICHA1 = LCHAIN.LECT(ID) 889 : MTAB3.MTABIV(ID) = ICHA1 890 : * 891 : * Ecriture de la table de liaison dans la table r{sultat: 892 : * 893 : IPTLA3 = 0 894 : IF (LMODYN) THEN 895 : itmodl = IPOLB(IL) 896 : typobj = ' ' 896 : CALL ACCTAB(IPTLA1,'MMODEL ',IM,X0,CHARRE,L0,itmodl, 897 : & typobj,np,X1,CHARRI,L1,IPTLA3) 898 : ipta3 = mtab3 899 : if (typobj.eq.'TABLE'.and.iptla3.gt.0) then 900 : else 901 : iptla3 = 0 901 : CALL ECCTAB(IPTLA1,'MMODEL ',0,0.D0,CHARRE,.TRUE.,itmodl, 902 : # 'TABLE',0,0.D0,CHARRI,.TRUE.,ipta3) 903 : endif 904 : ELSE 905 : IRE2 = IRE2 + 1 906 : MTABTI(IRE2) = 'TABLE' 907 : MTABII(IRE2) = IPOLB(IL) 908 : MTABTV(IRE2) = 'TABLE' 909 : MTABIV(IRE2) = MTAB3 910 : * 911 : ENDIF 912 : * 913 : II = 0 914 : DO 62 IV = 1,NTVAR 915 : IF (ILIREB(IL,IV).EQ.1) THEN 916 : II = II + 1 917 : ICHA = ILIRNB(IL,IV) 918 : 919 : MLREEL = IPLRLB(IL,II) 920 : DO 64 IRES = 1 , NPRES 921 : PROG(IRES) = XRESLB(IL,IRES,II) 922 : 64 CONTINUE 923 : * end do 924 : ipl2 = mlreel 925 : SEGDES,MLREEL 926 : * 927 : * Ecriture de la liste de r{els dans la table MTAB3 : 928 : * 929 : ID = ID + 1 930 : MTAB3.MTABTI(ID) = 'MOT' 931 : MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA) 932 : MTAB3.MTABTV(ID) = 'LISTREEL' 933 : MTAB3.MTABIV(ID) = MLREEL 934 : ELSE 935 : * Ecriture des chpoints dans la table MTAB1, puis de cette 936 : * table dans la table MTAB3 937 : IF (ILIREB(IL,IV).EQ.2) THEN 938 : ICHA = ILIRNB(IL,IV) 939 : MTAB1 = IPLRLB(IL,II+1) 940 : SEGACT,MTAB1*MOD 941 : MLENTI= IPLRLB(IL,II+2) 942 : SEGACT,MLENTI 943 : DO 65 IRES=1,NPRES 944 : III=II 945 : MCHPOI=LECT(IRES) 946 : SEGACT MCHPOI 947 : MSOUPO=IPCHP(1) 948 : SEGACT,MSOUPO 949 : MPOVAL=IPOVAL 950 : SEGACT,MPOVAL*MOD 951 : DO 66 IP=1,NPLB 952 : DO 67 IDD=1,2 953 : III=III+1 954 : VPOCHA(IP,IDD)=XRESLB(IL,IRES,III) 955 : 67 CONTINUE 956 : 66 CONTINUE 957 : SEGDES,MPOVAL,MSOUPO,MCHPOI 958 : MTAB1.MTABIV(IRES)=MCHPOI 959 : 65 CONTINUE 960 : SEGSUP,MLENTI 961 : SEGDES,MTAB1 962 : II=III 963 : ID = ID + 1 964 : MTAB3.MTABTI(ID) = 'MOT' 965 : MTAB3.MTABII(ID) = LCHAIN.LECT(ICHA) 966 : MTAB3.MTABTV(ID) = 'TABLE' 967 : MTAB3.MTABIV(ID) = MTAB1 968 : ENDIF 969 : ENDIF 970 : if (IPTLA3.gt.0.and. 971 : & (ILIREB(IL,IV).EQ.1.or.ILIREB(IL,IV).EQ.2)) then 972 : ICHAR = LCHAIN.LECT(ICHA) 973 : segact MTABU*mod 974 : MTABU.MTABTI(1) = 'ENTIER' 975 : MTABU.MTABII(1) = 1 976 : MTABU.MTABTV(1) = 'MOT' 977 : MTABU.MTABIV(1) = ICHAR 978 : typret=' ' 978 : CALL ACCTAB(MTABU,'ENTIER',1,X0,CHARRI,L0,IP0, 979 : & typret,IUI,X1,CHARRE,L1,IP1) 980 : typret=' ' 980 : CALL ACCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0, 981 : # typret,0,0.D0,CHARRI,.TRUE.,IPTC3) 982 : if (typret.eq.'LISTREEL') then 982 : call fuspro(iptc3,ipl2,ipl3) 982 : CALL ECCTAB(IPTLA3,'MOT',0,0.D0,CHARRE,.TRUE.,0, 983 : # typret,0,0.D0,CHARRI,.TRUE.,ipl3) 984 : else if (typret.eq.'TABLE') then 985 : MTAB4 = IPTC3 986 : segact MTAB4,MTAB1 987 : M4 = MTAB4.MLOTAB 988 : do IRES = 1,NPRES 989 : ipch3 = MTAB1.MTABIV(IRES) 989 : CALL ECCTAB(IPTC3,'ENTIER',M4+IRES,0.D0,CHARRE,.TRUE.,0, 990 : # 'CHPOINT ',0,0.D0,CHARRI,.TRUE.,ipch3) 991 : 992 : enddo 993 : segsup MTAB1 994 : segdes MTAB4 995 : else 996 : endif 997 : 998 : endif 999 : 62 CONTINUE 1000 : * end do 1001 : SEGDES,MTAB3 1002 : if (IPTLA3.gt.0) segsup MTAB3 1003 : 60 CONTINUE 1004 : * end do 1005 : ENDIF 1006 : 1007 : segsup MTABU 1008 : IF (ITSORT.EQ.INDC10) THEN 1009 : if (iptla1.gt.0) THEN 1010 : MTAB1 = IPTLA1 1011 : segsup MTAB1 1012 : ENDIF 1013 : if (itdyn.gt.0) THEN 1014 : MTAB2 = ITDYN 1015 : segsup MTAB2 1016 : ITDYN = MTAB3 1017 : ENDIF 1018 : RETURN 1019 : ENDIF 1020 : SEGDES,MTABLE 1021 : * 1022 : RETURN 1023 : END 1024 : 1025 : 1026 : 1027 : 1028 : 1029 : 1030 : 1031 :
© Cast3M 2003 - All rights reserved.
Disclaimer