Télécharger tire.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales