Télécharger psmo.eso

Retour à la liste

Numérotation des lignes :

  1. C PSMO SOURCE BP208322 14/09/15 21:16:54 8150
  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. LCH1 = 1
  169. ENDIF
  170. ELSE
  171. ICH1 = 1
  172. ENDIF
  173. IF (ICH1 .EQ. 1) THEN
  174. CALL ECROBJ('CHPOINT ',ICHPT)
  175. CALL SUITE1
  176. IF(IERR.NE.0) RETURN
  177. CALL LIROBJ('LISTCHPO',LCHPT,1,IRETOU)
  178. IF(IERR.NE.0) RETURN
  179. LCH1 = 1
  180. ENDIF
  181. *
  182. IF (LCH1 .EQ. 1) THEN
  183. IF ( SISMIQ ) THEN
  184. STRUCM = .TRUE.
  185. SISMIQ = .FALSE.
  186. ELSE
  187. FORCON = .TRUE.
  188. ENDIF
  189. CALL DIMEN2(LCHPT,NBCHP)
  190. IF (IERR.NE.0) RETURN
  191. ENDIF
  192. *
  193. * RECUPERATION DE LA MATRICE K ET DE LA MATRICE M
  194. *
  195. CALL EXTR10(ISTR,'RIGI',IRAI1)
  196. IF (IERR.NE.0) RETURN
  197. CALL EXTR10(ISTR,'MASS',IMAS1)
  198. IF (IERR.NE.0) RETURN
  199. *
  200. * REMPLISSAGE DE MTRAV
  201. *
  202. MSOLUT = IMOD
  203. SEGACT MSOLUT
  204. MSOLEN = MSOLIS(4)
  205. SEGACT MSOLEN
  206. NBMODE = ISOLEN(/1)
  207. *
  208. SEGINI MTRAV
  209. *
  210. DO 1940 I = 1,NBMODE
  211. FREQ(I) = XZERO
  212. MN(I) = XZERO
  213. MW2(I) = XZERO
  214. QX(I) = XZERO
  215. QY(I) = XZERO
  216. QZ(I) = XZERO
  217. DEPL(I) = 0
  218. 1940 CONTINUE
  219. *
  220. DO 1950 IM = 1,NBMODE
  221. MMODE = ISOLEN(IM)
  222. SEGACT MMODE
  223. XF = FMMODD(1)
  224. XMN = FMMODD(2)
  225. W2 = ( DEUXPI * XF ) ** 2
  226. FREQ(IM) = XF
  227. MN(IM) = XMN
  228. MW2(IM) = XMN * W2
  229. QX(IM) = FMMODD(3)
  230. QY(IM) = FMMODD(4)
  231. QZ(IM) = FMMODD(5)
  232. SEGDES MMODE
  233. 1950 CONTINUE
  234. SEGDES MSOLEN
  235. *
  236. MSOLEN = MSOLIS(5)
  237. SEGACT MSOLEN
  238. DO 1960 ID = 1,NBMODE
  239. DEPL(ID) = ISOLEN(ID)
  240. 1960 CONTINUE
  241. SEGDES MSOLEN
  242. *
  243. SEGDES MSOLUT
  244. *
  245. * CAS DES MODES DE CORPS SOLIDE
  246. * RECHERCHE DE FREQUENCE(S) NULLE(S) DANS L'OBJET SOLUTION
  247. *
  248. XF1 = 0.D0
  249. DO 1972 I = 1,NBMODE
  250. XFI = FREQ(I)
  251. IF (XFI .LT. EPSI) THEN
  252. CORSOL = .TRUE.
  253. ELSE
  254. IF (XF1 .EQ. 0.D0) XF1 =XFI
  255. ENDIF
  256. 1972 CONTINUE
  257. *
  258. IF ( CORSOL ) THEN
  259. IF (XFREQ .EQ. 0.D0) THEN
  260. * RECHERCHE DE LA 1-ERE FREQUENCE NON NULLE
  261. DO 1974 I = 1,NBMODE
  262. XFI = FREQ(I)
  263. IF ((XFI .LT. XF1) .AND.(XFI .GE. EPSI))THEN
  264. XF1 = XFI
  265. ENDIF
  266. 1974 CONTINUE
  267. XFREQ = XF1 / 2.D0
  268. ENDIF
  269. *
  270. IF ( IIMPI .GT. 0 ) THEN
  271. WRITE (IOIMP,998) ( FREQ(I),I=1,NBMODE)
  272. 998 FORMAT (/1X,'SBR PSMO LISTE DES FREQ ',/1X,10(E12.5,1X))
  273. WRITE ( IOIMP, 1002 ) XFREQ
  274. 1002 FORMAT ( /1X, 'SBR PSMO CORPS SOLIDES 1ERE FREQ*0.5 N.NUL'
  275. C ,' OU FREQ IMPO ',E12.5 )
  276. ENDIF
  277. W2 = (DEUXPI * XFREQ) ** 2
  278. CALL DECALE(IRAI1,IMAS1,W2,IRAID)
  279. IF (IERR.NE.0) RETURN
  280. *
  281. DO 19100 IM = 1,NBMODE
  282. W2I = ( DEUXPI * FREQ(IM) ) ** 2
  283. MW2(IM) = MN(IM) * ( W2I - W2 )
  284. 19100 CONTINUE
  285. *
  286. ELSE
  287. IRAID = IRAI1
  288. ENDIF
  289. *
  290. SEGDES MTRAV
  291. *
  292. NUME = NBMODE
  293. NBMOD1 = NBMODE + 1
  294. XFRST = 0.D0
  295. XMNST = 0.D0
  296. XQ1 = 0.D0
  297. XQ2 = 0.D0
  298. XQ3 = 0.D0
  299. ICHE1 = 0
  300. *
  301. * CAS DE L'ACCELERATION SISMIQUE D'ENSEMBLE
  302. *
  303. IF ( SISMIQ ) THEN
  304. CALL ECRCHA('MAIL')
  305. CALL ECROBJ('RIGIDITE',IRAID)
  306. CALL EXTRAI
  307. IF (IERR.NE.0) RETURN
  308. CALL LIROBJ('MAILLAGE',IMAIL,1,IRETOU)
  309. IF (IERR.NE.0) RETURN
  310. DO 1980 ID = 1,3
  311. DIR = DIRECT(ID)
  312. IF (DIR .NE. ' ') THEN
  313. CALL PSACCE(IRAID,IMAS1,IMAIL,MTRAV,DIR,ICHP1)
  314. N = 0
  315. SEGINI MJONCT
  316. IJONCT = MJONCT
  317. MJODDL = DIR
  318. MJOTYP = 'SEIS'
  319. MJOPOI = 0
  320. SEGDES MJONCT
  321. MCHPOI = ICHP1
  322. SEGACT MCHPOI
  323. IF (DIR .EQ. 'UX') THEN
  324. MOCHDE = 'EMSISEISMEX'
  325. ELSE IF (DIR .EQ. 'UY') THEN
  326. MOCHDE = 'EMSISEISMEY'
  327. ELSE
  328. MOCHDE = 'EMSISEISMEZ'
  329. ENDIF
  330. SEGDES MCHPOI
  331. NUME = NUME + 1
  332. IF (NUME .EQ. NBMOD1) THEN
  333. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  334. & ICHP1,ICHE1,IJONCT,ISOLS)
  335. ELSE
  336. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  337. & ICHP1,ICHE1,IJONCT,ISOL1)
  338. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  339. IF (IERR.NE.0) RETURN
  340. CALL DESOLU(ISOLS)
  341. IF (IERR.NE.0) RETURN
  342. CALL DESOLU(ISOL1)
  343. IF (IERR.NE.0) RETURN
  344. ISOLS = ISOL2
  345. ENDIF
  346. ENDIF
  347. 1980 CONTINUE
  348. ENDIF
  349. *
  350. * CAS DES FORCES CONCENTREES OU DE CHOCS
  351. *
  352. IF ( FORCON ) THEN
  353. DO 1920 IC = 1,NBCHP
  354. CALL EXTRA4(LCHPT,IC,ICHPT)
  355. IF (IERR.NE.0) RETURN
  356. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'FORC',ICHP1)
  357. N = 1
  358. SEGINI MJONCT
  359. IJONCT = MJONCT
  360. MJODDL = ' '
  361. MJOTYP = 'FORC'
  362. MJOPOI = 0
  363. IPCHJO(1) = ICHPT
  364. ISTRJO(1) = 0
  365. IPOSJO(1) = 0
  366. SEGDES MJONCT
  367. MCHPOI = ICHP1
  368. SEGACT MCHPOI
  369. MOCHDE = 'EMSIFORCECONCENTREE'
  370. SEGDES MCHPOI
  371. NUME = NUME + 1
  372. IF (NUME .EQ. NBMOD1) THEN
  373. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  374. & ICHP1,ICHE1,IJONCT,ISOLS)
  375. ELSE
  376. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  377. & ICHP1,ICHE1,IJONCT,ISOL1)
  378. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  379. IF (IERR.NE.0) RETURN
  380. CALL DESOLU(ISOLS)
  381. IF (IERR.NE.0) RETURN
  382. CALL DESOLU(ISOL1)
  383. IF (IERR.NE.0) RETURN
  384. ISOLS = ISOL2
  385. ENDIF
  386. 1920 CONTINUE
  387. ENDIF
  388. *
  389. * CAS DES FORCES DE CHOC
  390. *
  391. IF (IAT1 .EQ. 1) THEN
  392. MATTAC = IATT
  393. SEGACT MATTAC
  394. NSOUMA = LISATT(/1)
  395. DO 1932 IS =1,NSOUMA
  396. MSOUMA = LISATT(IS)
  397. SEGACT MSOUMA
  398. IF (ITYATT .NE. 'CHOC') THEN
  399. SEGDES MSOUMA
  400. GOTO 1932
  401. ENDIF
  402. MGEOCH = IGEOCH
  403. SEGACT MGEOCH
  404. MELEME = INORCH(1)
  405. SEGDES MGEOCH
  406. SEGACT MELEME
  407. NORM = NUM(1,1)
  408. SEGDES MELEME
  409. NJONCT = IATREL(/1)
  410. DO 1934 IJ =1,NJONCT
  411. MJONCT = IATREL(IJ)
  412. SEGACT MJONCT
  413. DO 1936 IJ2 = 1,2
  414. ISTR = ISTRJO(IJ2)
  415. IF (ISTR.NE.0) THEN
  416. MCHPOI = IPCHJO(IJ2)
  417. SEGACT MCHPOI
  418. MSOUPO = IPCHP(1)
  419. SEGDES MCHPOI
  420. SEGACT MSOUPO
  421. MELEME = IGEOC
  422. SEGDES MSOUPO
  423. SEGACT MELEME
  424. IPT = NUM(1,IJ2)
  425. SEGDES MELEME
  426. *
  427. CALL PSCHOC(IRAID,MTRAV,IPT,NORM,IJ2, ICHP1)
  428. N = 1
  429. SEGINI MJONC1
  430. IJONCT = MJONC1
  431. MJONC1.MJODDL = ' '
  432. MJONC1.MJOTYP = 'CHOC'
  433. MJONC1.MJOPOI = IPT
  434. MJONC1.IPCHJO(1) = 0
  435. MJONC1.ISTRJO(1) = ISTR
  436. MJONC1.IPOSJO(1) = 0
  437. SEGDES MJONC1
  438. *
  439. MCHPOI = ICHP1
  440. SEGACT MCHPOI
  441. MOCHDE = 'EMSIFORCEDECHOC'
  442. SEGDES MCHPOI
  443. *
  444. NUME = NUME + 1
  445. IF (NUME .EQ. NBMOD1) THEN
  446. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,
  447. & XQ2,XQ3,ICHP1,ICHE1,IJONCT,ISOLS)
  448. ELSE
  449. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,
  450. & XQ2,XQ3,ICHP1,ICHE1,IJONCT,ISOL1)
  451. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  452. IF (IERR.NE.0) RETURN
  453. CALL DESOLU(ISOLS)
  454. IF (IERR.NE.0) RETURN
  455. CALL DESOLU(ISOL1)
  456. IF (IERR.NE.0) RETURN
  457. ISOLS = ISOL2
  458. ENDIF
  459. ENDIF
  460. 1936 CONTINUE
  461. SEGDES MJONCT
  462. 1934 CONTINUE
  463. SEGDES MSOUMA
  464. 1932 CONTINUE
  465. SEGDES MATTAC
  466. ENDIF
  467. *
  468. * CAS DES STRUCTURES MULTISUPPORTEES
  469. *
  470. IF ( STRUCM ) THEN
  471. DO 1942 IC = 1,NBCHP
  472. CALL EXTRA4(LCHPT,IC,ICHPT)
  473. IF (IERR.NE.0) RETURN
  474. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'DEPL',ICHP1)
  475. N = 1
  476. SEGINI MJONCT
  477. IJONCT = MJONCT
  478. MJODDL = ' '
  479. MJOTYP = 'DEPL'
  480. MJOPOI = 0
  481. IPCHJO(1) = ICHPT
  482. ISTRJO(1) = 0
  483. IPOSJO(1) = 0
  484. SEGDES MJONCT
  485. MCHPOI = ICHP1
  486. SEGACT MCHPOI
  487. MOCHDE = 'EMSISTRUCTUREMULTISUPPORTEE'
  488. SEGDES MCHPOI
  489. NUME = NUME + 1
  490. IF (NUME .EQ. NBMOD1) THEN
  491. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  492. & ICHP1,ICHE1,IJONCT,ISOLS)
  493. ELSE
  494. CALL MANUSO('PSEUMODE',NUME,XFRST,XMNST,XQ1,XQ2,XQ3,
  495. & ICHP1,ICHE1,IJONCT,ISOL1)
  496. CALL FUSOLU(ISOLS,ISOL1,ISOL2)
  497. IF (IERR.NE.0) RETURN
  498. CALL DESOLU(ISOLS)
  499. IF (IERR.NE.0) RETURN
  500. CALL DESOLU(ISOL1)
  501. IF (IERR.NE.0) RETURN
  502. ISOLS = ISOL2
  503. ENDIF
  504. 1942 CONTINUE
  505. ENDIF
  506. *
  507. SEGSUP MTRAV
  508. *
  509. CALL ECROBJ('SOLUTION',ISOLS)
  510. *
  511. RETURN
  512. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*++*+*+*
  513. * nouvelle version
  514. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*++*+*+*
  515. 2000 CONTINUE
  516. IRAI1 = 0
  517. IMAS1 = 0
  518. 1 CALL LIROBJ('RIGIDITE',IRET,0,IRETOU)
  519. IF (IRETOU.NE.0) THEN
  520. MRIGID = IRET
  521. SEGACT,MRIGID
  522. IF (MTYMAT.EQ.'RIGIDITE') THEN
  523. IF (IRAI1.NE.0) THEN
  524. MOTERR(1:8)='RIGIDITE'
  525. MOTERR(9:16)='RIGIDITE'
  526. CALL ERREUR(130)
  527. * la matrice de rigidite a d{ja {t{ donn{e
  528. SEGDES,MRIGID
  529. RETURN
  530. ENDIF
  531. IRAI1 = MRIGID
  532. SEGDES,MRIGID
  533. IF (IMAS1.EQ.0) GOTO 1
  534. ELSE IF (MTYMAT.EQ.'MASSE') THEN
  535. IF (IMAS1.NE.0) THEN
  536. MOTERR(1:8)='RIGIDITE'
  537. MOTERR(9:16)='MASSE'
  538. CALL ERREUR(130)
  539. * la matrice de masse a d{ja {t{ donn{e
  540. SEGDES,MRIGID
  541. RETURN
  542. ENDIF
  543. IMAS1 = MRIGID
  544. SEGDES,MRIGID
  545. IF (IRAI1.EQ.0) GOTO 1
  546. ELSE
  547. MOTERR(1:8) = 'RIGIDITE'
  548. MOTERR(9:16) = MTYMAT
  549. CALL ERREUR(131)
  550. * on n'attend pas ce sous type de rigidit{
  551. SEGDES,MRIGID
  552. RETURN
  553. ENDIF
  554. ENDIF
  555. *
  556. CALL LIRTAB('BASE_DE_MODES',ITMOD,1,IRET)
  557. IF (IERR .NE. 0) RETURN
  558. *
  559. CALL LIRTAB('POINT_DE_LIAISON',ITLIA,0,IRETOU)
  560. IF (IRETOU .EQ. 1) THEN
  561. IAT1 = 1
  562. ENDIF
  563. *
  564. CALL LIROBJ('CHPOINT ',ICHPT,0,IRETOU)
  565. IF (IRETOU .EQ. 0) THEN
  566. CALL LIROBJ('LISTCHPO',LCHPT,0,IRETOU)
  567. IF (IRETOU .EQ. 1) THEN
  568. LCH1 = 1
  569. ENDIF
  570. ELSE
  571. ICH1 = 1
  572. ENDIF
  573. IF (ICH1 .EQ. 1) THEN
  574. CALL ECROBJ('CHPOINT ',ICHPT)
  575. CALL SUITE1
  576. IF(IERR.NE.0) RETURN
  577. CALL LIROBJ('LISTCHPO',LCHPT,1,IRETOU)
  578. IF(IERR.NE.0) RETURN
  579. LCH1 = 1
  580. ENDIF
  581. *
  582. IF (LCH1 .EQ. 1) THEN
  583. IF ( SISMIQ ) THEN
  584. STRUCM = .TRUE.
  585. SISMIQ = .FALSE.
  586. ELSE
  587. FORCON = .TRUE.
  588. ENDIF
  589. CALL DIMEN2(LCHPT,NBCHP)
  590. IF (IERR.NE.0) RETURN
  591. ENDIF
  592. *
  593. * remplissage de MTRAV
  594. *
  595. CALL DIMEN7(ITMOD,NBMODE)
  596. NBMODE = NBMODE - 2
  597. *
  598. SEGINI MTRAV
  599. DO 50 IM = 1,NBMODE
  600. CALL ACCTAB(ITMOD,'ENTIER',IM,X0,' ',L0,IP0,
  601. & 'TABLE',I1,X1,' ',L1,ITMK)
  602. CALL ACCTAB(ITMK,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  603. & 'FLOTTANT',I1,XF,' ',L1,IP1)
  604. CALL ACCTAB(ITMK,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  605. & 'FLOTTANT',I1,XMN,' ',L1,IP1)
  606. CALL ACCTAB(ITMK,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',L0,IP0,
  607. & 'TABLE',I1,X1,' ',L1,ITDG)
  608. CALL ACCTAB(ITDG,'ENTIER',1,X0,' ',L0,IP0,
  609. & 'FLOTTANT',I1,XQX,' ',L1,IP1)
  610. CALL ACCTAB(ITDG,'ENTIER',2,X0,' ',L0,IP0,
  611. & 'FLOTTANT',I1,XQY,' ',L1,IP1)
  612. CALL ACCTAB(ITDG,'ENTIER',3,X0,' ',L0,IP0,
  613. & 'FLOTTANT',I1,XQZ,' ',L1,IP1)
  614. CALL ACCTAB(ITMK,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  615. & 'CHPOINT',I1,X1,' ',L1,ICHDM)
  616. W2 = ( DEUXPI * XF ) ** 2
  617. FREQ(IM) = XF
  618. MN(IM) = XMN
  619. MW2(IM) = XMN * W2
  620. QX(IM) = XQX
  621. QY(IM) = XQY
  622. QZ(IM) = XQZ
  623. DEPL(IM) = ICHDM
  624. 50 CONTINUE
  625. *
  626. * cas des modes de corps solide
  627. * recherche de fr{quence(s) nulle(s)
  628. *
  629. XF1 = 0.D0
  630. DO 72 I = 1,NBMODE
  631. XFI = FREQ(I)
  632. IF (XFI .LT. EPSI) THEN
  633. CORSOL = .TRUE.
  634. ELSE
  635. IF (XF1 .EQ. 0.D0) XF1 =XFI
  636. ENDIF
  637. 72 CONTINUE
  638. *
  639. IF ( CORSOL ) THEN
  640. IF (XFREQ .EQ. 0.D0) THEN
  641. * recherche de la 1-}re fr{quence non nulle
  642. DO 74 I = 1,NBMODE
  643. XFI = FREQ(I)
  644. IF ((XFI .LT. XF1) .AND.(XFI .GE. EPSI))THEN
  645. XF1 = XFI
  646. ENDIF
  647. 74 CONTINUE
  648. XFREQ = XF1 / 2.D0
  649. ENDIF
  650. *
  651. IF ( IIMPI .GT. 0 ) THEN
  652. WRITE (IOIMP,999) ( FREQ(I),I=1,NBMODE)
  653. 999 FORMAT (/1X,'SBR PSMO liste des freq ',/1X,10(E12.5,1X))
  654. WRITE ( IOIMP, 1000 ) XFREQ
  655. 1000 FORMAT ( /1X, 'SBR PSMO corps solides 1}re freq*0.5 n.nil'
  656. & ,' OU FREQ IMPO ',E12.5 )
  657. ENDIF
  658. W2 = (DEUXPI * XFREQ) ** 2
  659. IF (IMAS1.EQ.0) THEN
  660. MOTERR(1:8) = 'RIGIDITE'
  661. MOTERR(9:16) = 'MASSE '
  662. CALL ERREUR(131)
  663. SEGSUP,MTRAV
  664. RETURN
  665. ENDIF
  666. CALL DECALE(IRAI1,IMAS1,W2,IRAID)
  667. IF (IERR.NE.0) RETURN
  668. *
  669. DO 100 IM = 1,NBMODE
  670. W2I = ( DEUXPI * FREQ(IM) ) ** 2
  671. MW2(IM) = MN(IM) * ( W2I - W2 )
  672. 100 CONTINUE
  673. *
  674. ELSE
  675. IRAID = IRAI1
  676. ENDIF
  677. *
  678. SEGDES MTRAV
  679. *
  680. * cr{ation de la table de sortie
  681. *
  682. CALL CRTABL(ITPSMO)
  683. CALL ECCTAB(ITPSMO,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  684. & 'MOT',I1,X1,'PSEUDO_MODE',L1,IP1)
  685. IPSMO = 0
  686. *
  687. * cas de l'acceleration sismique d'ensemble
  688. *
  689. IF ( SISMIQ ) THEN
  690. IF (IRAID.EQ.0) THEN
  691. MOTERR(1:8)='RIGIDITE'
  692. MOTERR(9:16)='RAIDEUR'
  693. CALL ERREUR(79)
  694. SEGSUP,MTRAV
  695. RETURN
  696. ENDIF
  697. IF (IMAS1.EQ.0) THEN
  698. MOTERR(1:8)='RIGIDITE'
  699. MOTERR(9:16)='MASSE'
  700. CALL ERREUR(79)
  701. SEGSUP,MTRAV
  702. RETURN
  703. ENDIF
  704. CALL ECRCHA('MAIL')
  705. CALL ECROBJ('RIGIDITE',IRAID)
  706. CALL EXTRAI
  707. IF (IERR.NE.0) RETURN
  708. CALL LIROBJ('MAILLAGE',IMAIL,1,IRETOU)
  709. IF (IERR.NE.0) RETURN
  710. DO 80 ID = 1,3
  711. DIR = DIRECT(ID)
  712. IF (DIR .NE. ' ') THEN
  713. CALL PSACCE(IRAID,IMAS1,IMAIL,MTRAV,DIR,ICHP1)
  714. MCHPOI = ICHP1
  715. SEGACT MCHPOI*MOD
  716. IF (DIR .EQ. 'UX') THEN
  717. MOCHDE = 'EMSISEISMEX'
  718. IENT = 1
  719. ELSE IF (DIR .EQ. 'UY') THEN
  720. MOCHDE = 'EMSISEISMEY'
  721. IENT = 2
  722. ELSE
  723. MOCHDE = 'EMSISEISMEZ'
  724. IENT = 3
  725. ENDIF
  726. SEGDES MCHPOI
  727. CALL CRTABL(ITSEIS)
  728. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  729. & 'MOT',I1,X1,'PSMO_SEIS',L1,IP1)
  730. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  731. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  732. CALL ECCTAB(ITSEIS,'MOT',I0,X0,'DIRECTION',L0,IP0,
  733. & 'ENTIER',IENT,X1,' ',L1,IP1)
  734. IPSMO = IPSMO + 1
  735. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  736. & 'TABLE',I1,X1,' ',L1,ITSEIS)
  737. ENDIF
  738. 80 CONTINUE
  739. ENDIF
  740. *
  741. * cas des forces concentr{es
  742. *
  743. IF ( FORCON ) THEN
  744. IF (IRAID.EQ.0) THEN
  745. MOTERR(1:8)='RIGIDITE'
  746. MOTERR(9:16)='RAIDEUR'
  747. CALL ERREUR(79)
  748. SEGSUP,MTRAV
  749. RETURN
  750. ENDIF
  751. DO 20 IC = 1,NBCHP
  752. CALL EXTRA4(LCHPT,IC,ICHPT)
  753. IF (IERR.NE.0) RETURN
  754. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'FORC',ICHP1)
  755. MCHPOI = ICHP1
  756. SEGACT MCHPOI*MOD
  757. MOCHDE = 'EMSIFORCECONCENTREE'
  758. SEGDES MCHPOI
  759. CALL CRTABL(ITFORC)
  760. CALL ECCTAB(ITFORC,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  761. & 'MOT',I1,X1,'PSMO_FORC',L1,IP1)
  762. CALL ECCTAB(ITFORC,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  763. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  764. CALL ECCTAB(ITFORC,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
  765. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  766. CALL PROJTA(ICHPT,ITMOD,0,ICHPR)
  767. CALL ECCTAB(ITFORC,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  768. & 'CHPOINT',I1,X1,' ',L1,ICHPR)
  769. IPSMO = IPSMO + 1
  770. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  771. & 'TABLE',I1,X1,' ',L1,ITFORC)
  772. 20 CONTINUE
  773. ENDIF
  774. *
  775. * cas des forces de choc
  776. *
  777. IF (IAT1 .EQ. 1) THEN
  778. IF!<{pan style="color: #009900;">(IRAID.EQ.0) THEN
  779. MOTERR(1:8)='RIGIDITE'
  780. MOTERR(9:16)='RAIDEUR'
  781. CALL ERREUR(79)
  782. SEGSUP,MTRAV
  783. RETURN
  784. ENDIF
  785. IL = 0
  786. 32 CONTINUE
  787. IL = IL + 1
  788. TYPRET = ' '
  789. CALL ACCTAB(ITLIA,'ENTIER',IL,X0,' ',L0,IP0,
  790. & TYPRET,I1,X1,CHARRE,L1,ITLLL)
  791. IF (ITLLL.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  792. CALL ACCTAB(ITLLL,'MOT',I1,X0,'POINT',L0,IP0,
  793. & 'POINT',I1,X1,' ',L1,IPS)
  794. CALL ACCTAB(ITLLL,'MOT',I1,X0,'NORMALE',L0,IP0,
  795. & 'POINT',I1,X1,' ',L1,IPN)
  796. CALL PSCHOC(IRAID,MTRAV,IPS,IPN,1,ICHP1)
  797. MCHPOI = ICHP1
  798. SEGACT MCHPOI*MOD
  799. MOCHDE = 'EMSIFORCEDECHOC'
  800. SEGDES MCHPOI
  801. CALL CRTABL(ILIAI)
  802. CALL ECCTAB(ILIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  803. & 'MOT',I1,X1,'PSMO_LIAI',L1,IP1)
  804. CALL ECCTAB(ILIAI,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  805. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  806. CALL ECCTAB(ILIAI,'MOT',I0,X0,'POINT',L0,IP0,
  807. & 'POINT',I1,X1,' ',L1,IPS)
  808. CALL ECCTAB(ILIAI,'MOT',I0,X0,'NORMALE',L0,IP0,
  809. & 'POINT',I1,X1,' ',L1,IPN)
  810. IPSMO = IPSMO + 1
  811. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  812. & 'TABLE',I1,X1,' ',L1,ILIAI)
  813. GOTO 32
  814. ENDIF
  815. ENDIF
  816. *
  817. * cas des structures multisupport{es
  818. *
  819. IF ( STRUCM ) THEN
  820. IF (IRAID.EQ.0) THEN
  821. MOTERR(1:8)='RIGIDITE'
  822. MOTERR(9:16)='RAIDEUR'
  823. CALL ERREUR(79)
  824. SEGSUP,MTRAV
  825. RETURN
  826. ENDIF
  827. IF (IMAS1.EQ.0) THEN
  828. MOTERR(1:8)='RIGIDITE'
  829. MOTERR(9:16)='RAIDEUR'
  830. CALL ERREUR(79)
  831. SEGSUP,MTRAV
  832. RETURN
  833. ENDIF
  834. DO 42 IC = 1,NBCHP
  835. CALL EXTRA4(LCHPT,IC,ICHPT)
  836. IF (IERR.NE.0) RETURN
  837. CALL PSCHPT(IRAID,IMAS1,MTRAV,ICHPT,'DEPL',ICHP1)
  838. MCHPOI = ICHP1
  839. SEGACT MCHPOI*MOD
  840. MOCHDE = 'EMSISTRUCTUREMULTISUPPORTEE'
  841. SEGDES MCHPOI
  842. CALL CRTABL(ITMULT)
  843. CALL ECCTAB(ITMULT,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  844. & 'MOT',I1,X1,'PSMO_DEPL',L1,IP1)
  845. CALL ECCTAB(ITMULT,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  846. & 'CHPOINT',I1,X1,' ',L1,ICHP1)
  847. CALL ECCTAB(ITMULT,'MOT',I0,X0,'CHAMP_BASE_B',L0,IP0,
  848. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  849. CALL PROJTA(ICHPT,ITMOD,0,ICHPR)
  850. CALL ECCTAB(ITMULT,'MOT',I0,X0,'CHAMP_BASE_A',L0,IP0,
  851. & 'CHPOINT',I1,X1,' ',L1,ICHPR)
  852. IPSMO = IPSMO + 1
  853. CALL ECCTAB(ITPSMO,'ENTIER',IPSMO,X0,' ',L0,IP0,
  854. & 'TABLE',I1,X1,' ',L1,ITMULT)
  855. 42 CONTINUE
  856. ENDIF
  857. *
  858. SEGSUP MTRAV
  859. *
  860. CALL ECROBJ('TABLE',ITPSMO)
  861. *
  862. END
  863.  
  864.  
  865.  
  866.  
  867.  
  868.  
  869.  
  870.  
  871.  
  872.  
  873.  
  874.  
  875.  

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