Télécharger copbas.eso

Retour à la liste

Numérotation des lignes :

  1. C COPBAS SOURCE CB215821 16/04/15 21:15:06 8907
  2. SUBROUTINE COPBAS(ITBAS,ITPTS,MOTCLE,IPO1,IPO2,XANG)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,Q-Z)
  5. LOGICAL L0,L1
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Effectue une op{ration g{om{trique de translation (MOTCLE = *
  9. * 'PLUS') ou de rotation (MOTCLE = 'ROTA') sur ITBAS contenant *
  10. * les modes, les pseudo-modes de la structure. *
  11. * *
  12. * Param}tres: *
  13. * *
  14. * e ITBAS table de sous-type BASE_MODALE, contenant les modes, *
  15. * les pseudo-modes,... de la structure *
  16. * e ITPTS table de sous-type POINT, points de la g{om{trie que *
  17. * l'on souhaite translat{s *
  18. * e MOTCLE mot : PLUS ou ROTA *
  19. * e IPO1 premier point de l'axe de rotation *
  20. * e IPO2 deuxi}me point de l'axe de rotation, si 3D *
  21. * e XANG angle de rotation *
  22. * *
  23. * Auteur, date de cr{ation: *
  24. * *
  25. * Lionel VIVAN, le 9 mai 1990. *
  26. * *
  27. *--------------------------------------------------------------------*
  28. * *
  29. -INC CCOPTIO
  30. -INC SMCHPOI
  31. -INC SMCHAML
  32. -INC SMCOORD
  33. -INC SMELEME
  34. -INC SMTABLE
  35. *
  36. logical ltelq
  37. SEGMENT ITRCHP
  38. INTEGER ICHCA(NSOU),ICHCN(NSOU)
  39. ENDSEGMENT
  40. SEGMENT ITRCHA
  41. INTEGER ICHAM(NSOUS)
  42. ENDSEGMENT
  43. SEGMENT MTRAV
  44. REAL*8 XPT(IDIMB),XPTP(IDIMB),XP1PT(IDIMB),XMPT(IDIMB,IDIMB)
  45. ENDSEGMENT
  46. SEGMENT MTRA2
  47. INTEGER IDEP(3),IROT(3)
  48. REAL*8 XDEP(3),XROT(3)
  49. ENDSEGMENT
  50. SEGMENT MTRA3
  51. REAL*8 XDGEN(3),XDGE2(3)
  52. ENDSEGMENT
  53. SEGMENT MTRA4
  54. INTEGER IFOR(3),IMOM(3)
  55. REAL*8 XFOR(3),XMOM(3)
  56. ENDSEGMENT
  57. *
  58. * LCHAIN contiendra les adresses des cha™nes dans CCNOYAU
  59. *
  60. PARAMETER ( NCHAIN = 19 )
  61. INTEGER LCHAIN(NCHAIN)
  62. CHARACTER*4 COMP,MOTCLE
  63. CHARACTER*8 TYPRET,CHARRE
  64.  
  65. X0=0.D0
  66. L0=.FALSE.
  67. IP0=0
  68. I1=0
  69. X1=0.D0
  70. IP1=0
  71. I0=0
  72. *
  73. CALL CRTABL(ITBID)
  74. *
  75. ICHAIN = 1
  76. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  77. & 'POINT_REPERE',L1,IP1)
  78. ICHAIN = 2
  79. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  80. & 'DEPLACEMENTS_GENERALISES',L1,IP1)
  81. ICHAIN = 3
  82. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  83. & 'DEFORMEE_MODALE',L1,IP1)
  84. ICHAIN = 4
  85. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  86. & 'CONTRAINTE_MODALE',L1,IP1)
  87. ICHAIN = 5
  88. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  89. & 'REACTION_MODALE',L1,IP1)
  90. ICHAIN = 6
  91. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  92. & 'DEPLACEMENT',L1,IP1)
  93. ICHAIN = 7
  94. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  95. & 'CONTRAINTE',L1,IP1)
  96. ICHAIN = 8
  97. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  98. & 'REACTION',L1,IP1)
  99. ICHAIN = 9
  100. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  101. & 'CHAMP_BASE_B',L1,IP1)
  102. ICHAIN = 10
  103. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  104. & 'POINT',L1,IP1)
  105. ICHAIN = 11
  106. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  107. & 'MODES',L1,IP1)
  108. ICHAIN = 12
  109. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  110. & 'PSEUDO_MODES',L1,IP1)
  111. ICHAIN = 13
  112. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  113. & 'MAILLAGE',L1,IP1)
  114. ICHAIN = 14
  115. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  116. & 'SOUSTYPE',L1,IP1)
  117. ICHAIN = 15
  118. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  119. & 'BASE_MODALE',L1,IP1)
  120. ICHAIN = 16
  121. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  122. & 'BASE_ROTA',L1,IP1)
  123. ICHAIN = 17
  124. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  125. & 'BASE_PLUS',L1,IP1)
  126. ICHAIN = 18
  127. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  128. & 'BASE',L1,IP1)
  129. ICHAIN = 19
  130. CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
  131. & 'MASSE_GENERALISEE',L1,IP1)
  132. *
  133. MTABLE = ITBID
  134. SEGACT,MTABLE
  135. DO 20 ICHAIN = 1 , NCHAIN
  136. LCHAIN(ICHAIN) = MTABIV(ICHAIN)
  137. 20 CONTINUE
  138. * end do
  139. SEGSUP,MTABLE
  140. *
  141. * R{cup{ration de la table des modes
  142. *
  143. MTABLE = ITBAS
  144. SEGACT MTABLE
  145. LONG = MLOTAB
  146. DO 10 I = 1,LONG
  147. IF (MTABTI(I).EQ.'MOT ' .AND.
  148. & MTABII(I).EQ.LCHAIN(11) .AND.
  149. & MTABTV(I).EQ.'TABLE ') THEN
  150. IBAS = MTABIV(I)
  151. GOTO 12
  152. ENDIF
  153. 10 CONTINUE
  154. * end do
  155. CALL ERREUR(499)
  156. SEGDES MTABLE
  157. RETURN
  158. 12 CONTINUE
  159. *
  160. * R{cup{ration de la table des pseudo-modes
  161. *
  162. IPSM = 0
  163. DO 14 I = 1,LONG
  164. IF (MTABTI(I).EQ.'MOT ' .AND.
  165. & MTABII(I).EQ.LCHAIN(12) .AND.
  166. & MTABTV(I).EQ.'TABLE ') THEN
  167. IPSM = MTABIV(I)
  168. GOTO 16
  169. ENDIF
  170. 14 CONTINUE
  171. * end do
  172. 16 CONTINUE
  173. SEGDES MTABLE
  174. *
  175. KTRAV = 0
  176. IF (MOTCLE.EQ.'ROTA') THEN
  177. IDIM1 = IDIM + 1
  178. CALL CALMAT(KTRAV,IPO1,IPO2,XANG)
  179. IF (IERR.NE.0) RETURN
  180. MTRAV = KTRAV
  181. ENDIF
  182. *
  183. * Traitement de la table de modes
  184. * ===============================
  185. *
  186. * On duplique la table des modes
  187. *
  188. CALL COPBA2(LCHAIN,IBAS,IBA2)
  189. *
  190. * On r{cup}re la premi}re d{form{e modale pour cr{er le nouveau
  191. * maillage.
  192. *
  193. MTABLE = IBA2
  194. SEGACT MTABLE*MOD
  195. LONG = MLOTAB
  196. IM = 1
  197. DO 60 I = 1,LONG
  198. IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
  199. & MTABTV(I).EQ.'TABLE ') THEN
  200. ITMOD = MTABIV(I)
  201. GOTO 62
  202. ENDIF
  203. 60 CONTINUE
  204. * end do
  205. CALL ERREUR(500)
  206. SEGDES MTABLE
  207. RETURN
  208. 62 CONTINUE
  209. MTAB1 = ITMOD
  210. SEGACT MTAB1*MOD
  211. LON1 = MTAB1.MLOTAB
  212. DO 64 I1 = 1,LON1
  213. IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
  214. & MTAB1.MTABII(I1).EQ.LCHAIN(3) .AND.
  215. & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  216. ICHDEP = MTAB1.MTABIV(I1)
  217. GOTO 66
  218. ENDIF
  219. 64 CONTINUE
  220. * end do
  221. CALL ERREUR(501)
  222. SEGDES MTAB1
  223. SEGDES MTABLE
  224. RETURN
  225. 66 CONTINUE
  226. *
  227. MCHPOI = ICHDEP
  228. SEGACT MCHPOI
  229. NSOU = IPCHP(/1)
  230. SEGINI ITRCHP
  231. KTRCHP = ITRCHP
  232. DO 80 INS = 1,NSOU
  233. MSOUPO = IPCHP(INS)
  234. SEGACT MSOUPO*MOD
  235. IF (MOTCLE.EQ.'PLUS') THEN
  236. MAIL1 = IGEOC
  237. ICHCA(INS) = MAIL1
  238. CALL ECROBJ('POINT ',IPO1)
  239. CALL ECROBJ('MAILLAGE',MAIL1)
  240. CALL PROPER(1)
  241. IF (IERR.NE.0) RETURN
  242. CALL LIROBJ('MAILLAGE',NOMA1,1,IRETOU)
  243. IF (IERR.NE.0) RETURN
  244. IGEOC = NOMA1
  245. ICHCN(INS) = NOMA1
  246. ELSE
  247. SEGINI MTRA2
  248. MPOVAL = IPOVAL
  249. SEGACT MPOVAL
  250. NPOIN = VPOCHA(/1)
  251. NCOM = VPOCHA(/2)
  252. DO 210 IP = 1,NPOIN
  253. ICD = 0
  254. ICR = 0
  255. DO 220 IC = 1,NCOM
  256. COMP = NOCOMP(IC)
  257. IF (COMP(1:1).EQ.'U') THEN
  258. ICD = ICD + 1
  259. IDEP(ICD) = IC
  260. XDEP(ICD) = VPOCHA(IP,IC)
  261. ELSE IF (COMP(1:1).EQ.'R') THEN
  262. ICR = ICR + 1
  263. IROT(ICR) = IC
  264. XROT(ICR) = VPOCHA(IP,IC)
  265. ENDIF
  266. 220 CONTINUE
  267. * end do
  268. DO 230 IDE = 1,ICD
  269. XVAL = 0.D0
  270. DO 232 ID2 = 1,ICD
  271. XVAL = XVAL + (XMPT(IDE,ID2) * XDEP(ID2))
  272. 232 CONTINUE
  273. * end do
  274. IC = IDEP(IDE)
  275. VPOCHA(IP,IC) = XVAL
  276. 230 CONTINUE
  277. * end do
  278. IF (IDIM.EQ.3) THEN
  279. DO 240 IRO = 1,ICR
  280. XVAL = 0.D0
  281. DO 242 IR2 = 1,ICR
  282. XVAL = XVAL + (XMPT(IRO,IR2) * XROT(IR2))
  283. 242 CONTINUE
  284. * end do
  285. IC = IROT(IRO)
  286. VPOCHA(IP,IC) = XVAL
  287. 240 CONTINUE
  288. * end do
  289. ENDIF
  290. 210 CONTINUE
  291. * end do
  292. SEGDES MPOVAL
  293. SEGSUP MTRA2
  294. MAIL1 = IGEOC
  295. ICHCA(INS) = MAIL1
  296. IPT1 = MAIL1
  297. SEGINI,MELEME=IPT1
  298. NOMA1 = MELEME
  299. NBE = NUM(/2)
  300. NBPT = XCOOR(/1) / IDIM1
  301. NBPTS = NBPT + NBE
  302. SEGADJ MCOORD
  303. DO 82 IP = 1,NBE
  304. IPT = NUM(IP,1)
  305. CALL EXCOO1(IPT,XP,YP,ZP,DP)
  306. NBPT1 = NBPT + 1
  307. XPT(1) = XP
  308. XPT(2) = YP
  309. IF (IDIM.EQ.3) XPT(3) = ZP
  310. DO 84 ID1 = 1,IDIM
  311. XVAL = 0.D0
  312. DO 86 ID2 = 1,IDIM
  313. XVAL = XVAL + (XMPT(ID1,ID2) * XPT(ID2))
  314. 86 CONTINUE
  315. * end do
  316. XPTP(ID1) = XVAL + XP1PT(ID1)
  317. 84 CONTINUE
  318. * end do
  319. XCOOR(NBPT * IDIM1 + 1) = XPTP(1)
  320. XCOOR(NBPT * IDIM1 + 2) = XPTP(2)
  321. IF (IDIM.EQ.3) XCOOR(NBPT * IDIM1 + 3) = XPTP(3)
  322. XCOOR(NBPT1 * IDIM1) = DP
  323. NUM(IP,1) = NBPT1
  324. NBPT = NBPT1
  325. 82 CONTINUE
  326. * end do
  327. SEGDES MELEME
  328. IGEOC = NOMA1
  329. ICHCN(INS) = NOMA1
  330. ENDIF
  331. SEGDES MSOUPO
  332. 80 CONTINUE
  333. * end do
  334. SEGDES MCHPOI
  335. MTAB1.MTABIV(I1) = ICHDEP
  336. *
  337. IMAIL = ICHCA(1)
  338. INOMA = ICHCN(1)
  339. DO 40 INS = 2,NSOU
  340. MAIL1 = ICHCA(INS)
  341. NOMA1 = ICHCN(INS)
  342. ltelq=.false.
  343. CALL FUSE(INOMA,NOMA1,INOM2,ltelq)
  344. INOMA = INOM2
  345. CALL FUSE(IMAIL,MAIL1,IMAI2,ltelq)
  346. IMAIL = IMAI2
  347. 40 CONTINUE
  348. * end do
  349. *
  350. ICONT = 0
  351. DO 90 I1 = 1,LON1
  352. IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
  353. & MTAB1.MTABII(I1).EQ.LCHAIN(4) .AND.
  354. & MTAB1.MTABTV(I1).EQ.'MCHAML ') THEN
  355. ICHCON = MTAB1.MTABIV(I1)
  356. ICONT = 1
  357. GOTO 92
  358. ENDIF
  359. 90 CONTINUE
  360. * end do
  361. 92 CONTINUE
  362. KTRCHA = 0
  363. IF (ICONT.EQ.1) THEN
  364. MCHELM = ICHCON
  365. SEGACT MCHELM*MOD
  366. NSOUS = IMACHE(/1)
  367. SEGINI ITRCHA
  368. KTRCHA = ITRCHA
  369. DO 94 IN = 1,NSOUS
  370. IPT1 = IMACHE(IN)
  371. SEGINI,MELEME=IPT1
  372. NBN = NUM(/1)
  373. NBE = NUM(/2)
  374. DO 96 IE = 1,NBE
  375. DO 98 IP = 1,NBN
  376. IPO = NUM(IP,IE)
  377. CALL BAPOIN(IMAIL,IPO,INOMA,INOPO)
  378. IF (IERR.NE.0) RETURN
  379. NUM(IP,IE) = INOPO
  380. 98 CONTINUE
  381. * end do
  382. 96 CONTINUE
  383. * end do
  384. SEGDES MELEME
  385. ICHAM(IN) = MELEME
  386. IMACHE(IN) = MELEME
  387. 94 CONTINUE
  388. * end do
  389. SEGDES MCHELM
  390. MTAB1.MTABIV(I1) = ICHCON
  391. ENDIF
  392. *
  393. IF (MOTCLE.EQ.'ROTA') THEN
  394. DO 400 I1 = 1,LON1
  395. IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
  396. & MTAB1.MTABII(I1).EQ.LCHAIN(2) .AND.
  397. & MTAB1.MTABTV(I1).EQ.'TABLE ') THEN
  398. ITDEPG = MTAB1.MTABIV(I1)
  399. GOTO 402
  400. ENDIF
  401. 400 CONTINUE
  402. * end do
  403. CALL ERREUR(502)
  404. SEGDES MTAB1
  405. SEGDES MTABLE
  406. RETURN
  407. 402 CONTINUE
  408. *
  409. SEGINI MTRA3
  410. MTAB2 = ITDEPG
  411. SEGACT MTAB2
  412. LON2 = MTAB2.MLOTAB
  413. IDG = 1
  414. DO 410 I2 = 1,LON2
  415. IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
  416. & MTAB2.MTABII(I2).EQ.IDG .AND.
  417. & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
  418. XDGEN(IDG) = MTAB2.RMTABV(I2)
  419. IDG = IDG + 1
  420. ENDIF
  421. 410 CONTINUE
  422. * end do
  423. DO 420 ID1 = 1,IDIM
  424. XVAL = 0.D0
  425. DO 422 ID2 = 1,IDIM
  426. XVAL = XVAL + (XMPT(ID1,ID2) * XDGEN(ID2))
  427. 422 CONTINUE
  428. * end do
  429. XDGE2(ID1) = XVAL
  430. 420 CONTINUE
  431. * end do
  432. IDG = 1
  433. DO 430 I2 = 1,LON2
  434. IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
  435. & MTAB2.MTABII(I2).EQ.IDG .AND.
  436. & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
  437. MTAB2.RMTABV(I2) = XDGE2(IDG)
  438. IDG = IDG + 1
  439. ENDIF
  440. 430 CONTINUE
  441. * end do
  442. SEGDES MTAB2
  443. MTAB1.MTABIV(I1) = ITDEPG
  444. SEGSUP MTRA3
  445. ENDIF
  446. *
  447. IREAC = 0
  448. DO 790 I1 = 1,LON1
  449. IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
  450. & MTAB1.MTABII(I1).EQ.LCHAIN(5) .AND.
  451. & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
  452. ICHREA = MTAB1.MTABIV(I1)
  453. IREAC = 1
  454. GOTO 792
  455. ENDIF
  456. 790 CONTINUE
  457. * end do
  458. 792 CONTINUE
  459. IF (IREAC.EQ.1) THEN
  460. MCHPOI = ICHREA
  461. SEGACT MCHPOI
  462. NSOU2 = IPCHP(/1)
  463. DO 722 INS = 1,NSOU2
  464. MSOUPO = IPCHP(INS)
  465. SEGACT MSOUPO*MOD
  466. IF (MOTCLE.EQ.'ROTA') THEN
  467. SEGINI MTRA4
  468. MPOVAL = IPOVAL
  469. SEGACT MPOVAL
  470. NPOI2 = VPOCHA(/1)
  471. NCOM2 = VPOCHA(/2)
  472. DO 710 IP = 1,NPOI2
  473. ICF = 0
  474. ICM = 0
  475. DO 720 IC = 1,NCOM2
  476. COMP = NOCOMP(IC)
  477. IF (COMP(1:1).EQ.'F') THEN
  478. ICF = ICF + 1
  479. IFOR(ICF) = IC
  480. XFOR(ICF) = VPOCHA(IP,IC)
  481. ELSE IF (COMP(1:1).EQ.'M') THEN
  482. ICM = ICM + 1
  483. IMOM(ICM) = IC
  484. XMOM(ICM) = VPOCHA(IP,IC)
  485. ENDIF
  486. 720 CONTINUE
  487. * end do
  488. DO 730 IFO = 1,ICF
  489. XVAL = 0.D0
  490. DO 732 IF2 = 1,ICF
  491. XVAL = XVAL + XMPT(IFO,IF2) * XFOR(IF2)
  492. 732 CONTINUE
  493. * end do
  494. IC = IFOR(IFO)
  495. VPOCHA(IP,IC) = XVAL
  496. 730 CONTINUE
  497. * end do
  498. IF (IDIM.EQ.3) THEN
  499. DO 740 IMO = 1,ICM
  500. XVAL = 0.D0
  501. DO 742 IM2 = 1,ICM
  502. XVAL = XVAL + XMPT(IMO,IM2) * XROT(IM2)
  503. 742 CONTINUE
  504. * end do
  505. IC = IMOM(IMO)
  506. VPOCHA(IP,IC) = XVAL
  507. 740 CONTINUE
  508. * end do
  509. ENDIF
  510. 710 CONTINUE
  511. * end do
  512. SEGDES MPOVAL
  513. SEGSUP MTRA4
  514. ENDIF
  515. IPT1 = IGEOC
  516. SEGINI,MELEME=IPT1
  517. NBE = NUM(/2)
  518. NBP = NUM(/1)
  519. DO 750 IE = 1,NBE
  520. DO 752 IP = 1,NBP
  521. IPTS = NUM(IP,IE)
  522. CALL BAPOIN(IMAIL,IPTS,INOMA,INOPT)
  523. IF (IERR.NE.0) RETURN
  524. NUM(IP,IE) = INOPT
  525. 752 CONTINUE
  526. * end do
  527. 750 CONTINUE
  528. * end do
  529. SEGDES MELEME
  530. IGEOC = MELEME
  531. SEGDES MSOUPO
  532. 722 CONTINUE
  533. * end do
  534. SEGDES MCHPOI
  535. MTAB1.MTABIV(I1) = ICHREA
  536. ENDIF
  537. *
  538. SEGDES MTAB1
  539. MTABIV(I) = ITMOD
  540. *
  541. * On range le maillage dans la nouvelle table de modes
  542. *
  543. DO 42 I = 1,LONG
  544. IF (MTABTI(I).EQ.'MOT ' .AND.
  545. & MTABII(I).EQ.LCHAIN(13) .AND.
  546. & MTABTV(I).EQ.'MAILLAGE') THEN
  547. MTABIV(I) = INOMA
  548. GOTO 44
  549. ENDIF
  550. 42 CONTINUE
  551. * end do
  552. CALL ERREUR(503)
  553. SEGDES MTABLE
  554. RETURN
  555. 44 CONTINUE
  556. *
  557. SEGDES MTABLE
  558. *
  559. IMODE = 2
  560. CALL COPBA3(IBA2,MOTCLE,IMODE,IMAIL,INOMA,LCHAIN,KTRCHP,KTRCHA,
  561. & KTRAV,ICONT)
  562. IF (IERR.NE.0) RETURN
  563. *
  564. * Normalisation des modes
  565. *
  566. IF (MOTCLE.EQ.'ROTA') THEN
  567. CALL NORMOD(IBA2,LCHAIN)
  568. ENDIF
  569. *
  570. * Traitement de la table de pseudo-modes
  571. * ======================================
  572. *
  573. * On duplique la table des pseudo-modes
  574. *
  575. IF (IPSM.NE.0) THEN
  576. CALL COPBA2(LCHAIN,IPSM,IPS2)
  577. IMODE = 1
  578. CALL COPBA3(IPS2,MOTCLE,IMODE,IMAIL,INOMA,LCHAIN,KTRCHP,
  579. & KTRCHA,KTRAV,ICONT)
  580. IF (IERR.NE.0) RETURN
  581. *
  582. * On projecte les champs base B sur la base modale
  583. *
  584. CALL COPBA4(IBA2,IPS2)
  585. ENDIF
  586. *
  587. SEGSUP ITRCHP
  588. IF (ICONT.EQ.1) SEGSUP ITRCHA
  589. IF (MOTCLE.EQ.'ROTA') THEN
  590. SEGSUP MTRAV
  591. ENDIF
  592. *
  593. * Cr{ation de la table de sous-type BASE_MODALE
  594. *
  595. IF (IPSM.EQ.0) THEN
  596. M = 2
  597. ELSE
  598. M = 3
  599. ENDIF
  600. SEGINI MTABLE
  601. ITBA2 = MTABLE
  602. MLOTAB = M
  603. MTABTI(1) = 'MOT '
  604. MTABII(1) = LCHAIN(14)
  605. MTABTV(1) = 'MOT '
  606. MTABIV(1) = LCHAIN(15)
  607. MTABTI(2) = 'MOT '
  608. MTABII(2) = LCHAIN(11)
  609. MTABTV(2) = 'TABLE '
  610. MTABIV(2) = IBA2
  611. IF (IPSM.NE.0) THEN
  612. MTABTI(3) = 'MOT '
  613. MTABII(3) = LCHAIN(12)
  614. MTABTV(3) = 'TABLE '
  615. MTABIV(3) = IPS2
  616. ENDIF
  617. SEGDES MTABLE
  618. *
  619. * Traitement de la table des points
  620. * =================================
  621. *
  622. CALL CRTABL(ITPT2)
  623. IF (MOTCLE.EQ.'PLUS') THEN
  624. CALL ECCTAB(ITPT2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  625. & 'MOT',I1,X1,'POINT_PLUS',L1,IP1)
  626. ELSE
  627. CALL ECCTAB(ITPT2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  628. & 'MOT',I1,X1,'POINT_ROTA',L1,IP1)
  629. ENDIF
  630. IP = 0
  631. 50 CONTINUE
  632. IP = IP + 1
  633. TYPRET = ' '
  634. CALL ACCTAB(ITPTS,'ENTIER',IP,X0,' ',L0,IP0,
  635. & TYPRET,I1,X1,CHARRE,L1,IPTS)
  636. IF (IPTS.NE.0 .AND. TYPRET.EQ.'POINT ') THEN
  637. CALL BAPOIN(IMAIL,IPTS,INOMA,INOPT)
  638. IF (IERR.NE.0) RETURN
  639. CALL ECCTAB(ITPT2,'POINT',I0,X0,' ',L0,IPTS,
  640. & 'POINT',I1,X1,' ',L1,INOPT)
  641. GOTO 50
  642. ENDIF
  643. *
  644. * Cr{ation de la table de sortie
  645. *
  646. M = 3
  647. SEGINI MTABLE
  648. ITNOBA = MTABLE
  649. MLOTAB = 3
  650. MTABTI(1) = 'MOT '
  651. MTABII(1) = LCHAIN(14)
  652. MTABTV(1) = 'MOT '
  653. IF (MOTCLE.EQ.'PLUS') THEN
  654. MTABIV(1) = LCHAIN(17)
  655. ELSE
  656. MTABIV(1) = LCHAIN(16)
  657. ENDIF
  658. MTABTI(2) = 'MOT '
  659. MTABII(2) = LCHAIN(18)
  660. MTABTV(2) = 'TABLE '
  661. MTABIV(2) = ITBA2
  662. MTABTI(3) = 'MOT '
  663. MTABII(3) = LCHAIN(10)
  664. MTABTV(3) = 'TABLE '
  665. MTABIV(3) = ITPT2
  666. SEGDES MTABLE
  667. *
  668. CALL ECROBJ('TABLE ',ITNOBA)
  669. *
  670. END
  671.  
  672.  
  673.  
  674.  
  675.  

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