Télécharger rigtab.eso

Retour à la liste

Numérotation des lignes :

  1. C RIGTAB SOURCE CHAT 09/10/09 21:24:00 6519
  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. ELSE
  140. CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  141. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  142. OMEG = 2. * XPI * XFREQ
  143. RE(1,1,im) = XMGEN * OMEG * 2.
  144. ENDIF
  145. * SEGDES XMATRI
  146. 20 CONTINUE
  147.  
  148. SEGDES xMATRI
  149. *
  150. mrimod = mrigid
  151. SEGDES MRIGID
  152. if (itbst.eq.0) goto 80
  153.  
  154. 30 continue
  155. jgn = 4
  156. c jgm = 6
  157. segini mlmots
  158. iinc = mlmots
  159. do igm = 1,jgm
  160. mots(igm) = lesinc(igm)
  161. enddo
  162. segini mlmots
  163. idua = mlmots
  164. do igm= 1,jgm
  165. mots(igm) = lesdua(igm)
  166. enddo
  167.  
  168. if (itbas.ne.0) then
  169. segini,ri1=mrigid
  170. mrigid = ri1
  171. endif
  172. mrista = mrigid
  173.  
  174. NLIGRP = 1
  175. NLIGRD = 1
  176. SEGINI DESCR
  177. IRIGEL(3,1) = DESCR
  178. NOELEP(1) = 1
  179. NOELED(1) = 1
  180. LISINC(1) = 'BETA'
  181. LISDUA(1) = 'FBET'
  182. SEGDES DESCR
  183. *
  184.  
  185. mtable = itbst
  186. segact mtable
  187.  
  188. IM = 0
  189. IPT1 = 0
  190. 40 CONTINUE
  191. IM = IM + 1
  192. itmod = mtabiv(im)
  193. typret = mtabtv(im)
  194. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  195. CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  196. & 'POINT',I1,X1,' ',L1,IPTS)
  197. CALL CRELEM(IPTS)
  198. IF (IPT1.EQ.0) THEN
  199. IPT1 = IPTS
  200. ELSE
  201. IPT2 = IPTS
  202. ltelq=.false.
  203. CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  204. IF (IERR.NE.0) RETURN
  205. IPT1 = IMAIL
  206. ENDIF
  207. GOTO 40
  208. ENDIF
  209. if (im.lt.mlotab) goto 40
  210. IRIGEL(1,1) = IPT1
  211. if (ipt1.le.0) then
  212. interr(1) = 2
  213. if (mrigid.gt.0) segsup mrigid
  214. call erreur(974)
  215. return
  216. endif
  217.  
  218. segact ipt1
  219. NBMODE = ipt1.num(/2)
  220. segdes ipt1
  221. NELRIG = NBMODE
  222. SEGINI xMATRI
  223. IRIGEL(4,1) = xMATRI
  224. NLIGRP=1
  225. NLIGRD=1
  226.  
  227.  
  228. IM = 0
  229. IMA = 0
  230. 50 CONTINUE
  231. IM = IM + 1
  232. itmod = mtabiv(im)
  233. typret = mtabtv(im)
  234. IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  235. * SEGINI XMATRI
  236. IMA = IMA + 1
  237. * IMATTT(IMA) = XMATRI
  238. ITAB2=itmod
  239. IF (IRIG.EQ.1) THEN
  240. CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  241. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  242. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  243. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  244. if (ierr.ne.0) return
  245. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  246. re(1,1,ima) = x1
  247. ELSE IF (IRIG.EQ.2) THEN
  248. CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  249. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  250. CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  251. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  252. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  253. if (ierr.ne.0) return
  254. RE(1,1,ima) = x1
  255. ELSE
  256. MTYMAT = 'AMORMODA'
  257. ENDIF
  258. * segdes xmatri
  259. ENDIF
  260.  
  261. if (im.lt.mlotab) goto 50
  262. segdes xmatri
  263. *
  264. if (mrimod.gt.0) then
  265. call fusrig(mrimod,mrista,mrigid)
  266. else
  267. goto 79
  268. endif
  269. if (irig.gt.2) goto 79
  270.  
  271. mridec = mrigid
  272. mrigid = mrimod
  273. ri1 = mrimod
  274. ri2 = mrista
  275. segact ri1,ri2
  276. ipt1 = ri1.irigel(1,1)
  277. ipt2 = ri2.irigel(1,1)
  278. segdes ri1,ri2
  279.  
  280. segact ipt1,ipt2
  281.  
  282. NRIGE = 8
  283. NRIGEL = 2
  284. * hypothèse modes vib bloqués - pour la rigidite inutile de les coupler
  285. if (irig.eq.2) nrigel = 1
  286. * il faut suffisamment de modes statiques
  287. if (ipt2.num(/2).eq.1) nrigel = 1
  288. SEGINI MRIGID
  289. * write (6,*) ' ini mrigid ',mrigid,nrigel
  290. mricou = mrigid
  291. IF (IRIG.EQ.1) THEN
  292. MTYMAT = 'MASSE '
  293. ELSE IF (IRIG.EQ.2) THEN
  294. MTYMAT = 'RIGIDITE'
  295. ELSE
  296. MTYMAT = 'AMORMODA'
  297. ENDIF
  298. IFORIG = IFOMOD
  299. COERIG(1) = 1.D0
  300. if (nrigel.gt.1) COERIG(2) = 1.D0
  301. IMGEO1 = 0
  302. IMGEO2 = 0
  303. ICHOLE = 0
  304. ISUPEQ = 0
  305. *
  306. IRIGEL(2,1) = 0
  307. IRIGEL(5,1) = NIFOUR
  308. IRIGEL(6,1) = 0
  309. if (nrigel.gt.1) IRIGEL(2,2) = 0
  310. if (nrigel.gt.1) IRIGEL(5,2) = NIFOUR
  311. if (nrigel.gt.1) IRIGEL(6,2) = 0
  312.  
  313. * hypothèse mod vib bloques
  314. if (irig.eq.2) goto 64
  315. NBELEM = ipt1.num(/2) * ipt2.num(/2)
  316. NBNN = 2
  317. NBSOUS = 0
  318. NBREF = 0
  319. SEGINI MELEME
  320. ITYPEL=27
  321. NELRIG=NBELEM
  322. NLIGRP=2
  323. NLIGRD=2
  324. SEGINI xMATRI
  325. SEGINI DESCR
  326. NOELEP(1)=1
  327. NOELEP(2)=2
  328. NOELED(1)=1
  329. NOELED(2)=2
  330. LISINC(1)='ALFA'
  331. LISINC(2)='BETA'
  332. LISDUA(1)='FALF'
  333. LISDUA(2)='FBET'
  334. SEGDES DESCR
  335. irigel(1,1) = meleme
  336. irigel(3,1) = descr
  337. IRIGEL(4,1) = xMATRI
  338.  
  339. 64 if (ipt2.num(/2).le.1) goto 61
  340. nbelem = ipt2.num(/2)*(ipt2.num(/2) - 1) / 2
  341. NBNN = 2
  342. NBSOUS = 0
  343. NBREF = 0
  344. SEGINI MELEME
  345. ITYPEL=27
  346. NELRIG=NBELEM
  347. NLIGRP=2
  348. NLIGRD=2
  349. SEGINI xMATRI
  350. SEGINI DESCR
  351. NOELEP(1)=1
  352. NOELEP(2)=2
  353. NOELED(1)=1
  354. NOELED(2)=2
  355. LISINC(1)='BETA'
  356. LISINC(2)='BETA'
  357. LISDUA(1)='FBET'
  358. LISDUA(2)='FBET'
  359. SEGDES DESCR
  360. irigel(1,nrigel) = meleme
  361. irigel(3,nrigel) = descr
  362. IRIGEL(4,nrigel) = xMATRI
  363.  
  364. 61 continue
  365. * distingue les kas couplage mode_vib/mod_stat et couplage mode_stat/mode_stat
  366. kas = 1
  367. iima = ipt1.num(/2)
  368. * hypothese mod vib bloques
  369. if (irig.eq.2) then
  370. kas = kas + 1
  371. iima = ipt2.num(/2) - 1
  372. endif
  373. meleme = irigel(1,1)
  374. xmatri = irigel(4,1)
  375. segact meleme*mod,xmatri*mod
  376. 62 continue
  377. kelem = 0
  378. do ii = 1, iima
  379. IF (IRIG.EQ.1) THEN
  380. IF (kas.EQ.1) THEN
  381. CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  382. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  383. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  384. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  385. ELSE IF (kas.EQ.2) THEN
  386. CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  387. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  388. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  389. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  390. ENDIF
  391. ELSE IF (IRIG.EQ.2) THEN
  392. IF (kas.EQ.1) THEN
  393. CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  394. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  395. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  396. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  397. ELSE IF (kas.EQ.2) THEN
  398. CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  399. & TYPRET,I1,X1,CHARRE,L1,ITMOD)
  400. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  401. & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  402. ENDIF
  403.  
  404. ELSE IF (IRIG.EQ.3) THEN
  405. *
  406. ENDIF
  407. * write(6,*) 'gk' , num(/1),num(/2), ii,kelem,kas
  408. if (kas.eq.1) then
  409. jjin = 1
  410. elseif (kas.eq.2) then
  411. jjin = ii + 1
  412. endif
  413.  
  414. do jj = jjin,ipt2.num(/2)
  415. kelem = kelem +1
  416. * write(6,*) 'jh' , kelem ,num(/2),ipt2.num(/2),jj
  417. if (kas.eq.1) then
  418. num(1,kelem) = ipt1.num(1,ii)
  419. elseif (kas.eq.2) then
  420. num(1,kelem) = ipt2.num(1,ii)
  421. endif
  422. num(2,kelem) = ipt2.num(1,jj)
  423. mtable = itbst
  424. segact mtable
  425. ima = 0
  426. im = 0
  427. 65 im = im + 1
  428. itab2 = mtabiv(im)
  429. typret = mtabtv(im)
  430. if (ITAB2.NE.0 .AND. TYPRET.EQ.'TABLE ') ima = ima + 1
  431. if (ima.ne.jj) goto 65
  432. * SEGINI XMATRI
  433. * IMATTT(kelem) = XMATRI
  434.  
  435. IF (IRIG.EQ.1) THEN
  436. CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  437. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  438. c t(mode ou sol_stat)*Masse*Sol_stat
  439. ELSE IF (IRIG.EQ.2) THEN
  440. CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  441. & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
  442. c t(mode ou sol_stat)* Reac(Sol_stat)
  443. ELSE
  444. c MTYMAT = 'AMORMODA'
  445. ENDIF
  446. CALL XTY1(itdepl,itreac,iinc,idua,X1)
  447. re(2,1,kelem) = x1
  448. re(1,2,kelem) = re(2,1,kelem)
  449.  
  450. * segdes xmatri
  451. enddo
  452. enddo
  453.  
  454. segdes meleme,xmatri
  455. if (kas.eq.1.and.ipt2.num(/2).gt.1) then
  456. kas = kas + 1
  457. iima = ipt2.num(/2) - 1
  458. meleme = irigel(1,kas)
  459. xmatri = irigel(4,kas)
  460. goto 62
  461. endif
  462. continue
  463. segdes ipt1,ipt2
  464. mrigid=mridec
  465. * write (6,*) 'avant segact mridec ',mridec
  466. segact mrigid
  467. mrigid=mricou
  468. * write (6,*) 'avant segact mricou ',mricou
  469. segact mrigid
  470. call fusrig(mridec,mricou,mrigid)
  471.  
  472. 79 mlmots = idua
  473. mlmot1 = iinc
  474. segsup mlmots, mlmot1
  475.  
  476. 80 continue
  477. IRET = MRIGID
  478.  
  479. *
  480. END
  481.  
  482.  
  483.  
  484.  

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