Télécharger psmo.eso

Retour à la liste

Numérotation des lignes :

  1. C PSMO SOURCE CB215821 19/07/30 21:17:48 10273
  2. SUBROUTINE PSMO
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * P S M O
  8. * -------
  9. *
  10. * Sous-programme associ{ @ l'op{rateur "PSMO"
  11. *
  12. * FONCTION:
  13. * ---------
  14. *
  15. * L'op{rateur "PSMO" calcule les pseudo-modes en d{placement.
  16. *
  17. * PHRASE D'APPEL (EN GIBIANE):
  18. * ----------------------------
  19. *
  20. * SOLS = 'PSMO' RIG (MAS) MOD1 (TPODI) (CHP1 OU LCHP1)
  21. * (SEISME (UX) (UY) (UZ)) (FREQ XFREQ) ;
  22. *
  23. * OPERANDES ET RESULTATS:
  24. * -----------------------
  25. *
  26. * RIG 'RIGIDITE' matrice de rigidit{ de la structure.
  27. * MAS 'RIGIDITE' matrice de masse de la structure.
  28. * MOD1 'TABLE ' modes de la structure.
  29. * TPODI 'TABLE ' table de sous-type POINTS_DE_LIAISON, donnant
  30. * les point et normale de chaque choc.
  31. * CHP1 'CHPOINT ' description spatiale des chargements ou des
  32. * supports.
  33. * LCHP1 'LISTCHPO' description spatiale des chargements ou des
  34. * supports.
  35. * SEISME 'MOT ' mot cl{, indique que :
  36. * - soit la structure est soumise @
  37. * une acc{l{ration sismique d'ensemble.
  38. * - soit la structure est multisupport{e
  39. * avec un d{placement impos{ des supoorts.
  40. * UX 'MOT ' mot cl{, direction de l'excitation sismique
  41. * suivant X.
  42. * UY 'MOT ' mot cl{, direction de l'excitation sismique
  43. * suivant Y.
  44. * UZ 'MOT ' mot cl{, direction de l'excitation sismique
  45. * suivant Z.
  46. * FREQ 'MOT ' mot cl{, indique dans le cas ou la structure a
  47. * des modes de corps solide que l'utilisateur
  48. * veut imposer la fr{quence @ laquelle on
  49. * {tudiera la r{ponse de la structure.
  50. * XFREQ 'FLOTTANT' valeur de cette fr{quence.
  51. * SOLS 'TABLE ' objet TABLE de sous-type 'PSEUDO_MODE'
  52. * contenant les pseudo-modes.
  53. *
  54. * MODULES UTILISES:
  55. * -----------------
  56. *
  57. -INC CCOPTIO
  58. -INC CCREEL
  59. *-
  60. -INC SMRIGID
  61. -INC SMATTAC
  62. -INC SMCHPOI
  63. -INC SMELEME
  64. -INC SMLCHPO
  65. -INC SMSOLUT
  66. -INC SMSTRUC
  67. *
  68. * VARIABLES:
  69. * ----------
  70. *
  71. * DIR : direction de l'excitation sismique.
  72. * DIRECT(3) : tableau contenant les directions sismiques donn{es.
  73. * CORSOL = .TRUE. : la structure a des modes de corps solide.
  74. * SISMIQ = .TRUE. : excitation sismique.
  75. * FORCON = .TRUE. : force concentr{e.
  76. * STRUCM = .TRUE. : structure multisupport{e.
  77. *
  78. PARAMETER (LSEIS=3,LOPT1=1,LOPT2=1)
  79. CHARACTER*2 NSEISM(LSEIS),DIRECT(3),DIR
  80. CHARACTER*4 NOPTI1(LOPT1),COMP
  81. CHARACTER*6 NOPTI2(LOPT2)
  82. CHARACTER*8 TYPRET,CTYP,CHARRE
  83. CHARACTER*40 CMOT,MONMOT
  84. LOGICAL CORSOL,SISMIQ,FORCON,STRUCM,L0,L1
  85. *
  86. *
  87. * AUTEUR, DATE DE CREATION:
  88. * -------------------------
  89. *
  90. * Lionel VIVAN Juillet 1988
  91. *
  92. ************************************************************************
  93. *
  94. SEGMENT MTRAV
  95. REAL*8 FREQ(NBMODE),MN(NBMODE),MW2(NBMODE),
  96. & QX(NBMODE),QY(NBMODE),QZ(NBMODE)
  97. INTEGER DEPL(NBMODE)
  98. ENDSEGMENT
  99. *
  100. DATA NOPTI1/'FREQ'/
  101. DATA NOPTI2/'SEISME'/
  102. DATA NSEISM/'UX','UY','UZ'/
  103. CORSOL = .FALSE.
  104. SISMIQ = .FALSE.
  105. FORCON = .FALSE.
  106. STRUCM = .FALSE.
  107. DEUXPI = 2.D0 * XPI
  108. EPSI = 0.00001
  109. XFREQ = 0.D0
  110. NBCHP = 0
  111. LCH1 = 0
  112. ICH1 = 0
  113. IAT1 = 0
  114. DO 8 I =1,3
  115. DIRECT(I) = ' '
  116. 8 CONTINUE
  117. *
  118. * lecture des donn{es
  119. *
  120. CALL LIRMOT(NOPTI1,LOPT1,IMOT,0)
  121. IF (IMOT .EQ. 1) THEN
  122. CALL LIRREE(XFREQ,1,IRETOU)
  123. IF (XFREQ .LE. 0.D0) THEN
  124. CALL ERREUR(21)
  125. RETURN
  126. ENDIF
  127. CORSOL = .TRUE.
  128. ENDIF
  129. *
  130. CALL LIRMOT(NOPTI2,LOPT2,IMOT,0)
  131. IF (IMOT .EQ. 1) THEN
  132. SISMIQ = .TRUE.
  133. I = 0
  134. 10 CONTINUE
  135. CALL LIRMOT(NSEISM,LSEIS,IMOT,0)
  136. IF (IMOT .NE. 0) THEN
  137. IF (I .LE. 3) THEN
  138. I = I + 1
  139. DIRECT(I) = NSEISM(IMOT)
  140. GOTO 10
  141. ELSE
  142. CALL ERREUR(21)
  143. RETURN
  144. ENDIF
  145. ENDIF
  146. ENDIF
  147. *
  148. CALL QUETYP(CTYP,1,IRETOU)
  149. IF (CTYP(1:8).EQ.'RIGIDITE') GOTO 2000
  150. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*
  151. * version appel{e @ disparaitre
  152. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*
  153. CALL LIROBJ('STRUCTUR',ISTR,1,IRETOU)
  154. IF (IERR .NE. 0) RETURN
  155. *
  156. CALL LIROBJ('SOLUTION',IMOD,1,IRETOU)
  157. IF (IERR .NE. 0) RETURN
  158. *
  159. CALL LIROBJ('ATTACHE ',IATT,0,IRETOU)
  160. IF (IRETOU .EQ. 1) THEN
  161. IAT1 = 1
  162. ENDIF
  163. *
  164. CALL LIROBJ('CHPOINT ',ICHPT,0,IRETOU)
  165. IF (IRETOU .EQ. 0) THEN
  166. CALL LIROBJ('LISTCHPO',LCHPT,0,IRETOU)
  167. IF (IRETOU .EQ. 1) THEN
  168. CALL ACTOBJ('LISTCHPO',LCHPT,1)
  169. LCH1 = 1
  170. ENDIF
  171. ELSE
  172. CALL ACTOBJ('CHPOINT ',ICHPT,1)
  173. ICH1 = 1
  174. ENDIF
  175. IF (ICH1 .EQ. 1) THEN
  176. CALL ECROBJ('CHPOINT ',ICHPT)
  177. CALL SUITE1
  178. IF(IERR.NE.0) RETURN
  179. CALL LIROBJ('LISTCHPO',LCHPT,1,IRETOU)
  180. CALL ACTOBJ('LISTCHPO',LCHPT,1)
  181. IF(IERR.NE.0) RETURN
  182. LCH1 = 1
  183. ENDIF
  184. *
  185. IF (LCH1 .EQ. 1) THEN
  186. IF ( SISMIQ ) THEN
  187. STRUCM = .TRUE.
  188. SISMIQ = .FALSE.
  189. ELSE
  190. FORCON = .TRUE.
  191. ENDIF
  192. CALL DIMEN2(LCHPT,NBCHP)
  193. IF (IERR.NE.0) RETURN
  194. ENDIF
  195. *
  196. * RECUPERATION DE LA MATRICE K ET DE LA MATRICE M
  197. *
  198. CALL EXTR10(ISTR,'RIGI',IRAI1)
  199. IF (IERR.NE.0) RETURN
  200. CALL EXTR10(ISTR,'MASS',IMAS1)
  201. IF (IERR.NE.0) RETURN
  202. *
  203. * REMPLISSAGE DE MTRAV
  204. *
  205. MSOLUT = IMOD
  206. SEGACT MSOLUT
  207. MSOLEN = MSOLIS(4)
  208. SEGACT MSOLEN
  209. NBMODE = ISOLEN(/1)
  210. *
  211. SEGINI MTRAV
  212. *
  213. DO 1940 I = 1,NBMODE
  214. FREQ(I) = XZERO
  215. MN(I) = XZERO
  216. MW2(I) = XZERO
  217. QX(I) = XZERO
  218. QY(I) = XZERO
  219. QZ(I) = XZERO
  220. DEPL(I) = 0
  221. 1940 CONTINUE
  222. *
  223. DO 1950 IM = 1,NBMODE
  224. MMODE = ISOLEN(IM)
  225. SEGACT MMODE
  226. XF = FMMODD(1)
  227. XMN = FMMODD(2)
  228. W2 = ( DEUXPI * XF ) ** 2
  229. FREQ(IM) = XF
  230. MN(IM) = XMN
  231. MW2(IM) = XMN * W2
  232. QX(IM) = FMMODD(3)
  233. QY(IM) = FMMODD(4)
  234. QZ(IM) = FMMODD(5)
  235. SEGDES MMODE
  236. 1950 CONTINUE
  237. SEGDES MSOLEN
  238. *
  239. MSOLEN = MSOLIS(5)
  240. SEGACT MSOLEN
  241. DO 1960 ID = 1,NBMODE
  242. DEPL(ID) = ISOLEN(ID)
  243. 1960 CONTINUE
  244. SEGDES MSOLEN
  245. *
  246. SEGDES MSOLUT
  247. *
  248. * CAS DES MODES DE CORPS SOLIDE
  249. * RECHERCHE DE FREQUENCE(S) NULLE(S) DANS L'OBJET SOLUTION
  250. *
  251. XF1 = 0.D0
  252. DO 1972 I = 1,NBMODE
  253. XFI = FREQ(I)
  254. IF (XFI .LT. EPSI) THEN
  255. CORSOL = .TRUE.
  256. ELSE
  257. IF (XF1 .EQ. 0.D0) XF1 =XFI
  258. ENDIF
  259. 1972 CONTINUE
  260. *
  261. IF ( CORSOL ) THEN
  262. IF (XFREQ .EQ. 0.D0) THEN
  263. * RECHERCHE DE LA 1-ERE FREQUENCE NON NULLE
  264. DO 1974 I = 1,NBMODE
  265. XFI = FREQ(I)
  266. IF ((XFI .LT. XF1) .AND.(XFI .GE. EPSI))THEN
  267. XF1 = XFI
  268. ENDIF
  269. 1974 CONTINUE
  270. XFREQ = XF1 / 2.D0
  271. ENDIF
  272. *
  273. IF ( IIMPI .GT. 0 ) THEN
  274. WRITE (IOIMP,998) ( FREQ(I),I=1,NBMODE)
  275. 998 FORMAT (/1X,'SBR PSMO LISTE DES FREQ ',/1X,10(E12.5,1X))
  276. WRITE ( IOIMP, 1002 ) XFREQ
  277. 1002 FORMAT ( /1X, 'SBR PSMO CORPS SOLIDES 1ERE FREQ*0.5 N.NUL'
  278. C ,' OU FREQ IMPO ',E12.5 )
  279. ENDIF
  280. W2 = (DEUXPI * XFREQ) ** 2
  281. CALL DECALE(IRAI1,IMAS1,W2,IRAID)
  282. IF (IERR.NE.0) RETURN
  283. *
  284. DO 19100 IM = 1,NBMODE
  285. W2I = ( DEUXPI * FREQ(IM) ) ** 2
  286. MW2(IM) = MN(IM) * ( W2I - W2 )
  287. 19100 CONTINUE
  288. *
  289. ELSE
  290. IRAID = IRAI1
  291. ENDIF
  292. *
  293. SEGDES MTRAV
  294. *
  295. NUME = NBMODE
  296. NBMOD1 = NBMODE + 1
  297. XFRST = 0.D0
  298. XMNST = 0.D0
  299. XQ1 = 0.D0
  300. XQ2 = 0.D0
  301. XQ3 = 0.D0
  302. ICHE1 = 0
  303. *
  304. * CAS DE L'ACCELERATION SISMIQUE D'ENSEMBLE
  305. *
  306. IF ( SISMIQ ) THEN
  307. CALL ECRCHA('MAIL')
  308. CALL ECROBJ('RIGIDITE',IRAID)
  309. CALL EXTRAI
  310. IF (IERR.NE.0) RETURN
  311. CALL LIROBJ('MAILLAGE',IMAIL,1,IRETOU)
  312. IF (IERR.NE.0) RETURN
  313. DO 1980 ID = 1,3
  314. DIR = DIRECT(ID)
  315. IF (DIR .NE. ' ') THEN
  316. CALL PSACCE(IRAID,IMAS1,IMAIL,MTRAV,DIR,ICHP1)
  317. N = 0
  318. SEGINI MJONCT
  319. IJONCT = MJONCT
  320. MJODDL = DIR
  321. MJOTYP = 'SEIS'
  322. MJOPOI = 0
  323. SEGDES MJONCT
  324. MCHPOI = ICHP1
  325. SEGACT MCHPOI
  326. IF (DIR .EQ. 'UX') THEN
  327. MOCHDE = 'EMSISEISMEX'
  328. ELSE IF (DIR .EQ. 'UY') THEN
  329. MOCHDE = 'EMSISEISMEY'
  330. ELSE
  331. MOCHDE = 'EMSISEISMEZ'
  332. ENDIF
  333. SEGDES MCHPOI
  334. NUME = NUME + 1
  335. IF (NUME .EQ. NBMOD1) THEN
  336. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  337. & ICHP1,ICHE1,IJONCT,ISOLS)
  338. ELSE
  339. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  340. & ICHP1,ICHE1,IJONCT,ISOL1)
  341. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  342. IF (IERR.NE.0) RETURN
  343. CALL DESOLU(ISOLS)
  344. IF (IERR.NE.0) RETURN
  345. CALL DESOLU(ISOL1)
  346. IF (IERR.NE.0) RETURN
  347. ISOLS = ISOL2
  348. ENDIF
  349. ENDIF
  350. 1980 CONTINUE
  351. ENDIF
  352. *
  353. * CAS DES FORCES CONCENTREES OU DE CHOCS
  354. *
  355. IF ( FORCON ) THEN
  356. DO 1920 IC = 1,NBCHP
  357. CALL EXTRA4(LCHPT,IC,ICHPT)
  358. IF (IERR.NE.0) RETURN
  359. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'FORC',ICHP1)
  360. N = 1
  361. SEGINI MJONCT
  362. IJONCT = MJONCT
  363. MJODDL = ' '
  364. MJOTYP = 'FORC'
  365. MJOPOI = 0
  366. IPCHJO(1) = ICHPT
  367. ISTRJO(1) = 0
  368. IPOSJO(1) = 0
  369. SEGDES MJONCT
  370. MCHPOI = ICHP1
  371. SEGACT MCHPOI
  372. MOCHDE = 'EMSIFORCECONCENTREE'
  373. SEGDES MCHPOI
  374. NUME = NUME + 1
  375. IF (NUME .EQ. NBMOD1) THEN
  376. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  377. & ICHP1,ICHE1,IJONCT,ISOLS)
  378. ELSE
  379. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  380. & ICHP1,ICHE1,IJONCT,ISOL1)
  381. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  382. IF (IERR.NE.0) RETURN
  383. CALL DESOLU(ISOLS)
  384. IF (IERR.NE.0) RETURN
  385. CALL DESOLU(ISOL1)
  386. IF (IERR.NE.0) RETURN
  387. ISOLS = ISOL2
  388. ENDIF
  389. 1920 CONTINUE
  390. ENDIF
  391. *
  392. * CAS DES FORCES DE CHOC
  393. *
  394. IF (IAT1 .EQ. 1) THEN
  395. MATTAC = IATT
  396. SEGACT MATTAC
  397. NSOUMA = LISATT(/1)
  398. DO 1932 IS =1,NSOUMA
  399. MSOUMA = LISATT(IS)
  400. SEGACT MSOUMA
  401. IF (ITYATT .NE. 'CHOC') THEN
  402. SEGDES MSOUMA
  403. GOTO 1932
  404. ENDIF
  405. MGEOCH = IGEOCH
  406. SEGACT MGEOCH
  407. MELEME = INORCH(1)
  408. SEGDES MGEOCH
  409. SEGACT MELEME
  410. NORM = NUM(1,1)
  411. SEGDES MELEME
  412. NJONCT = IATREL(/1)
  413. DO 1934 IJ =1,NJONCT
  414. MJONCT = IATREL(IJ)
  415. SEGACT MJONCT
  416. DO 1936 IJ2 = 1,2
  417. ISTR = ISTRJO(IJ2)
  418. IF (ISTR.NE.0) THEN
  419. MCHPOI = IPCHJO(IJ2)
  420. SEGACT MCHPOI
  421. MSOUPO = IPCHP(1)
  422. SEGDES MCHPOI
  423. SEGACT MSOUPO
  424. MELEME = IGEOC
  425. SEGDES MSOUPO
  426. SEGACT MELEME
  427. IPT = NUM(1,IJ2)
  428. SEGDES MELEME
  429. *
  430. CALL PSCHOC(IRAID,MTRAV,IPT,NORM,IJ2, ICHP1)
  431. N = 1
  432. SEGINI MJONC1
  433. IJONCT = MJONC1
  434. MJONC1.MJODDL = ' '
  435. MJONC1.MJOTYP = 'CHOC'
  436. MJONC1.MJOPOI = IPT
  437. MJONC1.IPCHJO(1) = 0
  438. MJONC1.ISTRJO(1) = ISTR
  439. MJONC1.IPOSJO(1) = 0
  440. SEGDES MJONC1
  441. *
  442. MCHPOI = ICHP1
  443. SEGACT MCHPOI
  444. MOCHDE = 'EMSIFORCEDECHOC'
  445. SEGDES MCHPOI
  446. *
  447. NUME = NUME + 1
  448. IF (NUME .EQ. NBMOD1) THEN
  449. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,
  450. & XQ2,XQ3,ICHP1,ICHE1,IJONCT,ISOLS)
  451. ELSE
  452. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,
  453. & XQ2,XQ3,ICHP1,ICHE1,IJONCT,ISOL1)
  454. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  455. IF (IERR.NE.0) RETURN
  456. CALL DESOLU(ISOLS)
  457. IF (IERR.NE.0) RETURN
  458. CALL DESOLU(ISOL1)
  459. IF (IERR.NE.0) RETURN
  460. ISOLS = ISOL2
  461. ENDIF
  462. ENDIF
  463. 1936 CONTINUE
  464. SEGDES MJONCT
  465. 1934 CONTINUE
  466. SEGDES MSOUMA
  467. 1932 CONTINUE
  468. SEGDES MATTAC
  469. ENDIF
  470. *
  471. * CAS DES STRUCTURES MULTISUPPORTEES
  472. *
  473. IF ( STRUCM ) THEN
  474. DO 1942 IC = 1,NBCHP
  475. CALL EXTRA4(LCHPT,IC,ICHPT)
  476. IF (IERR.NE.0) RETURN
  477. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'DEPL',ICHP1)
  478. N = 1
  479. SEGINI MJONCT
  480. IJONCT = MJONCT
  481. MJODDL = ' '
  482. MJOTYP = 'DEPL'
  483. MJOPOI = 0
  484. IPCHJO(1) = ICHPT
  485. ISTRJO(1) = 0
  486. IPOSJO(1) = 0
  487. SEGDES MJONCT
  488. MCHPOI = ICHP1
  489. SEGACT MCHPOI
  490. MOCHDE = 'EMSISTRUCTUREMULTISUPPORTEE'
  491. SEGDES MCHPOI
  492. NUME = NUME + 1
  493. IF (NUME .EQ. NBMOD1) THEN
  494. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  495. & ICHP1,ICHE1,IJONCT,ISOLS)
  496. ELSE
  497. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  498. & ICHP1,ICHE1,IJONCT,ISOL1)
  499. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  500. IF (IERR.NE.0) RETURN
  501. CALL DESOLU(ISOLS)
  502. IF (IERR.NE.0) RETURN
  503. CALL DESOLU(ISOL1)
  504. IF (IERR.NE.0) RETURN
  505. ISOLS = ISOL2
  506. ENDIF
  507. 1942 CONTINUE
  508. ENDIF
  509. *
  510. SEGSUP MTRAV
  511. *
  512. CALL ECROBJ('SOLUTION',ISOLS)
  513. *
  514. RETURN
  515. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*++*+*+*
  516. * nouvelle version
  517. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*++*+*+*
  518. 2000 CONTINUE
  519. IRAI1 = 0
  520. IMAS1 = 0
  521. 1 CALL LIROBJ('RIGIDITE',IRET,0,IRETOU)
  522. IF (IRETOU.NE.0) THEN
  523. MRIGID = IRET
  524. SEGACT,MRIGID
  525. IF (MTYMAT.EQ.'RIGIDITE') THEN
  526. IF (IRAI1.NE.0) THEN
  527. MOTERR(1:8)='RIGIDITE'
  528. MOTERR(9:16)='RIGIDITE'
  529. CALL ERREUR(130)
  530. * la matrice de rigidite a d{ja {t{ donn{e
  531. SEGDES,MRIGID
  532. RETURN
  533. ENDIF
  534. IRAI1 = MRIGID
  535. SEGDES,MRIGID
  536. IF (IMAS1.EQ.0) GOTO 1
  537. ELSE IF (MTYMAT.EQ.'MASSE') THEN
  538. IF (IMAS1.NE.0) THEN
  539. MOTERR(1:8)='RIGIDITE'
  540. MOTERR(9:16)='MASSE'
  541. CALL ERREUR(130)
  542. * la matrice de masse a d{ja {t{ donn{e
  543. SEGDES,MRIGID
  544. RETURN
  545. ENDIF
  546. IMAS1 = MRIGID
  547. SEGDES,MRIGID
  548. IF (IRAI1.EQ.0) GOTO 1
  549. ELSE
  550. MOTERR(1:8) = 'RIGIDITE'
  551. MOTERR(9:16) = MTYMAT
  552. CALL ERREUR(131)
  553. * on n'attend pas ce sous type de rigidit{
  554. SEGDES,MRIGID
  555. RETURN
  556. ENDIF
  557. ENDIF
  558. *
  559. CALL LIRTAB('BASE_DE_MODES',ITMOD,1,IRET)
  560. IF (IERR .NE. 0) RETURN
  561. *
  562. CALL LIRTAB('POINT_DE_LIAISON',ITLIA,0,IRETOU)
  563. IF (IRETOU .EQ. 1) THEN
  564. IAT1 = 1
  565. ENDIF
  566. *
  567. CALL LIROBJ('CHPOINT ',ICHPT,0,IRETOU)
  568. IF (IRETOU .EQ. 0) THEN
  569. CALL LIROBJ('LISTCHPO',LCHPT,0,IRETOU)
  570. IF (IRETOU .EQ. 1) THEN
  571. CALL ACTOBJ('LISTCHPO',LCHPT,1)
  572. LCH1 = 1
  573. ENDIF
  574. ELSE
  575. CALL ACTOBJ('CHPOINT ',ICHPT,1)
  576. ICH1 = 1
  577. ENDIF
  578. IF (ICH1 .EQ. 1) THEN
  579. CALL ECROBJ('CHPOINT ',ICHPT)
  580. CALL SUITE1
  581. IF(IERR.NE.0) RETURN
  582. CALL LIROBJ('LISTCHPO',LCHPT,1,IRETOU)
  583. CALL ACTOBJ('LISTCHPO',LCHPT,1)
  584. IF(IERR.NE.0) RETURN
  585. LCH1 = 1
  586. ENDIF
  587. *
  588. IF (LCH1 .EQ. 1) THEN
  589. IF ( SISMIQ ) THEN
  590. STRUCM = .TRUE.
  591. SISMIQ = .FALSE.
  592. ELSE
  593. FORCON = .TRUE.
  594. ENDIF
  595. CALL DIMEN2(LCHPT,NBCHP)
  596. IF (IERR.NE.0) RETURN
  597. ENDIF
  598. *
  599. * remplissage de MTRAV
  600. *
  601. CALL DIMEN7(ITMOD,NBMODE)
  602. NBMODE = NBMODE - 2
  603. *
  604. SEGINI MTRAV
  605. DO 50 IM = 1,NBMODE
  606. CALL ACCTAB(ITMOD,'ENTIER',IM,X0,' ',L0,IP0,
  607. & 'TABLE',I1,X1,' ',L1,ITMK)
  608. CALL ACCTAB(ITMK,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  609. & 'FLOTTANT',I1,XF,' ',L1,IP1)
  610. CALL ACCTAB(ITMK,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  611. & 'FLOTTANT',I1,XMN,' ',L1,IP1)
  612. CALL ACCTAB(ITMK,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',L0,IP0,
  613. & 'TABLE',I1,X1,' ',L1,ITDG)
  614. CALL ACCTAB(ITDG,'ENTIER',1,X0,' ',L0,IP0,
  615. & 'FLOTTANT',I1,XQX,' ',L1,IP1)
  616. CALL ACCTAB(ITDG,'ENTIER',2,X0,' ',L0,IP0,
  617. & 'FLOTTANT',I1,XQY,' ',L1,IP1)
  618. CALL ACCTAB(ITDG,'ENTIER',3,X0,' ',L0,IP0,
  619. & 'FLOTTANT',I1,XQZ,' ',L1,IP1)
  620. CALL ACCTAB(ITMK,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  621. & 'CHPOINT',I1,X1,' ',L1,ICHDM)
  622. W2 = ( DEUXPI * XF ) ** 2
  623. FREQ(IM) = XF
  624. MN(IM) = XMN
  625. MW2(IM) = XMN * W2
  626. QX(IM) = XQX
  627. QY(IM) = XQY
  628. QZ(IM) = XQZ
  629. DEPL(IM) = ICHDM
  630. 50 CONTINUE
  631. *
  632. * cas des modes de corps solide
  633. * recherche de fr{quence(s) nulle(s)
  634. *
  635. XF1 = 0.D0
  636. DO 72 I = 1,NBMODE
  637. XFI = FREQ(I)
  638. IF (XFI .LT. EPSI) THEN
  639. CORSOL = .TRUE.
  640. ELSE
  641. IF (XF1 .EQ. 0.D0) XF1 =XFI
  642. ENDIF
  643. 72 CONTINUE
  644. *
  645. IF ( CORSOL ) THEN
  646. IF (XFREQ .EQ. 0.D0) THEN
  647. * recherche de la 1-}re fr{quence non nulle
  648. DO 74 I = 1,NBMODE
  649. XFI = FREQ(I)
  650. IF ((XFI .LT. XF1) .AND.(XFI .GE. EPSI))THEN
  651. XF1 = XFI
  652. ENDIF
  653. 74 CONTINUE
  654. XFREQ = XF1 / 2.D0
  655. ENDIF
  656. *
  657. IF ( IIMPI .GT. 0 ) THEN
  658. WRITE (IOIMP,999) ( FREQ(I),I=1,NBMODE)
  659. 999 FORMAT (/1X,'SBR PSMO liste des freq ',/1X,10(E12.5,1X))
  660. WRITE ( IOIMP, 1000 ) XFREQ
  661. 1000 FORMAT ( /1X, 'SBR PSMO corps solides 1}re freq*0.5 n.nil'
  662. & ,' OU FREQ IMPO ',E12.5 )
  663. ENDIF
  664. W2 = (DEUXPI * XFREQ) ** 2
  665. IF (IMAS1.EQ.0) THEN
  666. MOTERR(1:8) = 'RIGIDITE'
  667. MOTERR(9:16) = 'MASSE '
  668. CALL ERREUR(131)
  669. SEGSUP,MTRAV
  670. RETURN
  671. ENDIF
  672. CALL DECALE(IRAI1,IMAS1,W2,IRAID)
  673. IF (IERR.NE.0) RETURN
  674. *
  675. DO 100 IM = 1,NBMODE
  676. W2I = ( DEUXPI * FREQ(IM) ) ** 2
  677. MW2(IM) = MN(IM) * ( W2I - W2 )
  678. 100 CONTINUE
  679. *
  680. ELSE
  681. IRAID = IRAI1
  682. ENDIF
  683. *
  684. SEGDES MTRAV
  685. *
  686. * cr{ation de la table de sortie
  687. *
  688. CALL CRTABL(ITPSMO)
  689. CALL ECCTAB(ITPSMO,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  690. & 'MOT',I1,X1,'PSEUDO_MODE',L1,IP1)
  691. IPSMO = 0
  692. *
  693. * cas de l'acceleration sismique d'ensemble
  694. *
  695. IF ( SISMIQ ) THEN
  696. IF (IRAID.EQ.0) THEN
  697. MOTERR(1:8)='RIGIDITE'
  698. MOTERR(9:16)='RAIDEUR'
  699. CALL ERREUR(79)
  700. SEGSUP,MTRAV
  701. RETURN
  702. ENDIF
  703. IF (IMAS1.EQ.0) THEN
  704. MOTERR(1:8)='RIGIDITE'
  705. MOTERR(9:16)='MASSE'
  706. CALL ERREUR(79)
  707. SEGSUP,MTRAV
  708. RETURN
  709. ENDIF
  710. CALL ECRCHA('MAIL')
  711. CALL ECROBJ('RIGIDITE',IRAID)
  712. CALL EXTRAI
  713. IF (IERR.NE.0) RETURN
  714. CALL LIROBJ('MAILLAGE',IMAIL,1,IRETOU)
  715. IF (IERR.NE.0) RETURN
  716. DO 80 ID = 1,3
  717. DIR = DIRECT(ID)
  718. IF (DIR .NE. ' ') THEN
  719. CALL PSACCE(IRAID,IMAS1,IMAIL,MTRAV,DIR,ICHP1)
  720. MCHPOI = ICHP1
  721. SEGACT MCHPOI*MOD
  722. IF (DIR .EQ. 'UX') THEN
  723. MOCHDE = 'EMSISEISMEX'
  724. IENT = 1
  725. ELSE IF (DIR .EQ. 'UY') THEN
  726. MOCHDE = 'EMSISEISMEY'
  727. IENT = 2
  728. ELSE
  729. MOCHDE = 'EMSISEISMEZ'
  730. IENT = 3
  731. ENDIF
  732. SEGDES MCHPOI
  733. CALL CRTABL(ITSEIS)
  734. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  735. & 'MOT',I1,X1,'PSMO_SEIS',L1,IP1)
  736. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  737. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  738. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'DIRECTION',L0,IP0,
  739. & 'ENTIER',IENT,X1,' ',L1,IP1)
  740. IPSMO = IPSMO + 1
  741. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  742. & 'TABLE',I1,X1,' ',L1,ITSEIS)
  743. ENDIF
  744. 80 CONTINUE
  745. ENDIF
  746. *
  747. * cas des forces concentr{es
  748. *
  749. IF ( FORCON ) THEN
  750. IF (IRAID.EQ.0) THEN
  751. MOTERR(1:8)='RIGIDITE'
  752. MOTERR(9:16)='RAIDEUR'
  753. CALL ERREUR(79)
  754. SEGSUP,MTRAV
  755. RETURN
  756. ENDIF
  757. DO 20 IC = 1,NBCHP
  758. CALL EXTRA4(LCHPT,IC,ICHPT)
  759. IF (IERR.NE.0) RETURN
  760. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'FORC',ICHP1)
  761. MCHPOI = ICHP1
  762. SEGACT MCHPOI*MOD
  763. MOCHDE = 'EMSIFORCECONCENTREE'
  764. SEGDES MCHPOI
  765. CALL CRTABL(ITFORC)
  766. CALL ECCTAB(ITFORC,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  767. & 'MOT',I1,X1,'PSMO_FORC',L1,IP1)
  768. CALL ECCTAB(ITFORC,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  769. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  770. CALL ECCTAB(ITFORC,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
  771. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  772. CALL PROJTA(ICHPT,ITMOD,0,ICHPR)
  773. CALL ECCTAB(ITFORC,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  774. & 'CHPOINT',I1,X1,' ',L1,ICHPR)
  775. IPSMO = IPSMO + 1
  776. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  777. & 'TABLE',I1,X1,' ',L1,ITFORC)
  778. 20 CONTINUE
  779. ENDIF
  780. *
  781. * cas des forces de choc
  782. *
  783. IF (IAT1 .EQ. 1) THEN
  784. IF (IRAID.EQ.0) THEN
  785. MOTERR(1:8)='RIGIDITE'
  786. MOTERR(9:16)='RAIDEUR'
  787. CALL ERREUR(79)
  788. SEGSUP,MTRAV
  789. RETURN
  790. ENDIF
  791. IL = 0
  792. 32 CONTINUE
  793. IL = IL + 1
  794. TYPRET = ' '
  795. CALL ACCTAB(ITLIA,'ENTIER',IL,X0,' ',L0,IP0,
  796. & TYPRET,I1,X1,CHARRE,L1,ITLLL)
  797. IF (ITLLL.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  798. CALL ACCTAB(ITLLL,'MOT',I1,X0,'POINT',L0,IP0,
  799. & 'POINT',I1,X1,' ',L1,IPS)
  800. CALL ACCTAB(ITLLL,'MOT',I1,X0,'NORMALE',L0,IP0,
  801. & 'POINT',I1,X1,' ',L1,IPN)
  802. CALL PSCHOC(IRAID,MTRAV,IPS,IPN,1,ICHP1)
  803. MCHPOI = ICHP1
  804. SEGACT MCHPOI*MOD
  805. MOCHDE = 'EMSIFORCEDECHOC'
  806. SEGDES MCHPOI
  807. CALL CRTABL(ILIAI)
  808. CALL ECCTAB(ILIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  809. & 'MOT',I1,X1,'PSMO_LIAI',L1,IP1)
  810. CALL ECCTAB(ILIAI,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  811. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  812. CALL ECCTAB(ILIAI,'MOT',I0,X0,'POINT',L0,IP0,
  813. & 'POINT',I1,X1,' ',L1,IPS)
  814. CALL ECCTAB(ILIAI,'MOT',I0,X0,'NORMALE',L0,IP0,
  815. & 'POINT',I1,X1,' ',L1,IPN)
  816. IPSMO = IPSMO + 1
  817. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  818. & 'TABLE',I1,X1,' ',L1,ILIAI)
  819. GOTO 32
  820. ENDIF
  821. ENDIF
  822. *
  823. * cas des structures multisupport{es
  824. *
  825. IF ( STRUCM ) THEN
  826. IF (IRAID.EQ.0) THEN
  827. MOTERR(1:8)='RIGIDITE'
  828. MOTERR(9:16)='RAIDEUR'
  829. CALL ERREUR(79)
  830. SEGSUP,MTRAV
  831. RETURN
  832. ENDIF
  833. IF (IMAS1.EQ.0) THEN
  834. MOTERR(1:8)='RIGIDITE'
  835. MOTERR(9:16)='RAIDEUR'
  836. CALL ERREUR(79)
  837. SEGSUP,MTRAV
  838. RETURN
  839. ENDIF
  840. DO 42 IC = 1,NBCHP
  841. CALL EXTRA4(LCHPT,IC,ICHPT)
  842. IF (IERR.NE.0) RETURN
  843. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'DEPL',ICHP1)
  844. MCHPOI = ICHP1
  845. SEGACT MCHPOI*MOD
  846. MOCHDE = 'EMSISTRUCTUREMULTISUPPORTEE'
  847. SEGDES MCHPOI
  848. CALL CRTABL(ITMULT)
  849. CALL ECCTAB(ITMULT,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  850. & 'MOT',I1,X1,'PSMO_DEPL',L1,IP1)
  851. CALL ECCTAB(ITMULT,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  852. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  853. CALL ECCTAB(ITMULT,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
  854. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  855. CALL PROJTA(ICHPT,ITMOD,0,ICHPR)
  856. CALL ECCTAB(ITMULT,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  857. & 'CHPOINT',I1,X1,' ',L1,ICHPR)
  858. IPSMO = IPSMO + 1
  859. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  860. & 'TABLE',I1,X1,' ',L1,ITMULT)
  861. 42 CONTINUE
  862. ENDIF
  863. *
  864. SEGSUP MTRAV
  865. *
  866. CALL ECROBJ('TABLE ',ITPSMO)
  867. *
  868. END
  869.  
  870.  
  871.  
  872.  
  873.  
  874.  
  875.  
  876.  
  877.  
  878.  
  879.  
  880.  
  881.  
  882.  

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