Télécharger opermu.eso

Retour à la liste

Numérotation des lignes :

  1. C OPERMU SOURCE GF238795 18/02/01 21:16:09 9724
  2. SUBROUTINE OPERMU
  3. C_______________________________________________________________________
  4. C
  5. C multiplie un champ par point par un objet rigidite.
  6. C multiplie un listreel par un flottant (ou un entier)
  7. C multiplie un listreel par un listreel terme a terme.
  8. C multiplie un objet rigidite par un flottant (ou 1 entier)
  9. C multiplie un champs par elemt par un flottant (ou 1 entier)
  10. C multiplie un champ par element par un autre champ par element
  11. C multiplie un champ par element par une evolution
  12. C multiplie un champ par point par un autre champ par point
  13. C multiplie un champ par point par un flottant (ou 1 entier)
  14. C multiplie un champ par point par une evolution
  15. C multiplie 2 nombres (flottant ou entier)
  16. C multiplie un point par un nombre
  17. C multiplie un objet evolutio (ordonnees) par un flottant
  18. C (ou un entier)
  19. C multiplie un objet evolutio par un objet evolutio
  20. C multiplie une table soustype vecteur par un reel
  21. C multiplie une table soustype LIAISONS_STATIQUES ou
  22. C BASE_DE_MODES par une rigidite
  23. C
  24. C passage aux nouveaux MCHAML par jm campenon le 29 10 90
  25. C
  26. C_______________________________________________________________________
  27. C
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMLENTI
  33. -INC SMLREEL
  34. -INC SMTABLE
  35.  
  36.  
  37. INTEGER ICH1
  38. INTEGER IOPERA
  39. INTEGER IARGU
  40. INTEGER I1
  41. REAL*8 FLO
  42. INTEGER ICHR
  43. INTEGER IRET
  44. ICH1 = 0
  45. IOPERA = 0
  46. IARGU = 0
  47. I1 = 0
  48. FLO = 0.D0
  49. ICHR = 0
  50. IRET = 0
  51. C_______________________________________________________________________
  52. C
  53. C produit de deux CHPOINT
  54. C_______________________________________________________________________
  55. C
  56. CALL LIROBJ('CHPOINT',ICHP1,0,IRETOU)
  57. IF (IRETOU.EQ.0) GOTO 1
  58. CALL LIROBJ('CHPOINT',ICHP2,0,IRETOU)
  59. IF (IRETOU.EQ.0) THEN
  60. CALL REFUS
  61. GOTO 1
  62. ENDIF
  63.  
  64. CALL LIROBJ('LISTMOTS',LMOT1,0,IRETOU)
  65. IF ( IRETOU .EQ. 1) THEN
  66. CALL LIROBJ('LISTMOTS',LMOT2,1,IRETOU)
  67. IF (IERR .NE. 0) RETURN
  68.  
  69. CALL LIROBJ('LISTMOTS',LMOT3,1,IRETOU)
  70. IF (IERR .NE. 0) RETURN
  71. CALL MUCHP1(ICHP1,ICHP2,LMOT1,LMOT2,LMOT3,1,IRET)
  72. ELSE
  73.  
  74. CALL MUPOSC(ICHP1,ICHP2,1,IRET)
  75. ENDIF
  76.  
  77. IF (IRET.NE.0) CALL ECROBJ('CHPOINT',IRET)
  78.  
  79. RETURN
  80. C
  81. 1 CONTINUE
  82. IF (IERR .NE. 0) RETURN
  83. C_______________________________________________________________________
  84. C
  85. C multiplication de deux ENTIER
  86. C_______________________________________________________________________
  87. C
  88. CALL LIRENT(IRE1,0,IRETOU)
  89. IF (IRETOU.EQ.0) GOTO 2
  90. CALL LIRENT(IRE2,0,IRETOU)
  91. IF (IRETOU.EQ.0) THEN
  92. CALL REFUS
  93. GOTO 2
  94. ENDIF
  95.  
  96. C Cas du produit de 2 ENTIERS
  97. CALL ECRENT(IRE1*IRE2)
  98. RETURN
  99. C
  100. 2 CONTINUE
  101. IF (IERR .NE. 0) RETURN
  102. C_______________________________________________________________________
  103. C
  104. C multiplication de deux FLOTTANT
  105. C_______________________________________________________________________
  106. C
  107. CALL LIRREE(FLO1,0,IRETOU)
  108. IF (IRETOU.EQ.0) GOTO 3
  109. CALL LIRREE(FLO2,0,IRETOU)
  110. IF (IRETOU.EQ.0) THEN
  111. CALL REFUS
  112. GOTO 3
  113. ENDIF
  114. CALL ECRREE(FLO1*FLO2)
  115. RETURN
  116. C
  117. 3 CONTINUE
  118. IF (IERR .NE. 0) RETURN
  119. C_______________________________________________________________________
  120. C
  121. C produit d'un FLOTTANT par un POINT
  122. C_______________________________________________________________________
  123. C
  124. CALL LIRREE(FLO1,0,IRETOU)
  125. IF (IRETOU.EQ.0) GOTO 4
  126. CALL LIROBJ('POINT',IPT,0,IRETOU)
  127. IF (IRETOU.EQ.0) THEN
  128. CALL REFUS
  129. GOTO 4
  130. ENDIF
  131. SEGACT MCOORD*MOD
  132. DO ILDIM=1,IDIM+1
  133. XCOOR(**)=XCOOR((IPT-1)*(IDIM+1)+ILDIM)*FLO1
  134. ENDDO
  135. IRET=XCOOR(/1)/(IDIM+1)
  136. CALL ECROBJ('POINT',IRET)
  137. RETURN
  138. C
  139. 4 CONTINUE
  140. IF (IERR .NE. 0) RETURN
  141. C_______________________________________________________________________
  142. C
  143. C produit d'un CHPOINT par un FLOTTANT
  144. C_______________________________________________________________________
  145. C
  146. CALL LIRREE(FLO,0,IRETOU)
  147. IF (IRETOU.EQ.0) GOTO 5
  148. CALL LIROBJ('CHPOINT',ICH1,0,IRETOU)
  149. IF (IRETOU.EQ.0) THEN
  150. CALL REFUS
  151. GOTO 5
  152. ENDIF
  153. C IOPERA= 2 pour l'operation PRODUIT
  154. C IARGU = 2 pour FLOTTANT
  155. IOPERA= 2
  156. IARGU = 2
  157. I1 = 0
  158. CALL OPCHP1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  159. IF(IRET.NE.0) THEN
  160. CALL ECROBJ('CHPOINT',ICHR)
  161. ELSE
  162. CALL ERREUR(26)
  163. ENDIF
  164. RETURN
  165. C
  166. 5 CONTINUE
  167. IF (IERR .NE. 0) RETURN
  168. C_______________________________________________________________________
  169. C
  170. C produit d'un MCHAML par un FLOTTANT
  171. C_______________________________________________________________________
  172. C
  173. CALL LIRREE(FLO,0,IRETOU)
  174. IF (IRETOU.EQ.0) GOTO 6
  175. CALL LIROBJ('MCHAML',ICH1,0,IRETOU)
  176. IF (IRETOU.EQ.0) THEN
  177. CALL REFUS
  178. GOTO 6
  179. ENDIF
  180. C IOPERA= 2 pour l'operation PRODUIT
  181. C IARGU = 2 pour FLOTTANT
  182. IOPERA= 2
  183. IARGU = 2
  184. I1 = 0
  185. ICHR = 0
  186. IRET = 0
  187. CALL OPCHE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  188. IF(IRET.NE.0) THEN
  189. CALL ECROBJ('MCHAML',ICHR)
  190. ELSE
  191. CALL ERREUR(26)
  192. ENDIF
  193. RETURN
  194. C
  195. 6 CONTINUE
  196. IF (IERR .NE. 0) RETURN
  197. C_______________________________________________________________________
  198. C
  199. C produit d'une RIGIDITE par un FLOTTANT
  200. C_______________________________________________________________________
  201. C
  202. CALL LIRREE(FLO,0,IRETOU)
  203. IF (IRETOU.EQ.0) GOTO 7
  204. CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU)
  205. IF (IRETOU.EQ.0) THEN
  206. CALL REFUS
  207. GOTO 7
  208. ENDIF
  209. CALL MUFLRI(IRIG,FLO,IRET,1)
  210. IF (IRET.NE.0) CALL ECROBJ('RIGIDITE',IRET)
  211. RETURN
  212. C
  213. 7 CONTINUE
  214. IF (IERR .NE. 0) RETURN
  215. C_______________________________________________________________________
  216. C
  217. C produit d'un MATRIK par un FLOTTANT
  218. C_______________________________________________________________________
  219. C
  220. CALL LIRREE(FLO,0,IRETOU)
  221. IF (IRETOU.EQ.0) GOTO 71
  222. CALL LIROBJ('MATRIK ',IRIG,0,IRETOU)
  223. IF (IRETOU.EQ.0) THEN
  224. CALL REFUS
  225. GOTO 71
  226. ENDIF
  227. CALL PRDMF(FLO,IRIG,IRET)
  228. IF (IRET.NE.0) CALL ECROBJ('MATRIK ',IRET)
  229. RETURN
  230. C
  231. 71 CONTINUE
  232. IF (IERR .NE. 0) RETURN
  233. C_______________________________________________________________________
  234. C
  235. C produit d'une RIGIDITE par un CHPOINT
  236. C_______________________________________________________________________
  237. C
  238. CALL LIROBJ('CHPOINT',ICHP,0,IRETOU)
  239. IF (IRETOU.EQ.0) GOTO 8
  240. CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU)
  241. IF (IRETOU.EQ.0) THEN
  242. CALL REFUS
  243. GOTO 8
  244. ENDIF
  245. CALL MUCPRI(ICHP,IRIG,IRET)
  246. CALL ECROBJ('CHPOINT',IRET)
  247. RETURN
  248. C
  249. 8 CONTINUE
  250. IF (IERR .NE. 0) RETURN
  251. C_______________________________________________________________________
  252. C
  253. C produit d'un MATRIK par un CHPOINT
  254. C_______________________________________________________________________
  255. C
  256. CALL LIROBJ('CHPOINT',ICHP,0,IRETOU)
  257. IF (IRETOU.EQ.0) GOTO 9
  258. CALL LIROBJ('MATRIK ',IRIG,0,IRETOU)
  259. IF (IRETOU.EQ.0) THEN
  260. CALL REFUS
  261. GOTO 9
  262. ENDIF
  263. CALL PRDMCP(IRIG,ICHP,IRET)
  264. CALL ECROBJ('CHPOINT',IRET)
  265. RETURN
  266. C
  267. 9 CONTINUE
  268. IF (IERR .NE. 0) RETURN
  269.  
  270. C_______________________________________________________________________
  271. C
  272. C produit de deux MCHAML
  273. C_______________________________________________________________________
  274. C
  275. CALL LIROBJ('MMODEL',IPMODL,0,IRETOU)
  276. IF (IRETOU.EQ.0) IPMODL=0
  277. CALL LIROBJ('MCHAML',ICHP1,0,IRETOU)
  278. IF (IRETOU.EQ.0) GOTO 10
  279. CALL LIROBJ('MCHAML',ICHP2,0,IRETOU)
  280. IF (IRETOU.EQ.0) THEN
  281. CALL REFUS
  282. GOTO 10
  283. ENDIF
  284. C
  285. LMOT1 = -1
  286. LMOT2 = -1
  287. LMOT3 = -1
  288. ILREE = -1
  289. CALL LIROBJ('LISTMOTS',LMOT1,0,IRETOU)
  290. IF ( IRETOU .EQ. 1) THEN
  291. CALL LIROBJ('LISTMOTS',LMOT2,1,IRETOU)
  292. IF (IERR .NE. 0) RETURN
  293. CALL LIROBJ('LISTMOTS',LMOT3,1,IRETOU)
  294. IF (IERR .NE. 0) RETURN
  295. CALL LIROBJ('LISTREEL',ILREE,0,IRETOU)
  296. IF (IERR .NE. 0) RETURN
  297. ENDIF
  298. C
  299. CALL MUCHSC(IPMODL,ICHP1,ICHP2,IPCHMU,LMOT1,LMOT2,LMOT3,ILREE,1)
  300. IF(IERR.NE.0) RETURN
  301. C
  302. IF (IPCHMU.NE.0) THEN
  303. CALL ECROBJ('MCHAML',IPCHMU)
  304. ELSE
  305. CALL ERREUR(26)
  306. ENDIF
  307. RETURN
  308.  
  309. 10 CONTINUE
  310. IF (IERR .NE. 0) RETURN
  311. C_______________________________________________________________________
  312. C
  313. C produit ENTIER EVOLUTION
  314. C_______________________________________________________________________
  315. C
  316. CALL LIRENT(I1,0,IRETOU)
  317. IF (IRETOU.EQ.0) GOTO 101
  318. CALL LIROBJ('EVOLUTIO',ICH1,0,IRETOU)
  319. IF (IRETOU.EQ.0) THEN
  320. CALL REFUS
  321. GOTO 101
  322. ENDIF
  323. C IOPERA= 2 pour l'operation PRODUIT
  324. C IARGU = 1 pour ENTIER
  325. IOPERA= 2
  326. IARGU = 1
  327. FLO = REAL(0.D0)
  328. CALL OPEVO1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  329. IF(IRET.NE.0) THEN
  330. CALL ECROBJ('EVOLUTIO',ICHR)
  331. ELSE
  332. CALL ERREUR(26)
  333. ENDIF
  334. RETURN
  335. C
  336. 101 CONTINUE
  337. IF (IERR .NE. 0) RETURN
  338. C_______________________________________________________________________
  339. C
  340. C produit FLOTTANT EVOLUTION
  341. C_______________________________________________________________________
  342. C
  343. CALL LIRREE(FLO,0,IRETOU)
  344. IF (IRETOU.EQ.0) GOTO 11
  345. CALL LIROBJ('EVOLUTIO',ICH1,0,IRETOU)
  346. IF (IRETOU.EQ.0) THEN
  347. CALL REFUS
  348. GOTO 11
  349. ENDIF
  350. C IOPERA= 2 pour l'operation PRODUIT
  351. C IARGU = 2 pour FLOTTANT
  352. IOPERA= 2
  353. IARGU = 2
  354. I1 = 0
  355. CALL OPEVO1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  356. IF(IRET.NE.0) THEN
  357. CALL ECROBJ('EVOLUTIO',ICHR)
  358. ELSE
  359. CALL ERREUR(26)
  360. ENDIF
  361. RETURN
  362. C
  363. 11 CONTINUE
  364. IF (IERR .NE. 0) RETURN
  365. C_______________________________________________________________________
  366. C
  367. C produit de deux EVOLUTIO
  368. C_______________________________________________________________________
  369. C
  370. CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU)
  371. IF (IRETOU.EQ.0) GOTO 12
  372. CALL LIROBJ('EVOLUTIO',IEVOL2,0,IRETOU)
  373. IF (IRETOU.EQ.0) THEN
  374. CALL REFUS
  375. GOTO 12
  376. ENDIF
  377. CALL PUIS(IEVOL1,IEVOL2,IRET,1)
  378. CALL ECROBJ('EVOLUTIO',IRET)
  379. RETURN
  380. C
  381. 12 CONTINUE
  382. IF (IERR .NE. 0) RETURN
  383. C_______________________________________________________________________
  384. C
  385. C produit FLOTTANT LISTREEL
  386. C_______________________________________________________________________
  387. C
  388. CALL LIRREE(FLO,0,IRETOU)
  389. IF (IRETOU.EQ.0) GOTO 13
  390. CALL LIROBJ('LISTREEL',ICH1,0,IRETOU)
  391. IF (IRETOU.EQ.0) THEN
  392. CALL REFUS
  393. GOTO 13
  394. ENDIF
  395. C IOPERA= 2 pour l'operation PRODUIT
  396. C IARGU = 2 pour FLOTTANT
  397. IOPERA= 2
  398. IARGU = 2
  399. I1 = 0
  400. CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  401. IF(IRET.NE.0) THEN
  402. CALL ECROBJ('LISTREEL',ICHR)
  403. ELSE
  404. CALL ERREUR(26)
  405. ENDIF
  406. RETURN
  407. C
  408. 13 CONTINUE
  409. IF (IERR .NE. 0) RETURN
  410. C_______________________________________________________________________
  411. C
  412. C produit CHPOINT EVOLUTION
  413. C_______________________________________________________________________
  414. C
  415. CALL LIROBJ('CHPOINT',ICHP,0,IRETOU)
  416. IF (IRETOU.EQ.0) GOTO 14
  417. CALL LIROBJ('EVOLUTIO',IEVOL,0,IRETOU)
  418. IF (IRETOU.EQ.0) THEN
  419. CALL REFUS
  420. GOTO 14
  421. ENDIF
  422. CALL VARCHP(ICHP,IEVOL,IRET,IRETOU)
  423. IF (IRETOU.NE.0) CALL ECROBJ('CHPOINT',IRET)
  424. RETURN
  425. C
  426. 14 CONTINUE
  427. IF (IERR .NE. 0) RETURN
  428. C_______________________________________________________________________
  429. C
  430. C produit MCHAML EVOLUTION
  431. C_______________________________________________________________________
  432. C
  433. CALL LIROBJ('MCHAML',IPCHP,0,IRETOU)
  434. IF (IRETOU.EQ.0) GOTO 15
  435. CALL LIROBJ('EVOLUTIO',IEVOL,0,IRETOU)
  436. IF (IRETOU.EQ.0) THEN
  437. CALL REFUS
  438. GOTO 15
  439. ENDIF
  440. C
  441. CALL VARCHE(IPCHP,IEVOL,IPCHMU,IRETOU)
  442. C
  443. IF (IRETOU.NE.0) CALL ECROBJ('MCHAML',IPCHMU)
  444. C
  445. RETURN
  446. C
  447. 15 CONTINUE
  448. IF (IERR .NE. 0) RETURN
  449. C_______________________________________________________________________
  450. C
  451. C produit LISTREEL LISTREEL
  452. C_______________________________________________________________________
  453. C
  454. CALL LIROBJ('LISTREEL',ICH1,0,IRETOU)
  455. IF(IRETOU.EQ.0) GOTO 16
  456. CALL LIROBJ('LISTREEL',ICHR,0,IRETOU)
  457. IF (IRETOU.EQ.0) THEN
  458. CALL REFUS
  459. GOTO 16
  460. ENDIF
  461. C IOPERA= 2 pour l'operation PRODUIT
  462. C IARGU = 0
  463. IOPERA= 2
  464. IARGU = 0
  465. I1 = 0
  466. FLO = REAL(0.D0)
  467. CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  468. IF(IRET.NE.0) THEN
  469. CALL ECROBJ('LISTREEL',ICHR)
  470. ELSE
  471. CALL ERREUR(26)
  472. ENDIF
  473. RETURN
  474. C
  475. 16 CONTINUE
  476. IF (IERR .NE. 0) RETURN
  477. C_______________________________________________________________________
  478. C
  479. C produit LISTENTI ENTIER
  480. C_______________________________________________________________________
  481. C
  482. CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
  483. IF(IRETOU.EQ.0) GOTO 17
  484. CALL LIRENT(IVA,0,IRETOU)
  485. IF (IRETOU.EQ.0) THEN
  486. CALL REFUS
  487. GOTO 17
  488. ENDIF
  489. SEGACT MLENT1
  490. JG=MLENT1.LECT(/1)
  491. SEGINI MLENTI
  492. DO 160 I=1,JG
  493. LECT(I)=MLENT1.LECT(I)*IVA
  494. 160 CONTINUE
  495. SEGDES MLENTI,MLENT1
  496. CALL ECROBJ('LISTENTI',MLENTI)
  497. RETURN
  498. C
  499. 17 CONTINUE
  500. IF (IERR .NE. 0) RETURN
  501. C_______________________________________________________________________
  502. C
  503. C produit LISTENTI FLOTTANT
  504. C_______________________________________________________________________
  505. C
  506. CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
  507. IF(IRETOU.EQ.0) GOTO 18
  508. CALL LIRREE(XVA,0,IRETOU)
  509. IF (IRETOU.EQ.0) THEN
  510. CALL REFUS
  511. GOTO 18
  512. ENDIF
  513. SEGACT MLENT1
  514. JG=MLENT1.LECT(/1)
  515. SEGINI MLREEL
  516. DO 170 I=1,JG
  517. PROG(I)=REAL(MLENT1.LECT(I))*XVA
  518. 170 CONTINUE
  519. SEGDES MLREEL,MLENT1
  520. CALL ECROBJ('LISTREEL',MLREEL)
  521. RETURN
  522. C
  523. 18 CONTINUE
  524. IF (IERR .NE. 0) RETURN
  525. C_______________________________________________________________________
  526. C
  527. C produit LISTENTI LISTENTI
  528. C_______________________________________________________________________
  529. C
  530. CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
  531. IF(IRETOU.EQ.0) GOTO 19
  532. CALL LIROBJ('LISTENTI',MLENT2,0,IRETOU)
  533. IF (IRETOU.EQ.0) THEN
  534. CALL REFUS
  535. GOTO 19
  536. ENDIF
  537. SEGACT MLENT1,MLENT2
  538. JG=MLENT2.LECT(/1)
  539. IF(MLENT1.LECT(/1).NE.JG) THEN
  540. CALL ERREUR (217)
  541. RETURN
  542. ENDIF
  543. SEGINI MLENTI
  544. DO 180 I=1,JG
  545. LECT(I)=MLENT1.LECT(I)*MLENT2.LECT(I)
  546. 180 CONTINUE
  547. SEGDES MLENTI,MLENT1,MLENT2
  548. CALL ECROBJ('LISTENTI',MLENTI)
  549. RETURN
  550. C
  551. 19 CONTINUE
  552. IF (IERR .NE. 0) RETURN
  553. C_______________________________________________________________________
  554. C
  555. C produit TABLE-VECTEUR FLOTTANT
  556. C_______________________________________________________________________
  557. C
  558. CALL LIRREE(FLO1,0,IRETOU)
  559. IF(IRETOU.EQ.0) GOTO 20
  560. CALL LIRTAB('VECTEUR',MTAB1,0,IRETOU)
  561. IF (IRETOU.EQ.0) THEN
  562. CALL REFUS
  563. GOTO 20
  564. ENDIF
  565. SEGINI,MTABLE=MTAB1
  566. DO 200 I=1,MLOTAB
  567. IF (MTABTV(I).EQ.'FLOTTANT') THEN
  568. RMTABV(I)=RMTABV(I)*FLO1
  569. ELSE IF (MTABTV(I).EQ.'ENTIER ') THEN
  570. RMTABV(I)=REAL(MTABIV(I))*FLO1
  571. MTABTV(I)='FLOTTANT'
  572. ENDIF
  573. 200 CONTINUE
  574. SEGDES MTABLE,MTAB1
  575. CALL ECROBJ('TABLE',MTABLE)
  576. RETURN
  577. C
  578. 20 CONTINUE
  579. IF (IERR .NE. 0) RETURN
  580. C_______________________________________________________________________
  581. C
  582. C produit d'une RIGIDITE par un CHPOINT
  583. C_______________________________________________________________________
  584. C
  585. CALL LIROBJ('LISTCHPO',ILCHP,0,IRETOU)
  586. IF (IRETOU.EQ.0) GOTO 21
  587. CALL LIROBJ('RIGIDITE',IRIG,0,IRETOU)
  588. IF (IRETOU.EQ.0) THEN
  589. CALL REFUS
  590. GOTO 21
  591. ENDIF
  592. CALL MUCPLI(ILCHP,IRIG,IRET)
  593. CALL ECROBJ('LISTCHPO',IRET)
  594. RETURN
  595. C
  596. 21 CONTINUE
  597. IF (IERR .NE. 0) RETURN
  598.  
  599. C_______________________________________________________________________
  600. C
  601. C produit table-liaisons_statiques RIGIDITE
  602. C_______________________________________________________________________
  603. C
  604. CALL LIRTAB('LIAISONS_STATIQUES',ITBST,0,IRETOU)
  605. IF(IRETOU.EQ.0) CALL LIRTAB('BASE_DE_MODES',ITBST,0,IRETOU)
  606. IF(IRETOU.EQ.0) GOTO 22
  607. call lirobj('RIGIDITE',ir1,1,iretou)
  608. IF (IRETOU.EQ.0) THEN
  609. CALL REFUS
  610. GOTO 22
  611. ENDIF
  612. call prmu(ir1,itbst)
  613. RETURN
  614. C
  615.  
  616. 22 CONTINUE
  617. IF (IERR .NE. 0) RETURN
  618. C_______________________________________________________________________
  619. C
  620. C produit LISTREEL LISTENTI
  621. C_______________________________________________________________________
  622. C
  623. CALL LIROBJ('LISTREEL',MLREE1,0,IRETOU)
  624. IF(IRETOU.EQ.0) GOTO 30
  625. CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
  626. IF (IRETOU.EQ.0) THEN
  627. CALL REFUS
  628. GOTO 30
  629. ENDIF
  630. SEGACT MLREE1,MLENT1
  631. JG=MLENT1.LECT(/1)
  632. IF(MLREE1.PROG(/1).NE.JG) THEN
  633. CALL ERREUR (217)
  634. RETURN
  635. ENDIF
  636. SEGINI MLREEL
  637. DO 220 I=1,JG
  638. PROG(I)=MLREE1.PROG(I)*REAL(MLENT1.LECT(I))
  639. 220 CONTINUE
  640. SEGDES MLREEL,MLREE1,MLENT1
  641. CALL ECROBJ('LISTREEL',MLREEL)
  642. RETURN
  643. C_______________________________________________________________________
  644. C
  645. C ON A DONC RIEN TROUVE POUR FAIRE L OPERATION
  646. C_______________________________________________________________________
  647. C
  648. 30 CONTINUE
  649. IF (IERR .NE. 0) RETURN
  650. CALL QUETYP(MOTERR(1:8),0,IRETOU)
  651. IF(IRETOU.NE.0) THEN
  652. CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU)
  653. CALL QUETYP(MOTERR(9:16),0,IRETOU)
  654. IF (IRETOU.EQ.0) MOTERR(9:16) = ' ???? '
  655. CALL ERREUR(532)
  656. ELSE
  657. CALL ERREUR(533)
  658. ENDIF
  659.  
  660. RETURN
  661. END
  662.  
  663.  
  664.  

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