1 : C TIRE SOURCE SERRE 12/03/29 21:15:05 7333 2 : SUBROUTINE TIRE 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C OPERATEUR TIRE 7 : C 8 : C OBJOL = TIRE MSOLUT TYPE ( ROBO ) ( INSTANTS ) ; 9 : C ---- ---- 10 : C ou 11 : C OBJOL = TIRE MCHARG FLOTTANT | ( 'TABL' ) ; 12 : C | ( MOT ) 13 : C 14 : C OBJOL : objet de type ......... 15 : C MSOLUT : objet SOLUTION 16 : C TYPE : MOT CLE:TYPE DE LA VARIABLE(DEPL,VITE,ACCE,LIAI, 17 : C POIN ..) 18 : C MCHARG : objet CHARGEMENT 19 : C MOT : nom du CHARGEMENT a instancier 20 : C FLOTTANT : temps pour lequel on desire le chargement. 21 : C 22 : C dans le cas d'un objet SOLUTION de type DYNAMIQUE issu d'une 23 : C resolution par PLEX : 24 : C 1- on peut obtenir les matrices ROTATION et leurs derivees 25 : C en posant TYPE = ROTA ( pour les TRANSLATIONS TYPE = ROTA ) 26 : C 2- si on desire effectuer une RECOmbinaison des VITESSES et 27 : C des ACCELERATIONS specifier le mot-clef ROBO apres TYPE 28 : C 29 : C INSTANTS: procedure facultative pour choisir les cas de sortie 30 : C MOT suivi d'une VALEUR 31 : C TEMP T : FLOTTANT temps a sortir 32 : C CAS ICAS : ENTIER cas a sortir 33 : C RANG IRG : ENTIER rang de l'objet a sortir 34 : C NUME INUME : ENTIER numero du mode a sortir 35 : C RIEN : on prend le dernier 36 : C 37 : C Dans le cas de l'objet chargement le mot clef TABL permet 38 : C de ranger les differents chargements instancies dans une 39 : C table pointant vers un CHPOINT (ou MCHAML) et d'indice 40 : C le nom du chargement. Si on donne un objet de type MOT 41 : C a l'operateur il calcule le champ instancie correspondant 42 : C uniquement aux chargements portant ce nom.Si aucun mot 43 : C n'est donne il instancie le chargement et renvoie un 44 : C objet de type CHPOINT ou MCHAML. 45 : C Pour des chargements mobiles l'operateur calcule le 46 : C champ effectif au temps voulu 47 : C-------------------------------------------------------------------- 48 : C CREATION : 16/10/85 49 : C PROGRAMMEUR : FARVACQUE 50 : C PUIS CHARVET POUR INTRODUCTION DE L'OPTION ROBO ( NON 51 : C ENCORE TESTE SUR CRAY ) 52 : C APPELLE: LIRE LIRMOT CHRCHA ECRIRE TITMOD TYPFIL ERREUR(235 234 135) 53 : C LIRCHA LIRENT LIREE LIROBJ INTER1 MOCHPO DTCHPO ADCHPO PLACE 54 : C EXTENSION CHARGEMENT MOBILES 02/98 KICH 55 : C 56 : C======================================================================= 57 : -INC CCOPTIO 58 : -INC SMCOORD 59 : -INC SMSOLUT 60 : -INC SMELEME 61 : -INC SMCHPOI 62 : -INC SMLCHPO 63 : -INC SMCHARG 64 : -INC SMLREEL 65 : -INC SMTABLE 66 : -INC SMEVOLL 67 : 68 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 69 : DIMENSION X(3),Y(4) 70 : COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC, 71 : # ZVEC,ANGLE,ICLE 72 : 73 : PARAMETER (LMOOPT=4) 74 : CHARACTER*4 MOOPT(LMOOPT) 75 : CHARACTER*8 MTYPI,CHATY2 76 : CHARACTER*4 MOGDEP(2), MTYPR 77 : CHARACTER*4 MOROBO(1) 78 : CHARACTER*4 MOFREQ(6) 79 : CHARACTER *72 ITEX 80 : CHARACTER*8 TAPIND,TAPOBJ,TAPOB1,TAPOB2 81 : CHARACTER*4 CHARIN,CHARRE 82 : LOGICAL LOGIN,LOGRE 83 : REAL*8 XVALIN,XVALRE 84 : CHARACTER CTYP*8,MCHA*4,MOT1*4 85 : INTEGER LCHAR,MIN1,MAX1 86 : DATA MOFREQ/'FREQ','MGEN','QX ','QY ','QZ ','POIN'/ 87 : DATA MOOPT/'TEMP','CAS ','RANG','NUME'/ 88 : DATA MOGDEP/'ROTA','TRAN'/ 89 : DATA MOROBO(1)/'ROBO'/ 90 : DATA PRECI/1.E-3/ 91 : ITEX = ' ' 92 : IUN = 1 93 : ICHA2 = 0 94 : ICHA3 = 0 95 : IGDEP = 0 96 : 97 : *---------------------------------------------------------------------- 98 : * CAS OU ON CHERCHE A TIRER UN CHARGEMENT 99 : *---------------------------------------------------------------------- 100 : 101 : *----- la nature du chpo de sortie est conditionnée par celle qui ----- 102 : *-------- sort de l'objet chargement si il y des incoherence ---------- 103 : *--------- adchpo et muchpo rendront une nature indeterminée ---------- 104 : 105 : LFREQ=5 106 : LFREQ=6 107 : LGDEP = 2 108 : IRETT = 0 108 : CALL LIROBJ('CHARGEME',ICHAR,0,IRETOU) 109 : IF(IERR.NE.0) RETURN 110 : IF(IRETOU.EQ.0) GO TO 200 110 : CALL LIRCHA(MOT1,0,LCHAR) 111 : IF (LCHAR.EQ.0) THEN 112 : MOT1 = ' ' 113 : ENDIF 114 : 115 : *---------------------------------------------------------------------- 116 : *------- Cas ou on range le chargement instancie dans une TABLE ------ 117 : *---------------------------------------------------------------------- 118 : 119 : IF (MOT1.EQ.'TABL') THEN 119 : CALL LIRREE(XXX,1,IRETOU) 120 : IF(IERR.NE.0) RETURN 121 : T1=XXX 122 : MCHARG=ICHAR 123 : SEGACT MCHARG 124 : NCHAR=KCHARG(/1) 125 : M = 0 126 : SEGINI MTABLE 127 : ITA1 = MTABLE 128 : SEGDES MTABLE 129 : 130 : *-------------- boucle sur les chargements élémentaires --------------- 131 : 132 : DO 501 IC=1,NCHAR 133 : ICHARG=KCHARG(IC) 134 : SEGACT ICHARG 135 : IPO1 = ICHPO1 136 : IPO2 = ICHPO2 137 : 138 : *--------- on ne considère que les objets de sous type force ----------- 139 : 140 : IF(CHANAT(IC).EQ.'DEPLACEM') THEN 141 : MOTERR(1:8)='CHARGEME' 142 : MOTERR(9:16)='DEPLACEM' 142 : CALL ERREUR(131) 143 : GO TO 599 144 : ENDIF 145 : 146 : *------------ On ne considere que les chargements nommes --------------- 147 : 148 : IF (CHANOM(IC).EQ.' ') THEN 148 : CALL ERREUR(697) 149 : GOTO 599 150 : ENDIF 151 : 152 : *--- cas des chargements elementaires CHPOINT (ou MCHAML) + EVOL ------- 153 : 154 : IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML ')) THEN 155 : MLREEL=ICHPO2 156 : SEGACT MLREEL 157 : NF=PROG(/1) 158 : 159 : *------- Le temps %r1 sort de la table du %i1ème chargement ----------- 160 : 161 : T2 = T1 + ABS(T1*0.000001D0) 162 : T3 = T1 - ABS(T1*0.000001D0) 163 : IF(PROG(1).GT.T2.OR.PROG(NF).LT.T3) THEN 164 : INTERR(1)=IC 165 : REAERR(1)=T1 165 : CALL ERREUR(342) 166 : SEGDES MLREEL 167 : GO TO 599 168 : ENDIF 169 : SEGDES MLREEL 170 : 171 : C------------- calcul du deplacement eventuel du champ ---------- 172 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 173 : & CHAMOB(IC).EQ.'TRAJ') THEN 174 : MTYPR = CHAMOB(IC) 175 : IPOENT = IPO1 176 : CHATY2 = CHATYP 177 : IPOENU = ICHPO4 178 : IPOENV = ICHPO5 179 : IPOENW = ICHPO6 180 : IPOENX = ICHPO7 180 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 181 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 182 : IF (IERR.NE.0) RETURN 183 : IPO1 = IPOSOR 184 : ENDIF 185 : 186 : C----- realise la multiplication du CHPOINT ou du MCHAML ----------- 187 : ICHATX=ICHPO2 188 : ICHAFX=ICHPO3 188 : CALL INTER1(ICHATX,ICHAFX,T1,FT1) 189 : IF(CHATYP.EQ.'CHPOINT ') THEN 190 : TAPOBJ = 'CHPOINT ' 190 : CALL MUCHPO(IPO1,FT1,IRET,1) 191 : ELSE 192 : TAPOBJ = 'MCHAML ' 192 : CALL MUCHEL(IPO1,FT1,IRET,1) 193 : ENDIF 194 : IF(IRET.EQ.0) GO TO 598 195 : CHARIN = CHANOM(IC) 196 : IOBRE = IRET 197 : TAPIND = 'MOT ' 197 : CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN, 198 : $ LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 199 : 200 : *----------- cas des chargements elementaires TABLE1 - TABLE2 ---------- 201 : 202 : ELSE 203 : IVALI1 = 0 204 : IVALI2 = 1 205 : mtab1=ipo1 206 : segact mtab1 206 : * CALL ECROBJ('TABLE ',ICHPO1) 206 : * CALL DIMENS 206 : * CALL LIRENT(JMA1,1,IRETOU) 207 : jma1=mtab1.mlotab 208 : * IF (IRETOU.EQ.0) GOTO 599 209 : DO 505 JJ = 1,JMA1 210 : * TAPOB1 = ' ' 211 : * TAPOB2 = ' ' 212 : * TAPIND = 'ENTIER ' 212 : * CALL ACCTAB(IPO1,TAPIND,IVALI1,XVALIN,CHARIN, 213 : * $ LOGIN,IOBIN,TAPOB1,IVALRE,XVALR1,CHARRE,LOGRE,IOBRE) 214 : * IF(TAPOB1.eq.' ') go to 5059 215 : xvalr1=mtab1.rmtabv(ivali1+1) 216 : tapob1=mtab1.mtabtv(ivali1+1) 217 : IF (JMA1.EQ.1) THEN 218 : XVALR2 = T1 219 : ELSE 220 : xvalr2=mtab1.rmtabv(ivali2+1) 221 : tapob2=mtab1.mtabtv(ivali2+1) 221 : * CALL ACCTAB(IPO1,TAPIND,IVALI2,XVALIN,CHARIN, 222 : * $ LOGIN,IOBIN,TAPOB2,IVALRE,XVALR2,CHARRE,LOGRE,IOBRE) 223 : ENDIF 224 : IF (IVALI1.EQ.0) THEN 225 : IF (T1.LE.XVALR1) THEN 226 : DREL = 0.D0 227 : GOTO 507 228 : ENDIF 229 : ENDIF 230 : IF (IVALI2.EQ.JMA1) THEN 231 : IF (T1.GE.XVALR2) THEN 232 : DREL = 1.D0 233 : GOTO 507 234 : ENDIF 235 : ENDIF 236 : IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 506 237 : 5059 continue 238 : IVALI1 = IVALI1 + 1 239 : IVALI2 = IVALI2 + 1 240 : 505 CONTINUE 241 : segdes mtab1 242 : 243 : *------- Le temps %r1 sort de la table du %i1ème chargement ---------- 244 : 245 : INTERR(1)=IC 246 : REAERR(1)=T1 246 : CALL ERREUR(342) 247 : GO TO 599 248 : 249 : 506 CONTINUE 250 : 251 : *------------ la premiere table ne pointe pas vers des reels ---------- 252 : 253 : IF((TAPOB1.NE.TAPOB2).OR.(TAPOB1.NE.'FLOTTANT')) THEN 253 : CALL ERREUR(692) 254 : GOTO 599 255 : ENDIF 256 : DREL = (T1 - XVALR1)/(XVALR2 - XVALR1) 257 : 507 CONTINUE 258 : TAPOB1 = ' ' 259 : TAPOB2 = ' ' 260 : TAPIND = 'ENTIER ' 261 : mtab2=ipo2 262 : segact mtab2 263 : tapob1=mtab2.mtabtv(ivali1+1) 264 : tapob2=mtab2.mtabtv(ivali2+1) 265 : iobr1=mtab2.mtabiv(ivali1+1) 266 : iobr2=mtab2.mtabiv(ivali2+1) 266 : * CALL ACCTAB(IPO2,TAPIND,IVALI1,XVALIN,CHARIN, 267 : * $ LOGIN,IOBIN,TAPOB1,IVALRE,XVALRE,CHARRE,LOGRE,IOBR1) 267 : * CALL ACCTAB(IPO2,TAPIND,IVALI2,XVALIN,CHARIN, 268 : * $ LOGIN,IOBIN,TAPOB2,IVALRE,XVALRE,CHARRE,LOGRE,IOBR2) 269 : segdes mtab2 270 : *------ la deuxieme table ne pointe pas vers des champs de meme type ----- 271 : 272 : IF(TAPOB1.NE.TAPOB2) THEN 273 : c write(6,*) ' passage 1' 274 : c write(6,*) ' ivali1 ' , ivali1 , ' ivali2 ' , ivali2 275 : c write(6,*) ' tapob1 ' ,tapob1,' tapob2 ',tapob2 275 : CALL ERREUR(693) 276 : GOTO 599 277 : ENDIF 278 : 279 : IF(TAPOB1.EQ.'CHPOINT ') THEN 279 : CALL ECROBJ('CHPOINT ',IOBR1) 279 : CALL ECROBJ('CHPOINT ',IOBR2) 279 : CALL ECRREE(1.D0 - DREL) 279 : CALL ECRREE(DREL) 279 : CALL COLI 279 : CALL LIROBJ('CHPOINT ',IRET,1,IRETOU) 280 : IF(IRETOU.EQ.0) GOTO 599 281 : 282 : C------------- calcul du deplacement eventuel du champ ---------- 283 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 284 : & CHAMOB(IC).EQ.'TRAJ') THEN 285 : MTYPR = CHAMOB(IC) 286 : IPOENT = IRET 287 : CHATY2 = CHATYP 288 : IPOENU = ICHPO4 289 : IPOENV = ICHPO5 290 : IPOENW = ICHPO6 291 : IPOENX = ICHPO7 291 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 292 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 293 : IF (IERR.NE.0) RETURN 294 : IRET = IPOSOR 295 : ENDIF 296 : 297 : CHARIN = CHANOM(IC) 298 : TAPOBJ = 'CHPOINT ' 299 : IOBRE = IRET 300 : TAPIND = 'MOT ' 300 : CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN, 301 : $ LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 302 : 303 : ELSE IF (TAPOB1.EQ.'MCHAML ') THEN 303 : CALL ECROBJ('MCHAML ',IOBR1) 303 : CALL ECROBJ('MCHAML',IOBR2) 303 : CALL ECRREE(1.D0 - DREL) 303 : CALL ECRREE(DREL) 303 : CALL COLI 303 : CALL LIROBJ('MCHAML ',IRET,1,IRETOU) 304 : IF(IRETOU.EQ.0) GOTO 599 305 : 306 : C------------- calcul du deplacement eventuel du champ ---------- 307 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 308 : & CHAMOB(IC).EQ.'TRAJ') THEN 309 : MTYPR = CHAMOB(IC) 310 : IPOENT = IRET 311 : CHATY2 = CHATYP 312 : IPOENU = ICHPO4 313 : IPOENV = ICHPO5 314 : IPOENW = ICHPO6 315 : IPOENX = ICHPO7 315 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 316 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 317 : IF (IERR.NE.0) RETURN 318 : IRET = IPOSOR 319 : ENDIF 320 : 321 : CHARIN = CHANOM(IC) 322 : TAPOBJ = 'MCHAML ' 323 : IOBRE = IRET 324 : TAPIND = 'MOT ' 324 : CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN, 325 : $ LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 326 : 327 : *-------- la deuxieme table ne pointe pas vers un CHPOINT ou MCHAML ---- 328 : ELSE 328 : CALL ERREUR(694) 329 : GOTO 599 330 : ENDIF 331 : C 332 : C ------- pas d'autre maniere de formatter les chargements ----- 333 : ENDIF 334 : SEGDES ICHARG 335 : 501 CONTINUE 336 : SEGDES MCHARG 336 : CALL ECROBJ('TABLE ',ITA1) 337 : RETURN 338 : 598 IF(IC.NE.0) THEN 339 : DO 555 J = 1, IC 340 : IRETT = MTABIV(J) 340 : CALL DTCHPO(IRETT) 341 : 555 CONTINUE 342 : ENDIF 343 : 599 SEGDES ICHARG 344 : SEGDES MCHARG 345 : SEGSUP MTABLE 346 : RETURN 347 : ELSE 348 : 349 : *----------------------------------------------------------------------- 350 : *- cas ou on veut instancier un seul chargement elementaire de nom MOT - 351 : *----------------------------------------------------------------------- 352 : 353 : *------------------------------------------------------------------------- 354 : * cas ou on veut instancier tout le chargement et le ranger dans un seul champ 355 : *------------------------------------------------------------------------- 356 : 356 : CALL LIRREE(XXX,1,IRETOU) 357 : IF(IERR.NE.0) RETURN 358 : T1=XXX 359 : MCHARG=ICHAR 360 : SEGACT MCHARG 361 : NCHAR=KCHARG(/1) 362 : ISU = 0 363 : 364 : *-------------- boucle sur les chargements élémentaires --------------- 365 : 366 : DO 502 IC=1,NCHAR 367 : IF(MOT1.NE.' ') THEN 368 : IF(CHANOM(IC).NE.MOT1) GOTO 502 369 : ENDIF 370 : ICHARG=KCHARG(IC) 371 : SEGACT ICHARG 372 : IPO1 = ICHPO1 373 : IPO2 = ICHPO2 374 : 375 : *--------- on ne considère que les objets de sous type force ----------- 376 : 377 : IF(CHANAT(IC).EQ.'DEPLACEM') THEN 378 : MOTERR(1:8)='CHARGEME' 379 : MOTERR(9:16)='DEPLACEM' 379 : CALL ERREUR(131) 380 : GO TO 690 381 : ENDIF 382 : 383 : *--- cas des chargements elementaires CHPOINT (ou MCHAML) + EVOL ------- 384 : 385 : IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML ')) THEN 386 : MLREEL=ICHPO2 387 : SEGACT MLREEL 388 : NF=PROG(/1) 389 : 390 : *------- Le temps %r1 sort de la table du %i1ème chargement ------------- 391 : 392 : T2 = T1 + ABS(T1*0.000001D0) 393 : T3 = T1 - ABS(T1*0.000001D0) 394 : IF(PROG(1).GT.T2.OR.PROG(NF).LT.T3) THEN 395 : INTERR(1)=IC 396 : REAERR(1)=T1 396 : CALL ERREUR(342) 397 : SEGDES MLREEL 398 : GO TO 690 399 : ENDIF 400 : SEGDES MLREEL 401 : 402 : C------------- calcul du deplacement eventuel du champ ---------- 403 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 404 : & CHAMOB(IC).EQ.'TRAJ') THEN 405 : MTYPR = CHAMOB(IC) 406 : IPOENT = IPO1 407 : CHATY2 = CHATYP 408 : IPOENU = ICHPO4 409 : IPOENV = ICHPO5 410 : IPOENW = ICHPO6 411 : IPOENX = ICHPO7 411 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 412 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 413 : IF(IERR.NE.0) RETURN 414 : IPO1 = IPOSOR 415 : ENDIF 416 : 417 : ICHATX=ICHPO2 418 : ICHAFX=ICHPO3 418 : CALL INTER1(ICHATX,ICHAFX,T1,FT1) 419 : IF(CHATYP.EQ.'CHPOINT ') THEN 419 : CALL MUCHPO(IPO1,FT1,IRET,1) 420 : ELSE 420 : CALL MUCHEL(IPO1,FT1,IRET,1) 421 : ENDIF 422 : IF(IRET.EQ.0) GO TO 690 423 : IF (ISU.EQ.0) THEN 424 : IRETT = IRET 425 : ISU = 1 426 : CHATY2 = CHATYP 427 : ELSE 428 : 429 : *------------- Chargements elementaires incompatibles --------------- 430 : 431 : IF(CHATYP.NE.CHATY2) THEN 431 : CALL ERREUR(695) 432 : GOTO 690 433 : ELSE 434 : IF(CHATYP.EQ.'CHPOINT ') THEN 434 : CALL FUCHPO(IRETT,IRET,IRETOU) 434 : CALL DTCHPO(IRET) 435 : IF(IRETOU.EQ.0) THEN 436 : IF(IRETT.NE.0) THEN 436 : CALL DTCHPO(IRETT) 437 : ENDIF 438 : GOTO 690 439 : ENDIF 439 : CALL DTCHPO(IRETT) 440 : IRETT=IRETOU 441 : ELSE IF (CHATYP.EQ.'MCHAML ') THEN 441 : CALL ADCHEL(IRETT,IRET,IRETOU,1) 441 : CALL DTCHEL(IRET) 442 : IF(IRETOU.EQ.0) THEN 443 : IF(IRETT.NE.0) THEN 443 : CALL DTCHEL(IRETT) 444 : ENDIF 445 : GOTO 690 446 : ENDIF 446 : CALL DTCHEL(IRETT) 447 : IRETT=IRETOU 448 : ENDIF 449 : CHATY2 = CHATYP 450 : ENDIF 451 : ENDIF 452 : 453 : *---------- cas du chargement elementaire TABLE1-TABLE2 ------------- 454 : 455 : ELSE 456 : 457 : IVALI1 = 0 458 : IVALI2 = 1 459 : mtab1=ipo1 460 : segact mtab1 461 : jma1=mtab1.mlotab 462 : * 462 : * CALL ECROBJ('TABLE ',IPO1) 462 : * CALL DIMENS 462 : * CALL LIRENT(JMA1,1,IRETOU) 463 : DO 605 JJ = 1,JMA1 464 : TAPOB1 =mtab1. mtabtv(ivali1+1) 465 : TAPOB2 =mtab1. mtabtv(ivali2+1) 466 : xvalr1=mtab1.rmtabv(ivali1+1) 467 : * TAPIND = 'ENTIER ' 467 : * CALL ACCTAB(IPO1,TAPIND,IVALI1,XVALIN,CHARIN, 468 : * $ LOGIN,IOBIN,TAPOB1,IVALRE,XVALR1,CHARRE,LOGRE,IOBRE) 469 : * if(TAPOB1.EQ.' ') go to 6059 470 : IF (JMA1.EQ.1) THEN 471 : XVALR2 = T1 472 : ELSE 473 : xvalr2=mtab1.rmtabv(ivali2+1) 473 : * CALL ACCTAB(IPO1,TAPIND,IVALI2,XVALIN,CHARIN, 474 : * $ LOGIN,IOBIN,TAPOB2,IVALRE,XVALR2,CHARRE,LOGRE,IOBRE) 475 : ENDIF 476 : IF (IVALI1.EQ.0) THEN 477 : IF (T1.LE.XVALR1) THEN 478 : DREL = 0.D0 479 : GOTO 607 480 : ENDIF 481 : ENDIF 482 : IF (IVALI2.EQ.JMA1) THEN 483 : IF (T1.GE.XVALR2) THEN 484 : DREL = 1.D0 485 : GOTO 607 486 : ENDIF 487 : ENDIF 488 : IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 606 489 : 6059 continue 490 : IVALI1 = IVALI1 + 1 491 : IVALI2 = IVALI2 + 1 492 : 605 CONTINUE 493 : 494 : *------- Le temps %r1 sort de la table du %i1ème chargement ------------- 495 : 496 : INTERR(1)=IC 497 : REAERR(1)=T1 497 : CALL ERREUR(342) 498 : GO TO 690 499 : 500 : 606 CONTINUE 501 : 502 : *---------- la premiere table ne pointe pas vers des reels ---------- 503 : 504 : IF((TAPOB1.NE.TAPOB2).OR.(TAPOB1.NE.'FLOTTANT')) THEN 504 : CALL ERREUR(692) 505 : GOTO 690 506 : ENDIF 507 : DREL = (T1 - XVALR1)/(XVALR2 - XVALR1) 508 : 607 CONTINUE 509 : segdes mtab1 510 : mtab2=ipo2 511 : segact mtab2 512 : TAPOB1 =mtab2. mtabtv(ivali1+1) 513 : TAPOB2 =mtab2. mtabtv(ivali2+1) 514 : iobr1 = mtab2. mtabiv(ivali1+1) 515 : * TAPIND = 'ENTIER ' 515 : * CALL ACCTAB(IPO2,TAPIND,IVALI1,XVALIN,CHARIN, 516 : * $ LOGIN,IOBIN,TAPOB1,IVALRE,XVALRE,CHARRE,LOGRE,IOBR1) 517 : IF (JMA1.EQ.1) THEN 518 : IRET = IOBR1 519 : GOTO 668 520 : ENDIF 521 : iobr2=mtab2. mtabiv(ivali2+1) 522 : segdes mtab2 522 : * CALL ACCTAB(IPO2,TAPIND,IVALI2,XVALIN,CHARIN, 523 : * $ LOGIN,IOBIN,TAPOB2,IVALRE,XVALRE,CHARRE,LOGRE,IOBR2) 524 : 525 : *------ la deuxieme table ne pointe pas vers de champs de meme type ---- 526 : 527 : IF(TAPOB1.NE.TAPOB2) THEN 528 : write(6,*) ' ivali1 ' , ivali1 , ' ivali2 ' , ivali2 529 : write(6,*) ' tapob1 ' , tapob1,' tapob2 ',tapob2 529 : CALL ERREUR(693) 530 : GOTO 690 531 : ENDIF 532 : IF(TAPOB1.EQ.'CHPOINT ') THEN 532 : CALL ECROBJ('CHPOINT ',IOBR1) 532 : CALL ECROBJ('CHPOINT ',IOBR2) 532 : CALL ECRREE(1.D0 - DREL) 532 : CALL ECRREE(DREL) 532 : CALL COLI 532 : CALL LIROBJ('CHPOINT ',IRET,1,IRETOU) 533 : IF(IRETOU.EQ.0) GOTO 690 534 : 535 : C------------- calcul du deplacement eventuel du champ ---------- 536 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 537 : & CHAMOB(IC).EQ.'TRAJ') THEN 538 : MTYPR = CHAMOB(IC) 539 : IPOENT = IRET 540 : CHATY2 = CHATYP 541 : IPOENU = ICHPO4 542 : IPOENV = ICHPO5 543 : IPOENW = ICHPO6 544 : IPOENX = ICHPO7 544 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 545 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 546 : IF(IERR.NE.0) RETURN 547 : IRET = IPOSOR 548 : ENDIF 549 : 550 : ELSE IF (TAPOB1.EQ.'MCHAML ') THEN 550 : CALL ECROBJ('MCHAML ',IOBR1) 550 : CALL ECROBJ('MCHAML ',IOBR2) 550 : CALL ECRREE(1.D0 - DREL) 550 : CALL ECRREE(DREL) 550 : CALL COLI 550 : CALL LIROBJ('MCHAML ',IRET,1,IRETOU) 551 : IF(IRETOU.EQ.0) GOTO 690 552 : C------------- calcul du deplacement eventuel du champ ---------- 553 : IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR. 554 : & CHAMOB(IC).EQ.'TRAJ') THEN 555 : MTYPR = CHAMOB(IC) 556 : IPOENT = IRET 557 : CHATY2 = CHATYP 558 : IPOENU = ICHPO4 559 : IPOENV = ICHPO5 560 : IPOENW = ICHPO6 561 : IPOENX = ICHPO7 561 : CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR, 562 : $ IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR) 563 : IF(IERR.NE.0) RETURN 564 : IRET = IPOSOR 565 : ENDIF 566 : 567 : *-------- la deuxieme table ne pointe pas vers un CHPOINT ou MCHAML ---- 568 : 569 : ELSE 569 : CALL ERREUR(694) 570 : GOTO 690 571 : ENDIF 572 : 668 CONTINUE 573 : IF (ISU.EQ.0) THEN 574 : IRETT = IRET 575 : ISU = 1 576 : CHATY2 = TAPOB1 577 : ELSE 578 : 579 : *------------- Chargements elementaires incompatibles --------------- 580 : 581 : IF(TAPOB1.NE.CHATY2) THEN 581 : CALL ERREUR(695) 582 : GOTO 690 583 : ELSE 584 : IF(TAPOB1.EQ.'CHPOINT ') THEN 584 : CALL FUCHPO(IRETT,IRET,IRETOU) 584 : CALL DTCHPO(IRET) 585 : IF(IRETOU.EQ.0) THEN 586 : IF(IRETT.NE.0) THEN 586 : CALL DTCHPO(IRETT) 587 : ENDIF 588 : GOTO 690 589 : ENDIF 589 : CALL DTCHPO(IRETT) 590 : IRETT=IRETOU 591 : ELSE IF (TAPOB1.EQ.'MCHAML ') THEN 591 : CALL ADCHEL(IRETT,IRET,IRETOU,1) 591 : CALL DTCHEL(IRET) 592 : IF(IRETOU.EQ.0) THEN 593 : IF(IRETT.NE.0) THEN 593 : CALL DTCHEL(IRETT) 594 : ENDIF 595 : GOTO 690 596 : ENDIF 596 : CALL DTCHEL(IRETT) 597 : IRETT=IRETOU 598 : ENDIF 599 : CHATY2 = TAPOB1 600 : ENDIF 601 : ENDIF 602 : ENDIF 603 : SEGDES ICHARG 604 : 502 CONTINUE 605 : SEGDES MCHARG 606 : IF(IRETT.EQ.0) RETURN 607 : IF (CHATY2.EQ.'CHPOINT ') THEN 607 : CALL ECROBJ('CHPOINT ',IRETT) 608 : ELSE 608 : CALL ECROBJ('MCHAML ',IRETT) 609 : ENDIF 610 : RETURN 611 : 690 CONTINUE 612 : SEGDES MCHARG 613 : SEGDES ICHARG 614 : RETURN 615 : ENDIF 616 : 617 : 618 : C---------------------------- 619 : C CAS DE L'OBJET SOLUTION 620 : C----------------------------- 621 : 622 : 200 CONTINUE 623 : ISOLIT=0 623 : CALL LIRCHA(MCHA,0,IRETOU) 624 : IF(IRETOU.EQ.0) GO TO 300 625 : C 625 : CALL LIROBJ('SOLUTION ',KSOLU,1,IRETOU) 626 : IF(IERR.NE.0) GOTO 5000 627 : MSOLUT=KSOLU 628 : C 629 : C *** ON VA CHERCHER LE CHAMP DE TYPE MCHA DANS LE MSOLUT 630 : SEGACT MSOLUT 631 : C 632 : C *** LECTURE DE FN,MN,QX,QY OU QZ ? 632 : CALL PLACE(MOFREQ,LFREQ,IPLAC,MCHA) 633 : IF(IPLAC.NE.0) THEN 634 : ICHA=4 635 : GOTO 50 636 : ENDIF 637 : C *** OPTION GRAND DEPLACEMENT ? 637 : CALL PLACE (MOGDEP,LGDEP,IGDEP,MCHA) 638 : IF(IGDEP .NE. 0) THEN 639 : ICHA = 10 + IGDEP 640 : GOTO 50 641 : ENDIF 642 : C *** LECTURE DES DEPLACEMENTS,DES CONTRAINTES ... 643 : MOTERR(1:8)=ITYSOL 643 : CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT) 644 : IF(ICHA.EQ.0) THEN 645 : MOTERR(1:8) = ITYSOL 646 : MOTERR(9:12)= MCHA 646 : CALL ERREUR(235) 647 : C ERREUR DANS LE TYPE DE CHAMP 648 : GOTO 5000 649 : ENDIF 650 : C TYPE = VITE + ROBO 651 : C 652 : IF(ICHA.EQ.8) THEN 652 : CALL LIRMOT ( MOROBO,1,IROBO,0 ) 653 : IF( IROBO.NE.0 ) THEN 654 : ICHA2 = ICHA 655 : ICHA = 5 656 : ENDIF 657 : ENDIF 658 : C TYPE = ACCE + ROBO 659 : C 660 : IF(ICHA.EQ.9) THEN 660 : CALL LIRMOT ( MOROBO,1,IROBO,MROBO ) 661 : IF( IROBO.NE.0 ) THEN 662 : ICHA3 = ICHA 663 : ICHA2 = ICHA - 1 664 : ICHA = 5 665 : ENDIF 666 : ENDIF 667 : C============================= 668 : 50 MSOLEN=MSOLIS(ICHA) 669 : IF(MSOLEN.EQ.0) THEN 670 : MOTERR(1:8) = ITYSOL 671 : MOTERR(9:12)= MCHA 671 : CALL ERREUR(235) 672 : GOTO 5000 673 : ENDIF 674 : ISOLIT=MSOLIT(ICHA) 675 : SEGACT MSOLEN 676 : LTE=ISOLEN(/1) 677 : C 678 : C **** CALCUL DE IRG LE RANG DE L'OBJET CHERCHE 679 : C 680 : IRG=0 680 : CALL LIRMOT(MOOPT,LMOOPT,IMOT,0) 681 : C ------------------------------ON PREND LA DERNIERE VALEUR--------- 682 : IF(IMOT.NE.0) GOTO 700 683 : IRG=LTE 684 : GOTO 152 685 : C 686 : C --------------------------------- RECHERCHE D'UN TEMPS----------- 687 : 700 IF(IMOT.NE.1)GOTO 701 688 : MSOLRE=MSOLIS(1) 689 : IF(MSOLRE.EQ.0) GOTO 140 690 : SEGACT MSOLRE 690 : CALL LIRREE (XXX,1,IRETOU) 691 : IF(IERR.NE.0) GOTO 5000 692 : T1=XXX 693 : IF(T1.EQ.0.) THEN 694 : IF(SOLRE(1).EQ.0.) THEN 695 : IRG=1 696 : SEGDES MSOLRE 697 : GOTO 152 698 : ENDIF 699 : GOTO 140 700 : ENDIF 701 : DO 153 J=1,LTE 702 : T2=SOLRE(J) 703 : TR=ABS((T2-T1)/T1) 704 : IF(TR.LT.PRECI) THEN 705 : IRG=J 706 : SEGDES MSOLRE 707 : GOTO 152 708 : ENDIF 709 : IF(T2.GT.T1) GOTO 140 710 : 153 CONTINUE 711 : 140 CONTINUE 712 : SEGDES MSOLRE 713 : MOTERR(9:16)='FLOTTANT' 714 : GOTO 145 715 : C -------------------------------------RECHERCHE D'UN CAS----------- 716 : 701 CONTINUE 717 : IF(IMOT.NE.2)GOTO 702 718 : MSOLE1=MSOLIS(2) 719 : IF(MSOLE1.EQ.0) GOTO 141 720 : SEGACT MSOLE1 720 : CALL LIRENT(L1,1,IRETOU) 721 : IF(IERR.NE.0) GOTO 5000 722 : DO 154 J=1,LTE 723 : IF(L1.EQ.MSOLE1.ISOLEN(J))THEN 724 : IRG=J 725 : SEGDES MSOLE1 726 : GOTO 152 727 : ENDIF 728 : 154 CONTINUE 729 : 141 CONTINUE 730 : SEGDES MSOLE1 731 : MOTERR(9:16)='ENTIER ' 732 : GOTO 145 733 : C -------------------------------------- RECHERCHE D'UN RANG----------- 734 : 702 IF(IMOT.NE.3) GOTO 703 734 : CALL LIRENT(IRG,1,IRETOU) 735 : IF(IERR.NE.0) GOTO 5000 736 : IF(IRG.GT.LTE.OR.IRG.LT.1) THEN 737 : MOTERR(1:8) = ITYSOL 737 : CALL ERREUR(203) 738 : GOTO 5000 739 : ENDIF 740 : GOTO 152 741 : C ---------------------------------------RECHERCHE D UN NUMERO DE MODE-- 742 : 703 IF(IMOT.NE.4) GOTO 5000 742 : CALL LIRENT(INUME,1,IRETOU) 743 : IF(IERR.NE.0) GOTO 5000 744 : IRG=INUME 745 : C 746 : C 747 : C 748 : C 749 : C 750 : GOTO 152 751 : C --------------------------------ERREUR------------------------- 752 : 145 CONTINUE 753 : MOTERR(1:8)='SOLUTION' 753 : CALL ERREUR(135) 754 : GOTO 5000 755 : C ------------------------------------------------------------------ 756 : 152 CONTINUE 757 : IRET = ISOLEN(IRG) 758 : SEGDES MSOLEN 759 : IF ( IRET.EQ.0 ) THEN 760 : MOTERR(1:8) = ITYSOL 761 : MOTERR(9:12)= MCHA 762 : INTERR(1) = IRG 762 : CALL ERREUR(234) 763 : GOTO 5000 764 : ENDIF 765 : C TYPE = ACCE + ROBO 766 : C VITE 767 : IF ( ICHA2.NE.0 ) THEN 768 : MSOLEN = MSOLIS(ICHA2) 769 : IF(MSOLEN.EQ.0) THEN 770 : MOTERR(1:8) = ITYSOL 771 : MOTERR(9:12)=MCHA 771 : CALL ERREUR(235) 772 : GOTO 5000 773 : ENDIF 774 : ISOLI2 = MSOLIT(ICHA2) 775 : IF ( ISOLI2.NE.ISOLIT ) GOTO 5000 776 : SEGACT MSOLEN 777 : IRET2 = ISOLEN(IRG) 778 : SEGDES MSOLEN 779 : IF ( IRET2.EQ.0 ) THEN 780 : MOTERR(1:8) = ITYSOL 781 : MOTERR(9:12) = MCHA 782 : INTERR(1) = IRG 782 : CALL ERREUR(234) 783 : GOTO 5000 784 : ENDIF 785 : ENDIF 786 : C TYPE = ACCE + ROBO 787 : C 788 : IF ( ICHA3.NE.0 ) THEN 789 : MSOLEN = MSOLIS(ICHA3) 790 : IF(MSOLEN.EQ.0) THEN 791 : MOTERR(1:8) = ITYSOL 792 : MOTERR(9:12)=MCHA 792 : CALL ERREUR(235) 793 : GOTO 5000 794 : ENDIF 795 : ISOLI3 = MSOLIT(ICHA3) 796 : IF ( ISOLI3.NE.ISOLIT ) GOTO 5000 797 : SEGACT MSOLEN 798 : IRET3 = ISOLEN(IRG) 799 : SEGDES MSOLEN 800 : IF ( IRET3.EQ.0 ) THEN 801 : MOTERR(1:8) = ITYSOL 802 : MOTERR(9:12) = MCHA 803 : INTERR(1) = IRG 803 : CALL ERREUR(234) 804 : GOTO 5000 805 : ENDIF 806 : ENDIF 807 : C 808 : C **** FREQUENCE* /MGEN /QX /QY /QZ / POIN ************************** 809 : C POIN 810 : IF ( IPLAC.EQ.6) THEN 811 : IF(ITYSOL.NE.'DYNAMIQU') THEN 812 : MELEME = MSOLIS(3) 813 : SEGACT MELEME 814 : IPOINN = NUM(1,IRG) 814 : * CALL ECRENT(IPOINN) 815 : SEGDES MELEME 815 : CALL ECROBJ ('POINT',IPOINN) 816 : GOTO 5000 817 : ELSE 818 : MOTERR(1:8)='SOLUTION' 819 : MOTERR(9:12) = ITYSOL 820 : INTERR(1) = IRG 820 : CALL ERREUR(131) 821 : GOTO 5000 822 : ENDIF 823 : ENDIF 824 : IF ( ICHA.EQ.4 ) THEN 825 : MMODE = IRET 826 : SEGACT MMODE 827 : RET = FMMODD(IPLAC) 828 : SEGDES MMODE 828 : CALL ECRREE(RET) 829 : GOTO 5000 830 : ENDIF 831 : C 832 : C *** LE MSOLUT EST UN MODE --------------------------------------- 833 : C 834 : IF ( ITYSOL.NE.'MODE ') GOTO 800 835 : MSOLEN = MSOLIS(4) 836 : SEGACT MSOLEN 837 : MMODE = ISOLEN(IRG) 838 : SEGDES MSOLEN 838 : CALL TITMOD(MMODE,ITEX) 839 : GOTO 899 840 : C 841 : 800 CONTINUE 842 : IF ( IMOT.NE.1 ) GOTO 801 843 : WRITE(ITEX(1:24),FMT='(A4,8X,1PE12.5)') MCHA,T1 844 : ITEX(5:12) = ' T=' 845 : GOTO 899 846 : 801 CONTINUE 847 : 899 CONTINUE 848 : C 849 : C *** LA SORTIE PORTE SUR DES CHPOINTS--------------------------- 850 : C 851 : IF ( ISOLIT.NE.2 ) GOTO 600 852 : IF ( ICHA2.EQ.0 ) THEN 853 : IF (ITEX.NE.' ') THEN 854 : MCHPOI = IRET 855 : SEGACT MCHPOI*MOD 856 : MOCHDE = ITEX 857 : SEGDES MCHPOI 858 : ENDIF 859 : GOTO 699 860 : ENDIF 861 : C TYPE = VITE + ROBO 862 : C 863 : IF ( ICHA3.EQ.0 ) THEN 864 : N1 = 2 865 : SEGINI MLCHPO 866 : ICHPOI(1) = IRET 867 : ICHPOI(2) = IRET2 868 : IF (ITEX.NE.' ') THEN 869 : MCHPOI = IRET 870 : SEGACT MCHPOI*MOD 871 : MOCHDE = ITEX 872 : SEGDES MCHPOI 873 : ENDIF 874 : ISOLIT = 34 875 : IRET = MLCHPO 876 : SEGDES MLCHPO 877 : GOTO 699 878 : ENDIF 879 : C TYPE = ACCE + ROBO 880 : C 881 : N1 = 3 882 : SEGINI MLCHPO 883 : ICHPOI(1) = IRET 884 : ICHPOI(2) = IRET2 885 : ICHPOI(3) = IRET3 886 : IF (ITEX.NE.' ') THEN 887 : MCHPOI = IRET 888 : SEGACT MCHPOI*MOD 889 : MOCHDE = ITEX 890 : SEGDES MCHPOI 891 : ENDIF 892 : ISOLIT = 34 893 : IRET = MLCHPO 894 : SEGDES MLCHPO 895 : GOTO 699 896 : C 897 : 600 CONTINUE 898 : IF ( ISOLIT.NE.5 ) GOTO 601 899 : WRITE(IOIMP,*) 'TIRE :CAS ISOLIT=5 N EST PLUS BRANCHE' 900 : C 901 : 601 CONTINUE 902 : 699 CONTINUE 903 : CTYP = ' ' 903 : CALL TYPFIL (CTYP,ISOLIT) 903 : CALL ECROBJ (CTYP,IRET) 904 : 5000 CONTINUE 905 : RETURN 906 : C 907 : C PAS D OPERANDE CORRECTE TROUVE 908 : C 908 : 300 CALL QUETYP(MOTERR(1:8),0,IRETOU) 909 : IF(IRETOU.NE.0) THEN 909 : CALL ERREUR (39) 910 : ELSE 910 : CALL ERREUR(533) 911 : ENDIF 912 : C 913 : RETURN 914 : END 915 : 916 : 917 :
© Cast3M 2003 - All rights reserved.
Disclaimer