1 : C PRFUSE SOURCE GOUNAND 14/01/31 21:15:11 7928 2 : SUBROUTINE PRFUSE 3 : 4 : *============================================================= 5 : * 6 : * Interface entre la directive "ET" et le sous-programme "FUSE" 7 : * 8 : *============================================================= 9 : * 10 : * Modifications : 11 : * 12 : * PM 09/10/2007 : fusion de deux LISTCHPOs 13 : * PM 09/10/2007 : respect de l'ordre des opérandes 14 : * 15 : *============================================================= 16 : * 17 : * Remarques : 18 : * 19 : *============================================================= 20 : 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : 24 : -INC CCOPTIO 25 : -INC SMTABLE 26 : -INC CCNOYAU 27 : -INC CCASSIS 28 : -INC SMELEME 29 : -INC CCGEOME 30 : 31 : EXTERNAL LONG 32 : 33 : LOGICAL IR1,IR2,IR3,LTELQ 34 : CHARACTER*(8) CTYP,ICHAT,TYPRET,TYPRE1 35 : CHARACTER*(72) LEMOT,LEMOT1,LEMOT2 36 : REAL*4 XVAL 37 : CHARACTER*4 LISTMO(1) 38 : DATA LISTMO / 'TELQ' / 39 : 40 : * Recherche préalable du mot-clef 'TELQUEL' éventuel 40 : CALL LIRMOT(LISTMO,1,IRE2,0) 41 : IF (IERR.NE.0) RETURN 42 : LTELQ = (IRE2.EQ.1) 43 : 44 : * Lecture du premier objet 45 : * ------------------------ 45 : CALL MESLIR(-225) 45 : CALL QUETYP(CTYP,0,IRETOU) 46 : IF(IRETOU.EQ.0) THEN 47 : * Cet opérateur a encore besoin d'un opérande. 47 : CALL ERREUR (533) 48 : RETURN 49 : ENDIF 50 : 51 : IF(CTYP.EQ.'LOGIQUE ') THEN 51 : CALL MESLIR(-225) 51 : CALL LIRLOG(IR1,1,IRETOU) 51 : CALL MESLIR(-223) 51 : CALL LIRLOG(IR2,1,IRETOU) 52 : IF(IERR.NE.0) RETURN 53 : GOTO 213 54 : 55 : ELSE IF(CTYP.EQ.'MOT ') THEN 55 : CALL LIRCHA(LEMOT1,1,IRET1) 56 : IF (IERR.NE.0) RETURN 56 : CALL LIRCHA(LEMOT2,1,IRET2) 57 : IF( IERR.NE.0) RETURN 58 : IF (LTELQ) THEN 59 : * Concaténation avec respect des espaces avant et après 60 : ELSE 61 : * Suppressions des espaces en fin de mot 62 : IRET1=LONG(LEMOT1) 63 : IRET2=LONG(LEMOT2) 64 : ENDIF 65 : GOTO 225 66 : 67 : ELSE IF(CTYP.EQ.'FLOTTANT') THEN 67 : CALL LIRFLO(XVAL,1,IRETOU) 68 : IF(IERR.NE.0) RETURN 68 : CALL CREPRO(XVAL,IP1) 69 : CTYP='LISTREEL' 70 : II=16 71 : GOTO 24 72 : 73 : ELSE IF(CTYP.EQ.'ENTIER ') THEN 73 : CALL LIRENT(IP1,1,IRETOU) 74 : IF(IERR.NE.0) RETURN 75 : * suivant que l'objet suivant est un ENTIER/LISTENTI ou pas, 76 : * on considère cette entrée comme un FLOTTANT 76 : CALL QUETYP(CTYP,1,IRETOU) 77 : IF(IERR.NE.0) RETURN 78 : IF(CTYP.NE.'ENTIER '.AND.CTYP.NE.'LISTENTI') THEN 79 : XVAL=FLOAT(IP1) 79 : CALL CREPRO(XVAL,IP1) 80 : CTYP='LISTREEL' 81 : II=16 82 : ELSE 82 : CALL CRELEC(IP1) 83 : CTYP='LISTENTI' 84 : II=17 85 : ENDIF 86 : GOTO 24 87 : 88 : ELSE 89 : MOTERR(1:8)=CTYP 89 : CALL MESLIR(-222) 89 : CALL LIROBJ(CTYP,IP1,1,IRETOU) 90 : IF(CTYP.EQ.'POINT ') THEN 91 : II = 1 92 : GOTO 24 93 : ENDIF 94 : IF(CTYP.EQ.'MAILLAGE') THEN 95 : II = 2 96 : GOTO 24 97 : ENDIF 98 : IF(CTYP.EQ.'CHPOINT ') THEN 99 : II = 3 100 : GOTO 24 101 : ENDIF 102 : IF(CTYP.EQ.'MCHAML ') THEN 103 : II = 20 104 : GOTO 24 105 : ENDIF 106 : IF(CTYP.EQ.'RIGIDITE') THEN 107 : II = 4 108 : GOTO 24 109 : ENDIF 110 : IF(CTYP.EQ.'EVOLUTIO') THEN 111 : II = 18 112 : GOTO 24 113 : ENDIF 114 : IF(CTYP.EQ.'CHARGEME') THEN 115 : II = 15 116 : GOTO 24 117 : ENDIF 118 : IF(CTYP.EQ.'STRUCTUR') THEN 119 : II = 5 120 : GOTO 24 121 : ENDIF 122 : IF(CTYP.EQ.'SOLUTION') THEN 123 : II = 6 124 : GOTO 24 125 : ENDIF 126 : IF(CTYP.EQ.'ATTACHE ') THEN 127 : II = 7 128 : GOTO 24 129 : ENDIF 130 : IF(CTYP.EQ.'ELEMSTRU') THEN 131 : II = 10 132 : GOTO 24 133 : ENDIF 134 : IF(CTYP.EQ.'BLOQSTRU') THEN 135 : II = 11 136 : GOTO 24 137 : ENDIF 138 : IF(CTYP.EQ.'BASEMODA') THEN 139 : II = 12 140 : GOTO 24 141 : ENDIF 142 : IF(CTYP.EQ.'DEFORME ') THEN 143 : II = 13 144 : GOTO 24 145 : ENDIF 146 : IF(CTYP.EQ.'VECTEUR ') THEN 147 : II = 14 148 : GOTO 24 149 : ENDIF 150 : IF(CTYP.EQ.'LISTREEL') THEN 151 : II = 16 152 : GOTO 24 153 : ENDIF 154 : IF(CTYP.EQ.'LISTENTI') THEN 155 : II = 17 156 : GOTO 24 157 : ENDIF 158 : IF(CTYP.EQ.'MMODEL ') THEN 159 : II = 19 160 : GOTO 24 161 : ENDIF 162 : IF(CTYP.EQ.'LISTMOTS') THEN 163 : II = 21 164 : GOTO 24 165 : ENDIF 166 : IF(CTYP.EQ.'NUAGE ') THEN 167 : II = 22 168 : GOTO 24 169 : ENDIF 170 : IF(CTYP.EQ.'MATRIK') THEN 171 : II = 23 172 : GOTO 24 173 : ENDIF 174 : IF(CTYP.EQ.'LISTCHPO') THEN 175 : II = 24 176 : GOTO 24 177 : ENDIF 178 : 179 : IF(CTYP.EQ.'TABLE') THEN 180 : II = 24 181 : MTABLE = IP1 181 : CALL ACCTAB(MTABLE,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0, 182 : > 'MOT',ID3,RR1,LEMOT,IR1,ID2) 183 : IF (LEMOT.EQ.'LIAISONS_STATIQUES'.OR. 184 : > LEMOT.EQ.'BASE_MODALE') GOTO 2000 185 : GOTO 1000 186 : ENDIF 187 : 188 : GOTO 999 189 : 190 : ENDIF 191 : 192 : * ================ 193 : * Première syntaxe 194 : * ================ 195 : 196 : * Lecture deuxième objet, lui aussi avec pointeur 197 : * ----------------------------------------------- 198 : 24 CONTINUE 199 : 200 : ICODE=1 201 : * pour les fusions mixtes, on est encore indécis sur le type du 202 : * deuxième objet. 203 : IF(CTYP.EQ.'POINT '.OR.CTYP.EQ.'MAILLAGE') ICODE=0 204 : IF(CTYP.EQ.'LISTENTI'.OR.CTYP.EQ.'LISTREEL') ICODE=0 205 : IF(CTYP.EQ.'CHPOINT '.OR.CTYP.EQ.'LISTCHPO') ICODE=0 206 : * on lit a priori un objet de même type que le premier 207 : MOTERR(1:8)=CTYP 207 : CALL MESLIR(-221) 207 : CALL LIROBJ(CTYP,IP2,ICODE,IRETOU) 208 : IF(IERR.NE.0) RETURN 209 : 210 : GOTO ( 1,2,3,4,205,206,207,999,999,210,211,212,214,215,216, 211 : $ 217,218,219,220,221,222,223,224,226),II 212 : 213 : *-- Création maillage 214 : 1 CONTINUE 214 : CALL CRELEM(IP1) 215 : 2 CONTINUE 216 : IF (CTYP.NE.'POINT '.AND.CTYP.NE.'MAILLAGE') GOTO 999 217 : IF(IRETOU.EQ.1.AND.CTYP.EQ.'POINT ') THEN 218 : * on a deux points 218 : CALL CRELEM(IP2) 219 : ENDIF 220 : IF(IRETOU.EQ.0) THEN 221 : * on a lu des objets de types différents mais compatibles 221 : CALL MESLIR(-220) 221 : IF(CTYP.EQ.'POINT ') CALL LIROBJ('MAILLAGE',IP2,1,IRETAU) 222 : IF(CTYP.EQ.'MAILLAGE') THEN 222 : CALL LIROBJ('POINT ',IP2,1,IRETAU) 222 : IF(IRETAU.EQ.1) CALL CRELEM(IP2) 223 : ENDIF 224 : IF(IERR.NE.0) RETURN 225 : ENDIF 226 : CTYP='MAILLAGE' 226 : CALL FUSE(IP1,IP2,IRETOU,LTELQ) 227 : GOTO 100 228 : 229 : *-- Création CHPOINT 230 : 3 CONTINUE 231 : IF(IRETOU.EQ.1) THEN 232 : * La concaténation de deux champ-points donne un champ-point 232 : CALL FUCHPO(IP1,IP2,IRETOU) 233 : GOTO 100 234 : ELSE 235 : *PM autrement, on peut obtenir une liste de chpoints 235 : CALL CRLCHP(IP1) 236 : GOTO 226 237 : ENDIF 238 : 239 : *-- Création RIGIDITE 240 : 4 CONTINUE 240 : CALL FUSRIG(IP1,IP2,IRETOU) 241 : GOTO 100 242 : *-- Création STRUCTURE 243 : 205 CONTINUE 243 : CALL FUSTRU(IP1,IP2,IRETOU) 244 : GOTO 100 245 : *-- Création SOLUTION 246 : 206 CONTINUE 246 : CALL FUSOLU(IP1,IP2,IRETOU) 247 : GOTO 100 248 : *-- Création ATTACHE 249 : 207 CONTINUE 249 : CALL FUSATT(IP1,IP2,IRETOU) 250 : GOTO 100 251 : *-- Création ELEMSTRU 252 : 210 CONTINUE 252 : CALL FUSELS(IP1,IP2,IRETOU) 253 : GOTO 100 254 : *-- Création BLOQSTRU 255 : 211 CONTINUE 255 : CALL FUSCLS(IP1,IP2,IRETOU) 256 : GOTO 100 257 : *-- Création BASE MODALE 258 : 212 CONTINUE 258 : CALL FUSBAS(IP1,IP2,IRETOU) 259 : GOTO 100 260 : *-- Opération LOGIQUE 261 : 213 CONTINUE 262 : IR3=IR1.AND.IR2 262 : CALL ECRLOG(IR3) 263 : RETURN 264 : *-- Création DEFORMEE 265 : 214 CONTINUE 265 : CALL FUSDEF(IP1,IP2,IRETOU) 266 : GOTO 100 267 : *-- Création VECTEUR 268 : 215 CONTINUE 268 : CALL FUSVEC (IP1,IP2,IRETOU) 269 : GOTO 100 270 : *-- Création CHARGEMENT 271 : 216 CONTINUE 271 : CALL FUSCHA(IP1,IP2,IRETOU) 272 : GOTO 100 273 : *-- Création LISTREEL 274 : 217 CONTINUE 275 : IF(IRETOU.EQ.0) THEN 276 : * on n'a pas lu un LISTREEL 276 : CALL QUETYP(CTYP,1,IRETOU) 277 : IF(IERR.NE.0) RETURN 278 : IF((CTYP.NE.'ENTIER ').AND.(CTYP.NE.'FLOTTANT')) GOTO 999 279 : * on a lu des objets de types différents mais compatibles 280 : IF (CTYP.EQ.'ENTIER ') THEN 280 : CALL LIRENT(IVAL,1,IRETOU) 281 : XVAL=FLOAT(IVAL) 282 : ELSE 282 : CALL LIRFLO(XVAL,1,IRETOU) 283 : ENDIF 284 : IF(IERR.NE.0) RETURN 284 : CALL CREPRO(XVAL,IP2) 285 : ENDIF 286 : CTYP='LISTREEL' 286 : CALL FUSPRO(IP1,IP2,IRETOU) 287 : GOTO 100 288 : *-- Création LISTENTI 289 : 218 CONTINUE 290 : IF(IRETOU.EQ.0) THEN 291 : * on n'a pas lu un LISTENTI 291 : CALL QUETYP(CTYP,1,IRETOU) 292 : IF(IERR.NE.0) RETURN 293 : IF(CTYP.NE.'ENTIER ') GOTO 999 293 : CALL LIRENT(IP2,1,IRETOU) 294 : IF(IERR.NE.0) RETURN 294 : CALL CRELEC(IP2) 295 : ENDIF 296 : CTYP='LISTENTI' 296 : CALL FUSLEC(IP1,IP2,IRETOU) 297 : GOTO 100 298 : 299 : *-- Création EVOLUTION 300 : 219 CONTINUE 300 : CALL FUEVOL(IP1,IP2,IRETOU) 301 : GOTO 100 302 : *-- Création MODELE 303 : 220 CONTINUE 303 : CALL FUSMOD(IP1,IP2,IRETOU) 304 : GOTO 100 305 : *-- Création MCHAML 306 : 221 CONTINUE 306 : CALL FUSCHL(IP1,IP2,IRETOU) 307 : GOTO 100 308 : *-- Création LISTMOTS 309 : 222 CONTINUE 309 : CALL FUSMOT(IP1,IP2,IRETOU) 310 : GOTO 100 311 : *-- Création NUAGE 312 : 223 CONTINUE 312 : CALL FUSNUA(IP1,IP2,IRETOU) 313 : GOTO 100 314 : *-- Création MATRIK 315 : 224 CONTINUE 315 : CALL FUSMTK(IP1,IP2,IRETOU) 316 : GOTO 100 317 : *-- Création LISTCHPO 318 : 226 CONTINUE 319 : IF (CTYP.NE.'CHPOINT '.AND.CTYP.NE.'LISTCHPO') GOTO 999 320 : IF(IRETOU.EQ.0) THEN 321 : * on a lu des objets de types différents mais compatibles 322 : * (le cas de 2 champ-points est traité ailleurs) 322 : CALL MESLIR(-221) 323 : IF(CTYP.EQ.'CHPOINT ') THEN 323 : CALL LIROBJ('LISTCHPO',IP2,1,IRETAU) 324 : ELSE 324 : CALL LIROBJ('CHPOINT ',IP2,1,IRETAU) 324 : CALL CRLCHP(IP2) 325 : ENDIF 326 : IF(IERR.NE.0) RETURN 327 : ENDIF 328 : CTYP='LISTCHPO' 328 : CALL FUSSUI(IP1,IP2,IRETOU) 329 : GOTO 100 330 : 331 : * Sortie sans problème, écriture résultat 332 : 100 CONTINUE 333 : IF(IERR.NE.0) RETURN 333 : CALL ECROBJ(CTYP,IRETOU) 334 : RETURN 335 : 336 : * Fusion de chaines, limitation à 72 caractères, contrairement à 337 : * l'opérateur CHAINE 338 : 225 CONTINUE 339 : IRET=IRET1+IRET2 340 : IF(IRET.GT.72) THEN 341 : * Un titre ou un texte ne peut avoir plus de 72 caractères 341 : CALL ERREUR(425) 342 : RETURN 343 : ENDIF 344 : LEMOT(1:IRET1) = LEMOT1(1:IRET1) 345 : LEMOT(IRET1+1:IRET) = LEMOT2(1:IRET2) 345 : CALL ECRCHA(LEMOT(1:IRET)) 346 : RETURN 347 : 348 : * ================ 349 : * Deuxième syntaxe 350 : * ================ 351 : * Fusion de tous les indices d'une table 352 : 353 : 1000 CONTINUE 354 : MTABLE=IP1 355 : IF (IRETOU.EQ.1) THEN 356 : * ET DE TABLES ESCLAVE 357 : * WRITE(IOIMP,*) ' TABLE ESCLAVE DANS ET' 358 : * IF (LODESL) THEN 359 : * WRITE(IOIMP,*) ' LODESL REMIS À FAUX DANS PRFUSE ' 360 : * LODESL=.FALSE. 360 : * CALL ABORT 361 : * ENDIF 361 : CALL ACCTAB(MTABLE,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0, 362 : > 'MOT',ID3,RR1,CTYP,IR1,ID2) 363 : IF (CTYP.NE.'ESCLAVE') THEN 364 : * Donnez une TABLE de sous-type %m1:8 365 : MOTERR(1:8)='ESCLAVE' 365 : CALL ERREUR(-173) 366 : * Le sous-type de la table est incorrect 366 : CALL ERREUR(648) 367 : RETURN 368 : ENDIF 369 : SEGACT MTABLE 370 : ML=MLOTAB 371 : * L'INDICE 1 EST LE SOUS TYPE 372 : IND=MTABII(2) 373 : CTYP=' ' 373 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 374 : > CTYP,ID3,RR1,TYPRET,IR1,ID1) 375 : IRETOU=ID1 376 : IF (CTYP.EQ.'POINT') THEN 377 : NBNN=1 378 : NBSOUS=0 379 : NBREF=0 380 : NBELEM=ML-1 381 : SEGINI MELEME 382 : ITYPEL=1 383 : NUM(1,1)=ID1 384 : ICOLOR(1)=IDCOUL 385 : DO I=3,ML 386 : SEGACT MTABLE 387 : IND=MTABII(I) 387 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 388 : > CTYP,ID3,RR1,' ',IR1,ID2) 389 : IF (IERR.NE.0) RETURN 390 : NUM(1,I-1)=ID2 391 : ICOLOR(I-1)=IDCOUL 392 : ENDDO 393 : SEGDES MELEME 394 : IRETOU=MELEME 395 : CTYP='MAILLAGE' 396 : ELSEIF (CTYP.EQ.'MAILLAGE') THEN 397 : DO I=3,ML 398 : SEGACT MTABLE 399 : IND=MTABII(I) 399 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 400 : > CTYP,ID3,RR1,' ',IR1,ID2) 401 : IF (IERR.NE.0) RETURN 401 : CALL FUSE(ID1,ID2,IRETOU,LTELQ) 402 : ID1=IRETOU 403 : ENDDO 404 : ELSEIF (CTYP.EQ.'MCHAML') THEN 405 : DO I=3,ML 406 : SEGACT MTABLE 407 : IND=MTABII(I) 407 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 408 : > CTYP,ID3,RR1,' ',IR1,ID2) 409 : IF (IERR.NE.0) RETURN 409 : CALL FUSCHL(ID1,ID2,IRETOU) 410 : ID1=IRETOU 411 : ENDDO 412 : ELSEIF (CTYP.EQ.'CHPOINT ') THEN 413 : DO I=3,ML 414 : SEGACT MTABLE 415 : IND=MTABII(I) 415 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 416 : > CTYP,ID3,RR1,' ',IR1,ID2) 417 : IF (IERR.NE.0) RETURN 417 : CALL FUCHPO(ID1,ID2,IRETOU) 418 : IF (IERR.NE.0) RETURN 419 : ID1=IRETOU 420 : ENDDO 421 : ELSEIF (CTYP.EQ.'RIGIDITE') THEN 422 : DO I=3,ML 423 : SEGACT MTABLE 424 : IND=MTABII(I) 424 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 425 : > CTYP,ID3,RR1,' ',IR1,ID2) 426 : IF (IERR.NE.0) RETURN 426 : CALL FUSRIG(ID1,ID2,IRETOU) 427 : IF (IERR.NE.0) RETURN 428 : ID1=IRETOU 429 : ENDDO 430 : ELSEIF (CTYP.EQ.'MATRIK ') THEN 431 : DO I=3,ML 432 : SEGACT MTABLE 433 : IND=MTABII(I) 433 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 434 : > CTYP,ID3,RR1,' ',IR1,ID2) 435 : IF (IERR.NE.0) RETURN 435 : CALL FUSMTK(ID1,ID2,IRETOU) 436 : IF (IERR.NE.0) RETURN 437 : ID1=IRETOU 438 : ENDDO 439 : ELSEIF (CTYP.EQ.'MMODEL') THEN 440 : DO I=3,ML 441 : SEGACT MTABLE 442 : IND=MTABII(I) 442 : CALL ACCTAB(MTABLE,'ENTIER',IND,0.D0,' ',.TRUE.,0, 443 : > CTYP,ID3,RR1,' ',IR1,ID2) 444 : IF (IERR.NE.0) RETURN 444 : CALL FUSMOD(ID1,ID2,IRETOU) 445 : IF (IERR.NE.0) RETURN 446 : ID1=IRETOU 447 : ENDDO 448 : ELSE 449 : * On ne veut pas d'objet de type %m1:8 450 : MOTERR(1:8)=CTYP 450 : CALL ERREUR(39) 451 : RETURN 452 : ENDIF 453 : SEGDES MTABLE 454 : GOTO 100 455 : ENDIF 456 : 457 : 2000 CONTINUE 458 : * FUSION TABLE DE MODES 458 : CALL CRTABL(IPTAB2) 459 : IPOUT = IPTAB2 460 : IL = 0 461 : IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN 461 : CALL ECCTAB(IPTAB2,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,IP0, 462 : & 'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,IP1) 463 : ELSE 463 : CALL ECCTAB(IPTAB2,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,IP0, 464 : & 'MOT',0,0.0D0,'BASE_MODALE',.TRUE.,IP1) 464 : CALL CRTABL(IPTAB3) 464 : CALL ECCTAB(IPTAB2,'MOT',0,0.0D0,'MODES',.TRUE.,IP0, 465 : & 'TABLE',0,0.0D0,' ',.TRUE.,IPTAB3) 466 : IPTAB2 = IPTAB3 466 : CALL ECCTAB(IPTAB2,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,IP0, 467 : & 'MOT',0,0.0D0,'BASE_DE_MODES',.TRUE.,IP1) 467 : CALL ECCTAB(IPTAB2,'MOT',0,0.0D0,'MAILLAGE',.TRUE.,IP0, 468 : & 'MOT',0,0.0D0,'MAILLAGE',.TRUE.,IP1) 468 : CALL ACCTAB(MTABLE,'MOT',0,0.D0,'MODES',.TRUE.,0, 469 : > 'TABLE',ID3,RR1,' ',.TRUE.,IP1) 470 : MTABLE = IP1 471 : ENDIF 472 : IKO = 0 473 : 2100 IKO = IKO + 1 474 : SEGACT MTABLE 475 : IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN 476 : IMA = MLOTAB - 1 477 : ELSE 478 : IMA = MLOTAB - 2 479 : ENDIF 480 : IM = 0 481 : 2160 IM = IM + 1 481 : CALL ACCTAB(MTABLE,'ENTIER',IM,0.D0,' ',.TRUE.,0, 482 : > 'TABLE',ID3,RR1,' ',.TRUE.,ITMOD) 483 : IF (ITMOD.GT.0) THEN 484 : IL = IL + 1 484 : CALL ECCTAB(IPTAB2,'ENTIER',IL,0.0D0,' ',.TRUE.,IP0, 485 : & 'TABLE',0,0.0D0,' ',.TRUE.,ITMOD) 486 : ENDIF 487 : IF (IM.LT.IMA) GOTO 2160 488 : 489 : SEGDES MTABLE 490 : IF (IKO.EQ.1) THEN 491 : IF (LEMOT.EQ.'LIAISONS_STATIQUES') THEN 491 : CALL LIRTAB('LIAISONS_STATIQUES',IP1,0,IRETOU) 492 : IF (IRETOU.EQ.0) GOTO 2300 493 : MTABLE = IP1 494 : ELSE 494 : CALL LIRTAB('BASE_MODALE',IP1,0,IRETOU) 495 : IF (IRETOU.EQ.0) GOTO 2300 495 : CALL ACCTAB(IP1,'MOT',0,0.D0,'MODES',.TRUE.,0, 496 : > 'TABLE',ID3,RR1,' ',.TRUE.,MTABLE) 497 : ENDIF 498 : GOTO 2100 499 : ENDIF 500 : 500 : 2300 CALL ECROBJ ('TABLE ',ipout) 501 : RETURN 502 : 503 : 999 CONTINUE 504 : * On ne veut pas d'objet de type %m1:8 505 : MOTERR(1:8)=CTYP 505 : CALL ERREUR(39) 506 : RETURN 507 : 508 : END 509 : 510 : 511 : 512 : 513 : 514 : 515 : 516 :
© Cast3M 2003 - All rights reserved.
Disclaimer