1 : C DEVALO SOURCE FANDEUR 13/01/16 21:15:07 7665 2 : SUBROUTINE DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, 3 : & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA, 4 : & KTLIAB,KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS, 5 : & ICHAIN,KOCLFA,KOCLB1,ITCARA,LMODYN) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : *--------------------------------------------------------------------* 9 : * * 10 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 11 : * ________________________________________________ * 12 : * * 13 : * Dimensionnement des tableaux de travail ( allocation de la * 14 : * memoire ). * 15 : * * 16 : * Parametres: * 17 : * * 18 : * e ITBAS Table repr�sentant une base modale * 19 : * e ITKM Table contenant les matrices XK et XM * 20 : * e ITA Table contenant la matrice XASM * 21 : * e ITLIA Table rassemblant la description des liaisons * 22 : * e ITCHAR Table contenant les chargements * 23 : * e ITINIT Table donnant les conditions initiales * 24 : * e NP Nombre de pas de calcul * 25 : * e PDT Valeur du pas de temps * 26 : * e NINS On veut une sortie tous les NINS pas de calcul * 27 : * e ITSORT Table d�finissant les r�sultats attendus * 28 : * e ITREDU Table contenant les noms d'inconnues de la base B * 29 : * auxquelles on se restreint * 30 : * e KPREF Segment des points de r�f�rence * 31 : * s MTQ Segment contenant les variables g�n�ralis�es * 32 : * (et les travaux) 33 : * s MTKAM Segment contenant les vecteurs XK, XASM et XM * 34 : * s MTPHI Segment contenant les d�form�es modales * 35 : * s MTLIAA Segment descriptif des liaisons en base A * 36 : * s MTLIAB Segment descriptif des liaisons en base B * 37 : * s MTFEX Segment contenant les chargements libres * 38 : * s MTPAS Segment des variables au cours d'un pas de temps * 39 : * s MTRES Segment de sauvegarde des resultats * 40 : * s MTNUM Segment contenant les parametres temporels * 41 : * s IPMAIL Maillage de reference pour les CHPOINTs resultats * 42 : * s REPRIS Vrai si reprise de calcul, faux sinon * 43 : * s ICHAIN Segment MLENTI (ACTIF) contenant les adresses des * 44 : * chaines dans la pile des mots de CCNOYAU * 45 : * s KOCLFA Segment contenant les tableaux locaux de la subroutine * 46 : * DEVLFA * 47 : * s KOCLB1 Segment contenant les tableaux locaux de la subroutine * 48 : * DEVLB1 * 49 : * * 50 : * Auteur, date de creation: * 51 : * * 52 : * Denis ROBERT-MOUGIN, le 25 mai 1989. * 53 : * NTRA passe a 10000 le 28/1/93 par D. R. * 54 : *--------------------------------------------------------------------* 55 : -INC CCOPTIO 56 : -INC SMCOORD 57 : -INC SMMODEL 58 : -INC SMELEME 59 : -INC SMCHAML 60 : -INC SMLENTI 61 : * 62 : * Segment des variables g�n�ralis�es: 63 : * 64 : SEGMENT,MTQ 65 : REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) 66 : REAL*8 WEXT(NA1,2),WINT(NA1,2) 67 : ENDSEGMENT 68 : * 69 : * Segment contenant les matrices XK, XASM et XM: 70 : * 71 : SEGMENT,MTKAM 72 : REAL*8 XK(NA1),XASM(NA1),XM(NA1) 73 : ENDSEGMENT 74 : * 75 : * Segment des d�form�es modales: 76 : * 77 : SEGMENT,MTPHI 78 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 79 : INTEGER IAROTA(NSB) 80 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 81 : ENDSEGMENT 82 : * 83 : * Segment descriptif des liaisons en base A: 84 : * 85 : SEGMENT,MTLIAA 86 : INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) 87 : REAL*8 XPALA(NLIAA,NXPALA) 88 : ENDSEGMENT 89 : * 90 : * Segment descriptif des liaisons en base B: 91 : * 92 : SEGMENT MTLIAB 93 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 94 : REAL*8 XPALB(NLIAB,NXPALB) 95 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 96 : ENDSEGMENT 97 : * 98 : * Segment repr�sentant les chargements libres: 99 : * 100 : SEGMENT,MTFEX 101 : REAL*8 FEXA(NPFEXA,NPC1,2) 102 : REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) 103 : REAL*8 FTEXB(NPLB,NPC1,2,IDIM) 104 : INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) 105 : ENDSEGMENT 106 : * 107 : * Segment contenant les variables au cours d'un pas de temps: 108 : * 109 : SEGMENT,MTPAS 110 : REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) 111 : REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4) 112 : REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) 113 : REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) 114 : ENDSEGMENT 115 : * 116 : * Segment de sauvegarde des resultats (active dans DYNE15) : 117 : * 118 : SEGMENT,MTRES 119 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) 120 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) 121 : REAL*8 XMREP(NLIAB,4,IDIMB) 122 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) 123 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) 124 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) 125 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) 126 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) 127 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) 128 : INTEGER ILPOLA(NLIAA,2) 129 : ENDSEGMENT 130 : * 131 : * Segment contenant les param�tres temporels: 132 : * 133 : SEGMENT,MTNUM 134 : REAL*8 XDT(NPC1),XTEMPS(NPC1) 135 : ENDSEGMENT 136 : * 137 : * Segment des points de r�f�rence: 138 : * 139 : SEGMENT,MPREF 140 : INTEGER IPOREF(NPREF) 141 : ENDSEGMENT 142 : * 143 : * Segment de points 144 : * 145 : SEGMENT,NCPR(XCOOR(/1)/(IDIM+1)) 146 : * 147 : * Segment de travail pour reprise force POLYNOMIALE base A 148 : * 149 : SEGMENT,MTRA 150 : INTEGER IPLA(NTRA) 151 : ENDSEGMENT 152 : * 153 : * Segment "local" pour DEVLFA ... 154 : SEGMENT,LOCLFA 155 : REAL*8 FTEST(NA1,4),FTOTA0(NA1,4) 156 : ENDSEGMENT 157 : * Segment "local" pour DEVLB1 ... 158 : SEGMENT,LOCLB1 159 : REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6) 160 : ENDSEGMENT 161 : * Segment pour Champoints 162 : SEGMENT,MSAM 163 : integer jplibb(NPLB) 164 : ENDSEGMENT 165 : * segment chapeau modeles liaisons 166 : SEGMENT MOLIAI 167 : integer modtla,modtlb 168 : ENDSEGMENT 169 : * 170 : segment mwinit 171 : integer jpdep,jpvit,jrepr 172 : endsegment 173 : segment mtbas 174 : integer itbmod,lsstru(np1),nsstru 175 : endsegment 176 : segment icma(0) 177 : segment icnna2(0) 178 : LOGICAL L0,L1,REPRIS,LMODYN 179 : CHARACTER*6 MO2 180 : CHARACTER*8 TYPRET,CHARRE 181 : CHARACTER*10 MO1 182 : CHARACTER*40 MONMOT 183 : * 184 : ITREP = 0 185 : MTQ = 0 186 : MTKAM = 0 187 : MTPHI = 0 188 : MTLIAA = 0 189 : MTLIAB = 0 190 : MTFEX = 0 191 : MTPAS = 0 192 : MTRES = 0 193 : MTNUM = 0 194 : MTRA = 0 195 : XTINI = 0.D0 196 : ITLA = 0 197 : ITLB = 0 198 : REPRIS = .FALSE. 199 : * 200 : * On r�cup�re le cas �ch�ant, le temps de reprise: 201 : * 202 : IF (ITINIT.NE.0) THEN 203 : if (lmodyn) then 204 : mwinit = itinit 205 : segact mwinit 206 : if (jrepr.gt.0) then 207 : itrep = jrepr 208 : REPRIS = .TRUE. 208 : CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0, 209 : & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1) 210 : IF (IERR.NE.0) RETURN 211 : endif 212 : else 213 : TYPRET = ' ' 213 : CALL ACCTAB(ITINIT,'MOT',I0,X0,'REPRISE',L0,IP0, 214 : & TYPRET,I1,X1,CHARRE,L1,ITREP) 215 : IF (IERR.NE.0) RETURN 216 : IF (ITREP.NE.0) THEN 217 : IF (TYPRET.EQ.'TABLE ') THEN 218 : REPRIS = .TRUE. 218 : CALL ACCTAB(ITREP,'MOT',I0,X0,'TEMPS_DE_REPRISE',L0,IP0, 219 : & 'FLOTTANT',I1,XTINI,CHARRE,L1,IP1) 220 : IF (IERR.NE.0) RETURN 221 : ELSE 221 : CALL ERREUR(487) 222 : RETURN 223 : ENDIF 224 : ENDIF 225 : endif 226 : ENDIF 227 : * 228 : * Param�tres temporels: 229 : * 230 : NPC1 = NP + 1 231 : SEGINI,MTNUM 232 : KTNUM = MTNUM 233 : XDT(1) = PDT 234 : XTEMPS(1) = XTINI 235 : DO 10 I = 2,NPC1 236 : XDT(I) = PDT 237 : XTEMPS(I) = XTEMPS(I-1) + PDT 238 : 10 CONTINUE 239 : * end do 240 : * 241 : * Recherche du nombre de modes: autant que de points de r�f�rence 242 : * 243 : MPREF = KPREF 244 : NA1 = IPOREF(/1) 245 : SEGINI,MTQ,MTKAM 246 : SEGINI,LOCLFA 247 : KOCLFA = LOCLFA 248 : KTQ = MTQ 249 : KTKAM = MTKAM 250 : * 251 : * Gestion des segments descriptifs des liaisons 252 : * 253 : NLIAA = 0 254 : NIPALA = 0 255 : NXPALA = 0 256 : NPLAA = 0 257 : NPLA = 0 258 : NLIAB = 0 259 : NIPALB = 0 260 : NXPALB = 0 261 : NPLBB = 0 262 : NPLB = 0 263 : NPLSB = 0 264 : IDIMB = 0 265 : NA2 = 0 266 : NSB = 0 267 : KCPR = 0 268 : NTVAR = 6 + 4 * IDIM 269 : * 270 : * MTRA indiquera la presence de liaisons POLYNOMIALEs 271 : * (on suppose un maximum de 100 liaisons en base A) 272 : *+* passe a 10000 le 28/1/93 273 : NTRA = 10000 274 : SEGINI,MTRA 275 : * 276 : IF (ITLIA.NE.0) THEN 277 : if (lmodyn) then 278 : mtbas = itbas 279 : ipbmod = itbmod 279 : call ecrcha('MAIL') 279 : call ecrobj('MMODEL',ipbmod) 279 : call extrai 279 : call lirobj('MAILLAGE',ipt1,0,iret) 280 : if (ierr.ne.0) return 281 : if (iret.ne.1) then 282 : write(6,*) 'pb developpement devalo' 283 : return 284 : endif 285 : itmail = ipt1 286 : segact ipt1 287 : segini ncpr 288 : do ie = 1,ipt1.num(/2) 289 : ncpr(ipt1.num(1,ie)) = 1 290 : enddo 291 : 292 : mmodel = itlia 293 : segact mmodel 294 : n1 = kmodel(/1) 295 : segini mmode1,mmode2 296 : klia = 0 297 : klib = 0 298 : do ik = 1,kmodel(/1) 299 : imodel = kmodel(ik) 300 : segact imodel 301 : meleme = imamod 302 : segact meleme 303 : 304 : if (ncpr(num(1,1)).gt.0) then 305 : klia = klia + 1 306 : mmode1.kmodel(klia) = imodel 307 : else 308 : klib = klib + 1 309 : mmode2.kmodel(klib) = imodel 310 : endif 311 : 312 : enddo 313 : segdes mmodel 314 : n1 = klia 315 : itla = mmode1 316 : segadj mmode1 317 : n1 = klib 318 : segadj mmode2 319 : itlb = mmode2 320 : segsup ncpr 321 : segini moliai 322 : modtla = itla 323 : if (klia.eq.0) modtla = 0 324 : modtlb = itlb 325 : if (klib.eq.0) modtlb = 0 326 : * distingue liasons A et B 327 : ITLIA = MOLIAI 328 : * 329 : else 330 : * 331 : TYPRET = ' ' 331 : CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_A',L0,IP0, 332 : & TYPRET,I1,X1,CHARRE,L1,ITLA) 333 : IF (IERR.NE.0) RETURN 334 : * 335 : * Liaisons sur la base A : determination des parametres 336 : * 337 : IF (ITLA.NE.0.and.(.not.lmodyn)) THEN 338 : IF (TYPRET.EQ.'TABLE ') THEN 338 : CALL DYNE21(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA) 339 : IF (IERR.NE.0) RETURN 340 : NLIAA = KLIAA 341 : NIPALA = KIPALA 342 : NXPALA = KXPALA 343 : NPLAA = KPLAA 344 : NPLA = NA1 345 : ELSE 345 : CALL ERREUR(492) 346 : RETURN 347 : ENDIF 348 : ENDIF 349 : * 350 : * Liaisons sur la base B : determination des parametres 351 : * 352 : TYPRET = ' ' 352 : CALL ACCTAB(ITLIA,'MOT',I0,X0,'LIAISON_B',L0,IP0, 353 : & TYPRET,I1,X1,CHARRE,L1,ITLB) 354 : IF (IERR.NE.0) RETURN 355 : IF (ITLB.NE.0.and.(.not.lmodyn)) THEN 356 : IF (TYPRET.EQ.'TABLE ') THEN 356 : CALL DYNE22(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR, 357 : & KIPALB,KNIP) 358 : IF (IERR.NE.0) RETURN 359 : NLIAB = KLIAB 360 : NIPALB = KIPALB 361 : NXPALB = KXPALB 362 : NPLBB = KPLBB 363 : NPLB = KPLB 364 : IDIMB = KDIMB 365 : NIP = KNIP 366 : ELSE 366 : CALL ERREUR(493) 367 : RETURN 368 : ENDIF 369 : ENDIF 370 : * 371 : endif 372 : * 373 : if (lmodyn.and.klia.gt.0) then 373 : CALL DYNE71(ITLA,PDT,MTRA,KLIAA,KXPALA,KPLAA,KIPALA) 374 : IF (IERR.NE.0) RETURN 375 : NLIAA = KLIAA 376 : NIPALA = KIPALA 377 : NXPALA = KXPALA 378 : NPLAA = KPLAA 379 : NPLA = NA1 380 : endif 381 : if (lmodyn.and.klib.gt.0) then 381 : CALL DYNE72(ITLB,KLIAB,KXPALB,KPLBB,KPLB,KDIMB,KCPR, 382 : & KIPALB,KNIP,ITCARA) 383 : IF (IERR.NE.0) RETURN 384 : NLIAB = KLIAB 385 : NIPALB = KIPALB 386 : NXPALB = KXPALB 387 : NPLBB = KPLBB 388 : NPLB = KPLB 389 : IDIMB = KDIMB 390 : NIP = KNIP 391 : endif 392 : ENDIF 393 : SEGINI,LOCLB1 394 : KOCLB1 = LOCLB1 395 : * 396 : * Les segments seront remplis dans le s-p DEVLIA: 397 : * 398 : SEGINI,MTLIAA 399 : SEGINI,MTLIAB 400 : KTLIAA = MTLIAA 401 : KTLIAB = MTLIAB 402 : IF (NLIAB.NE.0) THEN 403 : NCPR = KCPR 404 : LCPR = XCOOR(/1) / (IDIM + 1) 405 : IN = 0 406 : DO 20 I = 1,LCPR 407 : IF (NCPR(I).NE.0) THEN 408 : IN = IN + 1 409 : JPLIB(IN) = I 410 : ENDIF 411 : 20 CONTINUE 412 : * en do 413 : SEGSUP,NCPR 414 : ENDIF 415 : * 416 : * Segment des d�form�es modales: 417 : * 418 : IF (ITBAS.NE.0.and.(.not.lmodyn)) THEN 418 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0, 419 : & 'MOT',I1,X1,MONMOT,L1,IP1) 420 : IF (IERR.NE.0) RETURN 421 : IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN 422 : NSB = 1 423 : NA2 = NA1 424 : 425 : * changement de dimension en cas de corps rigide 425 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0, 426 : & 'TABLE',I1,X1,' ',L1,IBAS) 427 : IP = 0 428 : 22 CONTINUE 429 : ip = ip + 1 430 : TYPRET = ' ' 430 : CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0, 431 : & TYPRET,I1,X1,CHARRE,L1,ITP1) 432 : IF (IERR.NE.0) RETURN 433 : 434 : if (itp1.eq.0) goto 23 435 : IF ( itp1.ne.0) then 436 : typret = ' ' 436 : CALL ACCTAB(ITP1,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, 437 : & TYPRET,I1,X1,MONMOT,L1,IP1) 438 : IF (IERR.NE.0) RETURN 439 : IF (TYPRET.EQ.'MOT') THEN 440 : IF (MONMOT(1:4).EQ.'VRAI') THEN 441 : if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 442 : if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 443 : goto 23 444 : endif 445 : endif 446 : endif 447 : goto 22 448 : 23 continue 449 : 450 : ELSE 451 : IB = 0 452 : NA2 = 0 453 : IR = 0 454 : 30 CONTINUE 455 : IB = IB + 1 456 : TYPRET = ' ' 456 : CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0, 457 : & TYPRET,I1,X1,CHARRE,L1,ITBB) 458 : IF (IERR.NE.0) RETURN 459 : IF (ITBB.NE.0) THEN 460 : IF (TYPRET.EQ.'TABLE ') THEN 460 : CALL ACCTAB(ITBB,'MOT',I0,X0,'MODES',L0,IP0, 461 : & 'TABLE',I1,X1,' ',L1,IBAS) 462 : IF (IERR.NE.0) RETURN 463 : NNA2 = 0 464 : IP = 0 465 : 32 CONTINUE 466 : IP = IP + 1 467 : TYPRET = ' ' 467 : CALL ACCTAB(IBAS,'ENTIER',IP,X0,' ',L0,IP0, 468 : & TYPRET,I1,X1,CHARRE,L1,ITPP) 469 : IF (IERR.NE.0) RETURN 470 : IF (ITPP.NE.0) THEN 471 : IF (TYPRET.EQ.'TABLE ') THEN 472 : 473 : * changement de dimension en cas de corps rigide 474 : IF (IR.GT.1) GOTO 24 475 : typret = ' ' 475 : CALL ACCTAB(ITPP,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, 476 : & TYPRET,I1,X1,MONMOT,L1,IP1) 477 : IF (IERR.NE.0) RETURN 478 : IF (TYPRET.EQ.'MOT') THEN 479 : IF (MONMOT(1:4).EQ.'VRAI') THEN 480 : if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 481 : if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 482 : endif 483 : endif 484 : 24 CONTINUE 485 : 486 : NNA2 = NNA2 + 1 487 : GOTO 32 488 : ELSE 488 : CALL ERREUR(491) 489 : RETURN 490 : ENDIF 491 : ENDIF 492 : NA2 = MAX(NNA2,NA2) 493 : GOTO 30 494 : ELSE 494 : CALL ERREUR(491) 495 : RETURN 496 : ENDIF 497 : ENDIF 498 : NSB = IB - 1 499 : ENDIF 500 : NPLSB = NPLB 501 : * 502 : ELSE IF (LMODYN) THEN 503 : mchelm = itcara 504 : segact mchelm 505 : n1 = imache(/1) 506 : segini icma,icnna2 507 : mtbas = ITBAS 508 : MMODEL = ITBMOD 509 : segact MMODEL 510 : kstru = 0 511 : do im = 1,kmodel(/1) 512 : imodel = kmodel(im) 513 : segact imodel 514 : * recherche sommaire nombre de sous-structures independantes 515 : do 46 in = 1,n1 516 : meleme = imache(in) 517 : if (meleme.ne.imamod) goto 46 518 : if (conche(in).ne.conmod) goto 46 519 : segact meleme 520 : mchaml = ichaml(in) 521 : segact mchaml 522 : n2 = ielval(/1) 523 : 524 : do io = 1,n2 525 : if (nomche(io)(1:4).eq.'CGRA') then 526 : * recherche corps rigide 527 : if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3 528 : if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6 529 : else if (nomche(io)(1:4).eq.'DEFO') then 530 : melval = ielval(io) 531 : segact melval 532 : * assume que le maillage modèle se réduit au point support 533 : icdef1 = ielche(1,1) 533 : call ecrcha('NOMU') 533 : call ecrcha('MAIL') 533 : call ecrobj('CHPOINT ',icdef1) 533 : call extrai 533 : call lirobj('MAILLAGE', icmaio,1,iret) 534 : if (ierr.ne.0) return 535 : if (kstru.eq.0) then 536 : kstru = 1 537 : icma(**)=icmaio 538 : icnna2(**)=1 539 : lsstru(im) = kstru 540 : endif 541 : if (in.gt.1) then 542 : ipt5 = icmaio 543 : do ic = 1,kstru 544 : icmic = icma(ic) 544 : CALL INTERB(icmaio,icmic,IRETIB,icinte) 545 : if (iretib.eq.0) then 546 : ipt6 = icinte 547 : segact ipt6,ipt5 548 : if (ipt5.num(/2).eq.ipt6.num(/2)) then 549 : segsup ipt6 550 : icnna2(ic) = icnna2(ic) + 1 551 : lsstru(im) = ic 552 : goto 47 553 : endif 554 : segsup ipt6 555 : endif 556 : enddo 557 : kstru = kstru + 1 558 : icma(**) = icmaio 559 : icnna2(**) = 1 560 : lsstru(im) = kstru 561 : endif 562 : goto 47 563 : endif 564 : enddo 565 : 46 continue 566 : 47 continue 567 : segdes imodel 568 : enddo 569 : NSB = icma(/1) 570 : NA2 = icnna2(1) 571 : do ic = 1,icnna2(/1) 572 : na2 = MAX(icnna2(ic),NA2) 573 : enddo 574 : nsstru = kstru 575 : segsup icma,icnna2 576 : segdes mmodel 577 : * 578 : ENDIF 579 : * 580 : * on met NPLSB a 1 car le calcul actuel est debile 581 : * on ajuste la dimension dans dyne26 582 : * 583 : * MP 584 : * 585 : NPLSB=1 586 : SEGINI,MTPHI 587 : KTPHI = MTPHI 588 : * 589 : * Variables au cours d'un pas de temps: 590 : * 591 : SEGINI,MTPAS 592 : KTPAS = MTPAS 593 : * 594 : * Initialisation du segment repr�sentant les chargements ( bases A 595 : * et B ), il sera rempli dans le s-p DEVFX0: 596 : * 597 : NPFEXA = NA1 598 : NPFEXB = 0 599 : SEGINI,MTFEX 600 : KTFEX = MTFEX 601 : * 602 : * Gestion de la table definissant les resultats attendus: 603 : * ( par la suite, on s'occupera de TREDU ) 604 : * 604 : CALL DYNE15(ITSORT,KPREF,NA1,NP,NINS,ITLIA,KTRES,IPMAIL,REPRIS, 605 : & ICHAIN,NTVAR,NLIAA,NLIAB,NPLB,IDIMB,MTRA,ITCARA,lmodyn, 606 : & na1) 607 : IF (IERR.NE.0) RETURN 608 : MTRES = KTRES 609 : * 610 : * Creation des objets resultats : 611 : * 612 : SEGINI,MSAM 613 : KSAM=MSAM 614 : DO 100 IP=1,NPLB 615 : JPLIBB(IP)=JPLIB(IP) 616 : 100 CONTINUE 616 : CALL DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,KSAM, 617 : & lmodyn) 618 : IF (IERR.NE.0) RETURN 619 : MSAM=KSAM 620 : SEGSUP,MSAM 621 : * 622 : IF (IIMPI.EQ.333) THEN 623 : WRITE(IOIMP,*)'DEVALO : nombre de pas de temps ',NP 624 : WRITE(IOIMP,*)'DEVALO : temps de reprise ',XTINI 625 : * 626 : WRITE(IOIMP,*)' segment MTLIAB' 627 : WRITE(IOIMP,*)' NLIAB =',IPALB(/1) 628 : WRITE(IOIMP,*)' NIPALB =',IPALB(/2) 629 : WRITE(IOIMP,*)' NXPALB =',XPALB(/2) 630 : WRITE(IOIMP,*)' NPLBB =',IPLIB(/2) 631 : WRITE(IOIMP,*)' NPLB =',JPLIB(/1) 632 : WRITE(IOIMP,*)' NIP =',XABSCI(/2) 633 : * 634 : WRITE(IOIMP,*)' segment MTLIAA' 635 : WRITE(IOIMP,*)' NLIAA =',IPALA(/1) 636 : WRITE(IOIMP,*)' NIPALA =',IPALA(/2) 637 : WRITE(IOIMP,*)' NXPALA =',XPALA(/2) 638 : WRITE(IOIMP,*)' NPLAA =',IPLIA(/2) 639 : WRITE(IOIMP,*)' NPLA =',JPLIA(/1) 640 : * 641 : WRITE(IOIMP,*)' segment MTRES' 642 : WRITE(IOIMP,*)' NLSA =',XRESLA(/1) 643 : WRITE(IOIMP,*)' NVALA =',XRESLA(/3) 644 : WRITE(IOIMP,*)' NLSB =',XRESLB(/1) 645 : WRITE(IOIMP,*)' NVALB =',XRESLB(/3) 646 : WRITE(IOIMP,*)' NRES =',XRES(/1) 647 : WRITE(IOIMP,*)' NCRES =',XRES(/2) 648 : WRITE(IOIMP,*)' NPRES =',XRES(/3) 649 : WRITE(IOIMP,*)' NREP =',XREP(/1) 650 : WRITE(IOIMP,*)' NTVAR =',ILIREB(/2) 651 : WRITE(IOIMP,*)' NLIAB =',XMREP(/1) 652 : WRITE(IOIMP,*)' IDIMB =',XMREP(/3) 653 : WRITE(IOIMP,*)' NLIAA =',ILPOLA(/1) 654 : * 655 : WRITE(IOIMP,*)' segment MTFEX' 656 : WRITE(IOIMP,*)' NPC1 =',FEXA(/2) 657 : WRITE(IOIMP,*)' NPLB =',FEXPSM(/1) 658 : WRITE(IOIMP,*)' IDIMB =',FEXPSM(/4) 659 : WRITE(IOIMP,*)' NPFEXA =',IFEXA(/1) 660 : WRITE(IOIMP,*)' NPFEXB =',IFEXB(/1) 661 : * 662 : DO 1000 IP = 1,NPLB 663 : WRITE(IOIMP,*)'DEVALO : JPLIB(',IP,') =',JPLIB(IP) 664 : 1000 CONTINUE 665 : ENDIF 666 : * 667 : RETURN 668 : END 669 : 670 :
© Cast3M 2003 - All rights reserved.
Disclaimer