Télécharger rigtab.eso

Retour à la liste

Numérotation des lignes :

  1. C RIGTAB SOURCE BP208322 17/10/03 21:16:49 9580
  2. SUBROUTINE RIGTAB(ITBAS,ITBST,IRIG,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. * *
  8. * calcule pour les modes les petites matrices RIGIDITE contenant *
  9. * la masse (IRIG = 1), la raideur (IRIG = 2), ou amortissement *
  10. * (IRIG = 3). Ces matrices sont associ{es @ l'{l{ment qui con- *
  11. * tient le point qui est l'indice de chaque mode. *
  12. * *
  13. * Param}tres: *
  14. * *
  15. * e ITBAS table de mode, de sous-type BASE_DE_MODES *
  16. * e IRIG 1, 2, ou 3 *
  17. * s IRET matrice de masse, de rigidit{, ou d'amortissement *
  18. * *
  19. * Auteur, date de cr{ation: *
  20. * *
  21. * Lionel VIVAN, le 7 juin 1990. *
  22. * *
  23. *--------------------------------------------------------------------*
  24. * *
  25. -INC CCOPTIO
  26. -INC CCREEL
  27. *-
  28. -INC SMELEME
  29. -INC SMRIGID
  30. -INC SMTABLE
  31. -INC SMLMOTS
  32. *
  33. LOGICAL L0,L1,ltelq
  34. CHARACTER*8 TYPRET,CHARRE
  35. * CHARACTER*4 lesinc(6),lesdua(6)
  36. PARAMETER (jgm=12)
  37. CHARACTER*4 lesinc(jgm),lesdua(jgm)
  38. DATA lesinc/'UX','UY','UZ','RX','RY','RZ',
  39. >'IUX','IUY','IUZ','IRX','IRY','IRZ'/
  40. DATA lesdua/'FX','FY','FZ','MX','MY','MZ',
  41. >'IFX','IFY','IFZ','IMX','IMY','IMZ'/
  42. *
  43. IRET = 0
  44. IF (IRIG.NE.1 .AND. IRIG.NE.2 .AND. IRIG.NE.3) RETURN
  45. *
  46. NRIGE = 8
  47. NRIGEL = 1
  48. SEGINI MRIGID
  49. IF (IRIG.EQ.1) THEN
  50. MTYMAT = 'MASSE '
  51. ELSE IF (IRIG.EQ.2) THEN
  52. MTYMAT = 'RIGIDITE'
  53. ELSE
  54. MTYMAT = 'AMORMODA'
  55. ENDIF
  56.  
  57. IFORIG = IFOMOD
  58. COERIG(1) = 1.D0
  59. IMGEO1 = 0
  60. IMGEO2 = 0
  61. ICHOLE = 0
  62. ISUPEQ = 0
  63. *
  64. IRIGEL(2,1) = 0
  65. IRIGEL(5,1) = NIFOUR
  66. IRIGEL(6,1) = 0
  67.  
  68. mrimod = 0
  69. if (itbas.eq.0) goto 30
  70.  
  71. NLIGRP = 1
  72. NLIGRD = 1
  73. SEGINI DESCR
  74. IRIGEL(3,1) = DESCR
  75. NOELEP(1) = 1
  76. NOELED(1) = 1
  77. LISINC(1) = 'ALFA'
  78. LISDUA(1) = 'FALF'
  79. SEGDES DESCR
  80. *
  81. mtable = itbas
  82. segact mtable
  83. mlo = mlotab
  84. IM = 0
  85. 10 CONTINUE
  86. IM = IM + 1
  87. TYPRET = ' '
  88. CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  89. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  90. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  91. CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  92. & 'POINT',I1,X1,' ',L1,IPTS)
  93. CALL CRELEM(IPTS)
  94.  
  95. IF (IM.EQ.1) THEN
  96. IPT1 = IPTS
  97. ELSE
  98. IPT2 = IPTS
  99. ltelq=.false.
  100. CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  101. IF (IERR.NE.0) RETURN
  102. IPT1 = IMAIL
  103. ENDIF
  104. GOTO 10
  105. ENDIF
  106. if (im.lt.mlo) goto 10
  107. if (ipt1.eq.0) then
  108. interr(1) = 1
  109. if (mrigid.gt.0) segsup mrigid
  110. call erreur(974)
  111. return
  112. endif
  113.  
  114. IRIGEL(1,1) = IPT1
  115. *
  116. segact ipt1
  117. NBMODE = ipt1.num(/2)
  118. segdes ipt1
  119. NELRIG = NBMODE
  120. SEGINI xMATRI
  121. IRIGEL(4,1) = xMATRI
  122. NLIGRP=1
  123. NLIGRD=1
  124. DO 20 IM = 1,NBMODE
  125. * SEGINI XMATRI
  126. * IMATTT(IM) = XMATRI
  127. CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  128. & 'TABLE',I1,X1,' ',L1,ITMOD)
  129. CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  130. & 'FLOTTANT',I1,XMGEN,' ',L1,IP1)
  131. IF (IRIG.EQ.1) THEN
  132. RE(1,1,im) = XMGEN
  133. ELSE IF (IRIG.EQ.2) THEN
  134. CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  135. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  136. OMEG = 2. * XPI * XFREQ
  137. OMEG = OMEG * OMEG
  138. RE(1,1,im) = XMGEN * OMEG
  139. cbp-2017-10-02 : ajout
  140. IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0
  141. ELSE
  142. CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  143. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  144. OMEG = 2. * XPI * XFREQ
  145. RE(1,1,im) = XMGEN * OMEG * 2.
  146. cbp-2017-10-02 : ajout
  147. IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0
  148. ENDIF
  149. * SEGDES XMATRI
  150. 20 CONTINUE
  151.  
  152. SEGDES xMATRI
  153. *
  154. mrimod = mrigid
  155. SEGDES MRIGID
  156. if (itbst.eq.0) goto 80
  157.  
  158. 30 continue
  159. jgn = 4
  160. c jgm = 6
  161. segini mlmots
  162. iinc = mlmots
  163. do igm = 1,jgm
  164. mots(igm) = lesinc(igm)
  165. enddo
  166. segini mlmots
  167. idua = mlmots
  168. do igm= 1,jgm
  169. mots(igm) = lesdua(igm)
  170. enddo
  171.  
  172. if (itbas.ne.0) then
  173. segini,ri1=mrigid
  174. mrigid = ri1
  175. endif
  176. mrista = mrigid
  177.  
  178. NLIGRP = 1
  179. NLIGRD = 1
  180. SEGINI DESCR
  181. IRIGEL(3,1) = DESCR
  182. NOELEP(1) = 1
  183. NOELED(1) = 1
  184. LISINC(1) = 'BETA'
  185. LISDUA(1) = 'FBET'
  186. SEGDES DESCR
  187. *
  188.  
  189. mtable = itbst
  190. segact mtable
  191.  
  192. IM = 0
  193. IPT1 = 0
  194. 40 CONTINUE
  195. IM = IM + 1
  196. itmod = mtabiv(im)
  197. typret = mtabtv(im)
  198. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  199. CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  200. & 'POINT',I1,X1,' ',L1,IPTS)
  201. CALL CRELEM(IPTS)
  202. IF (IPT1.EQ.0) THEN
  203. IPT1 = IPTS
  204. ELSE
  205. IPT2 = IPTS
  206. ltelq=.false.
  207. CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  208. IF (IERR.NE.0) RETURN
  209. IPT1 = IMAIL
  210. ENDIF
  211. GOTO 40
  212. ENDIF
  213. if (im.lt.mlotab) goto 40
  214. IRIGEL(1,1) = IPT1
  215. if (ipt1.le.0) then
  216. interr(1) = 2
  217. if (mrigid.gt.0) segsup mrigid
  218. call erreur(974)
  219. return
  220. endif
  221.  
  222. segact ipt1
  223. NBMODE = ipt1.num(/2)
  224. segdes ipt1
  225. NELRIG = NBMODE
  226. SEGINI xMATRI
  227. IRIGEL(4,1) = xMATRI
  228. NLIGRP=1
  229. NLIGRD=1
  230.  
  231.  
  232. IM = 0
  233. IMA = 0
  234. 50 CONTINUE
  235. IM = IM + 1
  236. itmod = mtabiv(im)
  237. typret = mtabtv(im)
  238. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  239. * SEGINI XMATRI
  240. IMA = IMA + 1
  241. * IMATTT(IMA) = XMATRI
  242. ITAB2=itmod
  243. IF (IRIG.EQ.1) THEN
  244. CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  245. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  246. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  247. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  248. if (ierr.ne.0) return
  249. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  250. re(1,1,ima) = x1
  251. ELSE IF (IRIG.EQ.2) THEN
  252. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  253. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  254. CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  255. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  256. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  257. if (ierr.ne.0) return
  258. RE(1,1,ima) = x1
  259. ELSE
  260. MTYMAT = 'AMORMODA'
  261. ENDIF
  262. * segdes xmatri
  263. ENDIF
  264.  
  265. if (im.lt.mlotab) goto 50
  266. segdes xmatri
  267. *
  268. if (mrimod.gt.0) then
  269. call fusrig(mrimod,mrista,mrigid)
  270. else
  271. goto 79
  272. endif
  273. if (irig.gt.2) goto 79
  274.  
  275. mridec = mrigid
  276. mrigid = mrimod
  277. ri1 = mrimod
  278. ri2 = mrista
  279. segact ri1,ri2
  280. ipt1 = ri1.irigel(1,1)
  281. ipt2 = ri2.irigel(1,1)
  282. segdes ri1,ri2
  283.  
  284. segact ipt1,ipt2
  285.  
  286. NRIGE = 8
  287. NRIGEL = 2
  288. * hypothèse modes vib bloqués - pour la rigidite inutile de les coupler
  289. if (irig.eq.2) nrigel = 1
  290. * il faut suffisamment de modes statiques
  291. if (ipt2.num(/2).eq.1) nrigel = 1
  292. SEGINI MRIGID
  293. * write (6,*) ' ini mrigid ',mrigid,nrigel
  294. mricou = mrigid
  295. IF (IRIG.EQ.1) THEN
  296. MTYMAT = 'MASSE '
  297. ELSE IF (IRIG.EQ.2) THEN
  298. MTYMAT = 'RIGIDITE'
  299. ELSE
  300. MTYMAT = 'AMORMODA'
  301. ENDIF
  302. IFORIG = IFOMOD
  303. COERIG(1) = 1.D0
  304. if (nrigel.gt.1) COERIG(2) = 1.D0
  305. IMGEO1 = 0
  306. IMGEO2 = 0
  307. ICHOLE = 0
  308. ISUPEQ = 0
  309. *
  310. IRIGEL(2,1) = 0
  311. IRIGEL(5,1) = NIFOUR
  312. IRIGEL(6,1) = 0
  313. if (nrigel.gt.1) IRIGEL(2,2) = 0
  314. if (nrigel.gt.1) IRIGEL(5,2) = NIFOUR
  315. if (nrigel.gt.1) IRIGEL(6,2) = 0
  316.  
  317. * hypothèse mod vib bloques
  318. if (irig.eq.2) goto 64
  319. NBELEM = ipt1.num(/2) * ipt2.num(/2)
  320. NBNN = 2
  321. NBSOUS = 0
  322. NBREF = 0
  323. SEGINI MELEME
  324. ITYPEL=27
  325. NELRIG=NBELEM
  326. NLIGRP=2
  327. NLIGRD=2
  328. SEGINI xMATRI
  329. SEGINI DESCR
  330. NOELEP(1)=1
  331. NOELEP(2)=2
  332. NOELED(1)=1
  333. NOELED(2)=2
  334. LISINC(1)='ALFA'
  335. LISINC(2)='BETA'
  336. LISDUA(1)='FALF'
  337. LISDUA(2)='FBET'
  338. SEGDES DESCR
  339. irigel(1,1) = meleme
  340. irigel(3,1) = descr
  341. IRIGEL(4,1) = xMATRI
  342.  
  343. 64 if (ipt2.num(/2).le.1) goto 61
  344. nbelem = ipt2.num(/2)*(ipt2.num(/2) - 1) / 2
  345. NBNN = 2
  346. NBSOUS = 0
  347. NBREF = 0
  348. SEGINI MELEME
  349. ITYPEL=27
  350. NELRIG=NBELEM
  351. NLIGRP=2
  352. NLIGRD=2
  353. SEGINI xMATRI
  354. SEGINI DESCR
  355. NOELEP(1)=1
  356. NOELEP(2)=2
  357. NOELED(1)=1
  358. NOELED(2)=2
  359. LISINC(1)='BETA'
  360. LISINC(2)='BETA'
  361. LISDUA(1)='FBET'
  362. LISDUA(2)='FBET'
  363. SEGDES DESCR
  364. irigel(1,nrigel) = meleme
  365. irigel(3,nrigel) = descr
  366. IRIGEL(4,nrigel) = xMATRI
  367.  
  368. 61 continue
  369. * distingue les kas couplage mode_vib/mod_stat et couplage mode_stat/mode_stat
  370. kas = 1
  371. iima = ipt1.num(/2)
  372. * hypothese mod vib bloques
  373. if (irig.eq.2) then
  374. kas = kas + 1
  375. iima = ipt2.num(/2) - 1
  376. endif
  377. meleme = irigel(1,1)
  378. xmatri = irigel(4,1)
  379. segact meleme*mod,xmatri*mod
  380. 62 continue
  381. kelem = 0
  382. do ii = 1, iima
  383. IF (IRIG.EQ.1) THEN
  384. IF (kas.EQ.1) THEN
  385. CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  386. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  387. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  388. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  389. ELSE IF (kas.EQ.2) THEN
  390. CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  391. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  392. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  393. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  394. ENDIF
  395. ELSE IF (IRIG.EQ.2) THEN
  396. IF (kas.EQ.1) THEN
  397. CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  398. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  399. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  400. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  401. ELSE IF (kas.EQ.2) THEN
  402. CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  403. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  404. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  405. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  406. ENDIF
  407.  
  408. ELSE IF (IRIG.EQ.3) THEN
  409. *
  410. ENDIF
  411. * write(6,*) 'gk' , num(/1),num(/2), ii,kelem,kas
  412. if (kas.eq.1) then
  413. jjin = 1
  414. elseif (kas.eq.2) then
  415. jjin = ii + 1
  416. endif
  417.  
  418. do jj = jjin,ipt2.num(/2)
  419. kelem = kelem +1
  420. * write(6,*) 'jh' , kelem ,num(/2),ipt2.num(/2),jj
  421. if (kas.eq.1) then
  422. num(1,kelem) = ipt1.num(1,ii)
  423. elseif (kas.eq.2) then
  424. num(1,kelem) = ipt2.num(1,ii)
  425. endif
  426. num(2,kelem) = ipt2.num(1,jj)
  427. mtable = itbst
  428. segact mtable
  429. ima = 0
  430. im = 0
  431. 65 im = im + 1
  432. itab2 = mtabiv(im)
  433. typret = mtabtv(im)
  434. if (ITAB2.NE.0 .AND. TYPRET.EQ.'TABLE ') ima = ima + 1
  435. if (ima.ne.jj) goto 65
  436. * SEGINI XMATRI
  437. * IMATTT(kelem) = XMATRI
  438.  
  439. IF (IRIG.EQ.1) THEN
  440. CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  441. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  442. c t(mode ou sol_stat)*Masse*Sol_stat
  443. ELSE IF (IRIG.EQ.2) THEN
  444. CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  445. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  446. c t(mode ou sol_stat)* Reac(Sol_stat)
  447. ELSE
  448. c MTYMAT = 'AMORMODA'
  449. ENDIF
  450. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  451. re(2,1,kelem) = x1
  452. re(1,2,kelem) = re(2,1,kelem)
  453.  
  454. * segdes xmatri
  455. enddo
  456. enddo
  457.  
  458. segdes meleme,xmatri
  459. if (kas.eq.1.and.ipt2.num(/2).gt.1) then
  460. kas = kas + 1
  461. iima = ipt2.num(/2) - 1
  462. meleme = irigel(1,kas)
  463. xmatri = irigel(4,kas)
  464. goto 62
  465. endif
  466. continue
  467. segdes ipt1,ipt2
  468. mrigid=mridec
  469. * write (6,*) 'avant segact mridec ',mridec
  470. segact mrigid
  471. mrigid=mricou
  472. * write (6,*) 'avant segact mricou ',mricou
  473. segact mrigid
  474. call fusrig(mridec,mricou,mrigid)
  475.  
  476. 79 mlmots = idua
  477. mlmot1 = iinc
  478. segsup mlmots, mlmot1
  479.  
  480. 80 continue
  481. IRET = MRIGID
  482.  
  483. *
  484. END
  485.  
  486.  
  487.  
  488.  
  489.  

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