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

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