Télécharger projrg.eso

Retour à la liste

Numérotation des lignes :

  1. C PROJRG SOURCE PV 17/09/29 21:15:45 9578
  2. SUBROUTINE PROJRG(MRIGID,MTAB1,ITAB2,POS,RI1,RI2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. *
  6. ***********************************************************
  7. * PROJECTION D'UNE MATRICE SUR UNE BASE DE MODES *
  8. * _______________________________________________________ *
  9. * *
  10. * CREATION : Nicolas BENECH (11 Avril 1995) *
  11. * MODIFICATIONS : *
  12. * -18/11/2010 Benoit PRABEL : AMELIORATION PERFORMANCE *
  13. * -30/07/2014 Benoit PRABEL : ajout modes statiques *
  14. * + matrices de relations *
  15. * -18/11/2015 BP : calcul nbre de modes (pas a priori) *
  16. * _______________________________________________________ *
  17. * *
  18. * MODULE(S) APPELANT(S) : PJBA *
  19. * *
  20. * MODULE(S) APPELE(S) : ACCTAB, YTMX *
  21. * mucpri, corrsp, xty *
  22. * _______________________________________________________ *
  23. * *
  24. * EN ENTREE : *
  25. * MRIGID : Matrice a projeter *
  26. * MTAB1 : Base de modes, reels ou complexes *
  27. * 'REEL' : indique que l'on utilise le produit *
  28. * scalaire reel (pas de conjugaison) *
  29. * ITAB2 : Base de modes liaisons statiques *
  30. * *
  31. * EN SORTIE : *
  32. * RI1 : Matrice projetee (partie reelle) *
  33. * RI2 : Matrice projetee (partie imaginaire) *
  34. * _______________________________________________________ *
  35. * *
  36. * REMARQUE : *
  37. * L'operation realisee est : *
  38. * (MTAB1)t . MRIGID. MTAB1 *
  39. * Dans le cas complexe, la transposition est accompagnee *
  40. * de la conjugaison (si REEL n'est pas mentionne). *
  41. * L'operation realisee est : *
  42. ***********************************************************
  43. *
  44. -INC CCOPTIO
  45. -INC SMCHPOI
  46. -INC SMELEME
  47. -INC SMLCHPO
  48. -INC SMRIGID
  49. -INC SMTABLE
  50. -INC SMLMOTS
  51. pointeur IPLMOX.mlmots, IPLMOY.mlmots
  52. pointeur DES5.DESCR
  53. *
  54. * Declarations
  55. *
  56. REAL*8 XVAL, RMAX
  57. CHARACTER*8 LETYPE
  58. CHARACTER*8 TYPMOD,TYPRET,CHARRE
  59. LOGICAL MODCOM
  60. INTEGER I, J, NBMOD, POS, IREEL, IVALRE, IOBRE, isym
  61. REAL*8 XVALRE
  62. LOGICAL LOGRE
  63. CHARACTER*4 MO5
  64.  
  65.  
  66. ***********************************************************
  67. * INITIALISATIONS
  68. ***********************************************************
  69. *
  70. MODCOM = .FALSE.
  71. RI2 = 0
  72. * par defaut, on considere le vrai produit scalaire avec le conjugué
  73. * transposé y^H.M.x , mais avec POS=1, on prend seulement y^T.M.x
  74. IREEL = -1
  75. IF(POS.EQ.1) IREEL = 1
  76. *
  77. * recup de MTYMAT + symetrie / antisymetrie de la matrice a projeter
  78. segact,MRIGID
  79. LETYPE = MRIGID.MTYMAT
  80. NRIGEL=IRIGEL(/2)
  81. isym=IRIGEL(7,1)
  82. if(NRIGEL.le.1) goto 09
  83. do iel=2,NRIGEL
  84. if (isym.ne.IRIGEL(7,iel)) then
  85. isym=2
  86. goto 09
  87. endif
  88. enddo
  89. 09 CONTINUE
  90.  
  91.  
  92. ***********************************************************
  93. * ON SEPARE LA RIGIDITE EN 2 :
  94. * - RI4: partie rigidite "pure"
  95. * - RI5: partie relation cinematique
  96. * On ne traite que l'1 des 2 (RI4 par défaut)
  97. ***********************************************************
  98. IPRIG0 = MRIGID
  99. jmax = IRIGEL(/1)
  100. NRIG0 = NRIGEL
  101. segini,RI4,RI5
  102. nel4 = 0
  103. nel5 = 0
  104. iel4 = 0
  105. iel5 = 0
  106. do 1 iel=1,NRIGEL
  107. MELEME=IRIGEL(1,iel)
  108. segact,MELEME
  109. c rem : on teste ITYPEL,
  110. c mais on pourrait aussi tester LX comme dans SEPA.eso
  111. IF(ITYPEL.EQ.22) THEN
  112. nel5 = 1
  113. iel5 = iel5 + 1
  114. RI5.COERIG(iel5)=COERIG(iel)
  115. do j=1,jmax
  116. RI5.IRIGEL(j,iel5)=IRIGEL(j,iel)
  117. enddo
  118. ELSE
  119. nel4=1
  120. iel4 = iel4 + 1
  121. RI4.COERIG(iel4)=COERIG(iel)
  122. do j=1,jmax
  123. RI4.IRIGEL(j,iel4)=IRIGEL(j,iel)
  124. enddo
  125. ENDIF
  126. segdes,MELEME
  127. 1 continue
  128. segdes,MRIGID
  129. NRIGEL=iel5
  130. segadj,RI5
  131. NRIGEL=iel4
  132. segadj,RI4
  133.  
  134.  
  135. ***********************************************************
  136. * CREATION DE LA RIGIDITE CALCULEE
  137. ***********************************************************
  138. c IF(ITAB2.EQ.0) THEN
  139. c NRIGEL=nel4+nel5
  140. IF(ITAB2.EQ.0.and.nel4.eq.0) THEN
  141. NRIGEL=nel5
  142. ELSE
  143. c +en presence de Table de liaison statiques,
  144. c on ne traite pas les relations cinematiques
  145. * +si RI4 et Ri5, On ne traite que l'1 des 2 (RI4 par défaut)
  146. NRIGEL=nel4
  147. ENDIF
  148. SEGINI,RI1
  149. RI1.MTYMAT = LETYPE
  150. RI1.IFORIG = IFOMOD
  151. RI1.IMGEO1 = 0
  152. RI1.IMGEO2 = 0
  153. IRI1=0
  154.  
  155.  
  156. ************************************************************
  157. * TRAITEMENT DES MODES
  158. * + on prepare les MELEME + DESCR de sortie
  159. ***********************************************************
  160.  
  161. ***** BASE MODALE *****
  162.  
  163. LETYPE = ' '
  164. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'MODES',.TRUE.,0,
  165. & 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,MTAB2)
  166. IF (IERR.NE.0) RETURN
  167.  
  168. c c longueur a priori
  169. c SEGACT, MTAB2
  170. c NBMOD = MTAB2.MLOTAB-2
  171. c SEGDES, MTAB2
  172. c remplace par le calcul du vrai nombre de modes
  173. NBMOD = 0
  174. 11 CONTINUE
  175. NBMOD = NBMOD + 1
  176. TYPRET = ' '
  177. ITMOD=0
  178. CALL ACCTAB(MTAB2,'ENTIER',NBMOD,0.0D0,' ',.TRUE.,0,
  179. & TYPRET,IVALRE,XVALRE,CHARRE,LOGRE,ITMOD)
  180. IF(IERR.NE.0) RETURN
  181. IF(TYPRET.EQ.'TABLE ' .AND. ITMOD.NE.0) GOTO 11
  182. NBMOD = NBMOD - 1
  183. if(iimpi.ge.333) write(ioimp,*) 'nombre de modes=',NBMOD
  184.  
  185. *
  186. N1 = NBMOD
  187. SEGINI, MLCHP1
  188. SEGINI, MLCHP2
  189. *
  190. * Constitution du maillage support et du segment descriptif
  191. *
  192. NBNN = NBMOD
  193. NBELEM = 1
  194. NBSOUS = 0
  195. NBREF = 0
  196. SEGINI, MELEME
  197. * rem : ce itypel est faux, mais on arrive a vivre avec !
  198. ITYPEL = 1
  199. *
  200. NLIGRD=NBMOD
  201. NLIGRP=NBMOD
  202. nelrig=1
  203. SEGINI,DESCR
  204. *
  205. DO 10, I=1, NBMOD
  206. IPT1 = 0
  207. *
  208. CALL ACCTAB(MTAB2,'ENTIER',I,0.0D0,' ',.TRUE.,0,
  209. & 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,MTAB3)
  210. IF (IERR.NE.0) RETURN
  211. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  212. & 'MOT',IVALRE,XVALRE,TYPMOD,LOGRE,IOBRE)
  213. *
  214. * Le calcul est impossible :
  215. *
  216. IF (TYPMOD.EQ.'MODE_ANN') THEN
  217. IF (LETYPE.NE.'ANNULE') THEN
  218. WRITE (*,*) 'Calcul impossible : modes annules !!!'
  219. LETYPE = 'ANNULE'
  220. ENDIF
  221. GOTO 5
  222. ENDIF
  223. *
  224. * Cas reel ou cas complexe ?
  225. *
  226. IF (TYPMOD .EQ. 'MODE_COM') THEN
  227. MODCOM=.TRUE.
  228. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'DEFORMEE_MODALE_REELLE',
  229. & .TRUE.,0,'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPOI)
  230. MLCHP1.ICHPOI(I) = MCHPOI
  231. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'DEFORMEE_MODALE_IMAGINAIRE',
  232. & .TRUE.,0,'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPOI)
  233. MLCHP2.ICHPOI(I) = MCHPOI
  234. ELSE
  235. MODCOM = .FALSE.
  236. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'DEFORMEE_MODALE',.TRUE.,0,
  237. & 'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPOI)
  238. IF (IERR.NE.0) RETURN
  239. MLCHP1.ICHPOI(I) = MCHPOI
  240. ENDIF
  241. *
  242. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'POINT_REPERE',.TRUE.,0,
  243. & 'POINT',IVALRE,XVALRE,CHARRE,LOGRE,IPT1)
  244. IF (IERR.NE.0) RETURN
  245. *
  246. 5 MELEME.NUM(I,1)=IPT1
  247. *
  248. DESCR.LISINC(I) = 'ALFA'
  249. DESCR.LISDUA(I) = 'FALF'
  250. DESCR.NOELEP(I) = I
  251. DESCR.NOELED(I) = I
  252. *
  253. 10 CONTINUE
  254.  
  255.  
  256. ***** BASE LIAISONS STATIQUES *****
  257.  
  258. IF(ITAB2.EQ.0) GOTO 19
  259.  
  260. NBMOD1=NBMOD
  261. MTAB2=ITAB2
  262. SEGACT, MTAB2
  263. c c longueur a priori
  264. c NBMOD2 = MTAB2.MLOTAB-1
  265. c remplace par le calcul du vrai nombre de solutions statiques
  266. NBMOD2 = 0
  267. 13 NBMOD2 = NBMOD2 + 1
  268. TYPRET = ' '
  269. ITMOD=0
  270. CALL ACCTAB(MTAB2,'ENTIER',NBMOD2,0.0D0,' ',.TRUE.,0,
  271. & TYPRET,IVALRE,XVALRE,CHARRE,LOGRE,ITMOD)
  272. IF(IERR.NE.0) RETURN
  273. IF(TYPRET.EQ.'TABLE ' .AND. ITMOD.NE.0) GOTO 13
  274. NBMOD2 = NBMOD2 - 1
  275. if(iimpi.ge.333) write(ioimp,*) 'nombre de sol statiques=',NBMOD2
  276.  
  277. NBMOD = NBMOD1 + NBMOD2
  278. N1 =NBMOD
  279. NBNN =NBMOD
  280. NLIGRD=NBMOD
  281. NLIGRP=NBMOD
  282. SEGADJ,MLCHP1,MLCHP2,MELEME,DESCR
  283.  
  284. ITOT=NBMOD1
  285.  
  286. DO 12, I=1,NBMOD2
  287.  
  288.  
  289. CALL ACCTAB(MTAB2,'ENTIER',I,0.0D0,' ',.TRUE.,0,
  290. & 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,MTAB3)
  291. IF (IERR.NE.0) RETURN
  292.  
  293. c ici, on a une solution statique
  294. ITOT=ITOT+1
  295.  
  296. c DEFORMEE
  297. c modes statiques reels seulement !
  298. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'DEFORMEE',.TRUE.,0,
  299. & 'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPOI)
  300. IF (IERR.NE.0) RETURN
  301. MLCHP1.ICHPOI(ITOT) = MCHPOI
  302.  
  303. c POINT_REPERE
  304. CALL ACCTAB(MTAB3,'MOT',0,0.0D0,'POINT_REPERE',.TRUE.,0,
  305. & 'POINT',IVALRE,XVALRE,CHARRE,LOGRE,IPT1)
  306. IF (IERR.NE.0) RETURN
  307. MELEME.NUM(ITOT,1)=IPT1
  308.  
  309. c DESCR
  310. DESCR.LISINC(ITOT) = 'BETA'
  311. DESCR.LISDUA(ITOT) = 'FBET'
  312. DESCR.NOELEP(ITOT) = ITOT
  313. DESCR.NOELED(ITOT) = ITOT
  314.  
  315. 12 CONTINUE
  316.  
  317. SEGDES, MTAB2
  318.  
  319. ***** FIN DE TRAITEMENT DES BASES (MODALES ET STATIQUES) *****
  320.  
  321. 19 CONTINUE
  322. SEGDES, DESCR
  323. SEGDES, MELEME
  324. *
  325. * Constitution des segments XMATRI
  326. *
  327. NLIGRD=NBMOD
  328. NLIGRP=NBMOD
  329. *
  330. IF (LETYPE .EQ. 'ANNULE') THEN
  331. SEGINI, XMATR1
  332. IF (MODCOM) THEN
  333. SEGINI, XMATR2
  334. SEGDES, XMATR2
  335. ENDIF
  336. SEGDES, XMATR1
  337. GOTO 55
  338. ENDIF
  339.  
  340.  
  341. ***********************************************************
  342. * ON PROJETTE LA RIGIDITE "PURE" RI4
  343. ***********************************************************
  344.  
  345. IF(iel4.eq.0) GOTO 100
  346. MRIGID=RI4
  347. *
  348. * Cas reel
  349. *
  350. SEGINI, XMATR1
  351. if (isym.eq.0) then
  352. DO 20 J=1, NBMOD
  353. MCHPO2 = MLCHP1.ICHPOI(J)
  354. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  355. DO I=J, NBMOD
  356. MCHPO1 = MLCHP1.ICHPOI(I)
  357. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  358. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  359. XMATR1.RE(I,J,1)=XVAL
  360. XMATR1.RE(J,I,1)=XVAL
  361. ENDDO
  362. segsup,IPLMOX,IPLMOY
  363. segsup,MCHPO3
  364. MCHPO3=0
  365. 20 CONTINUE
  366. elseif (isym.eq.1) then
  367. DO 21 J=1, NBMOD
  368. XMATR1.RE(J,J,1)=0.D0
  369. if(J.ge.NBMOD) goto 21
  370. MCHPO2 = MLCHP1.ICHPOI(J)
  371. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  372. JP1=J+1
  373. DO I=JP1, NBMOD
  374. MCHPO1 = MLCHP1.ICHPOI(I)
  375. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  376. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  377. XMATR1.RE(I,J,1)=XVAL
  378. XMATR1.RE(J,I,1)=-1.D0*XVAL
  379. ENDDO
  380. segsup,IPLMOX,IPLMOY
  381. segsup,MCHPO3
  382. 21 CONTINUE
  383. else
  384. DO 22, J=1, NBMOD
  385. MCHPO2 = MLCHP1.ICHPOI(J)
  386. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  387. DO I=1, NBMOD
  388. MCHPO1 = MLCHP1.ICHPOI(I)
  389. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  390. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  391. XMATR1.RE(I,J,1)=XVAL
  392. ENDDO
  393. segsup,IPLMOX,IPLMOY
  394. segsup,MCHPO3
  395. 22 CONTINUE
  396. endif
  397. *
  398. * Cas complexe : calcul de termes complementaires
  399. *
  400. IF (MODCOM) THEN
  401. c partie reelle = phiR_i^T.M.phiR_j +/- phiI_i^T.M. phiI_j
  402. DO 30, J=1, NBMOD
  403. MCHPO2 = MLCHP2.ICHPOI(J)
  404. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  405. DO I=1, NBMOD
  406. MCHPO1 = MLCHP2.ICHPOI(I)
  407. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  408. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  409. XMATR1.RE(I,J,1)=XMATR1.RE(I,J,1)-IREEL*XVAL
  410. ENDDO
  411. segsup,IPLMOX,IPLMOY
  412. segsup,MCHPO3
  413. 30 CONTINUE
  414. * 2eme matrice (=partie imaginaire)
  415. c partie imaginaire = phiR_i^T.M.phiI_j -/+ phiI_i^T.M. phiR_j
  416. SEGINI,XMATR2
  417. DO 40, J=1, NBMOD
  418. MCHPO2 = MLCHP2.ICHPOI(J)
  419. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  420. DO I=1, NBMOD
  421. MCHPO1 = MLCHP1.ICHPOI(I)
  422. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  423. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  424. XMATR2.RE(I,J,1)=XVAL
  425. ENDDO
  426. segsup,IPLMOX,IPLMOY
  427. segsup,MCHPO3
  428. 40 CONTINUE
  429. DO 50, J=1, NBMOD
  430. MCHPO2 = MLCHP1.ICHPOI(J)
  431. CALL MUCPRI(MCHPO2,MRIGID,MCHPO3)
  432. DO I=1, NBMOD
  433. MCHPO1 = MLCHP2.ICHPOI(I)
  434. CALL CORRSP(MRIGID,MCHPO1,MCHPO3,IPLMOX,IPLMOY)
  435. CALL XTY1(MCHPO1,MCHPO3,IPLMOX,IPLMOY,XVAL)
  436. XMATR2.RE(I,J,1)=XMATR2.RE(I,J,1)+IREEL*XVAL
  437. ENDDO
  438. segsup,IPLMOX,IPLMOY
  439. segsup,MCHPO3
  440. 50 CONTINUE
  441. SEGDES,XMATR2
  442. ENDIF
  443. *
  444. 55 NELRIG = 1
  445.  
  446. * Stockage dans la rigidite calculee
  447. IRI1=IRI1+1
  448. RI1.COERIG(IRI1) = 1.D0
  449. RI1.IRIGEL(1,IRI1) = MELEME
  450. RI1.IRIGEL(2,IRI1) = 0
  451. RI1.IRIGEL(3,IRI1) = DESCR
  452. RI1.IRIGEL(4,IRI1) = xMATR1
  453. RI1.IRIGEL(5,IRI1) = NIFOUR
  454. RI1.IRIGEL(6,IRI1) = 0
  455. RI1.IRIGEL(7,IRI1) = isym
  456. xmatr1.symre=isym
  457. SEGDES,XMATR1
  458. RI1.IRIGEL(8,IRI1) = 0
  459. IF (MODCOM) THEN
  460. RI1.IRIGEL(7,1) = 2
  461. SEGINI, RI2 = RI1
  462. RI2.IRIGEL(4,IRI1) = xMATR2
  463. SEGDES, RI2
  464. ELSE
  465. RI2 = 0
  466. ENDIF
  467.  
  468. * Travail termine pour RI4.
  469.  
  470. * si RI4 et RI5 : On ne traite que l'1 des 2 (RI4 par défaut)
  471. IF(iel5.ne.0) THEN
  472. IF(IIMPI.ne.0) THEN
  473. WRITE(IOIMP,*) 'Présence de rigidites pures ',
  474. & 'et de relations cinematiques :'
  475. WRITE(IOIMP,*) 'On ne traite pas les relations cinematiques !'
  476. ENDIF
  477. GOTO 900
  478. ENDIF
  479.  
  480. 100 CONTINUE
  481. SEGSUP,RI4
  482.  
  483.  
  484. ***********************************************************
  485. * ON PROJETTE LES RELATIONS CINEMATIQUES RI5
  486. * rem : cela conduit a construire n rigidites-"relation"
  487. * de taille m*m -> pas forcement interessant...
  488. ***********************************************************
  489.  
  490. IF(iel5.eq.0) GOTO 900
  491. IF(ITAB2.NE.0) THEN
  492. WRITE(IOIMP,*) 'La syntaxe utilisee ne traite pas',
  493. & ' les relations cinematiques !'
  494. GOTO 900
  495. ENDIF
  496.  
  497. c Calcul de la projection d'une relation cinematique sur base modale
  498.  
  499. * recup de la matrice d entree
  500. NRIGEL=RI5.IRIGEL(/2)
  501. * DES2 = DESCR de sortie
  502. NLIGRD=NBMOD+1
  503. NLIGRP=NBMOD+1
  504. SEGINI,DES2
  505. DES2.LISINC(1)='LX'
  506. DES2.LISDUA(1)='FLX'
  507. DES2.NOELEP(1)=1
  508. DES2.NOELED(1)=1
  509. do i=2,NLIGRD
  510. DES2.LISINC(i)='ALFA'
  511. DES2.LISDUA(i)='FALF'
  512. DES2.NOELEP(i)=i
  513. DES2.NOELED(i)=i
  514. enddo
  515. SEGDES,DES2
  516. * maillage de sortie
  517. NBNN = NBMOD+1
  518. NBELEM = NRIGEL
  519. NBSOUS = 0
  520. NBREF = 0
  521. SEGINI,IPT2
  522. IPT2.ITYPEL = 22
  523. * XMATR3 de sortie
  524. NELRIG =NRIGEL
  525. SEGINI,XMATR3
  526.  
  527. * on branche et on remplit RI1
  528. IRI1 = IRI1 + 1
  529. RI1.COERIG(IRI1) = 1.D0
  530. RI1.IRIGEL(1,IRI1) = IPT2
  531. RI1.IRIGEL(3,IRI1) = DES2
  532. RI1.IRIGEL(4,IRI1) = XMATR3
  533. RI1.IRIGEL(5,IRI1) = RI5.IRIGEL(5,IRI1)
  534. RI1.IRIGEL(7,IRI1) = 0
  535. xmatr3.symre=0
  536.  
  537. SEGACT, MELEME
  538.  
  539. * --- Boucle sur les sous rigidites ---
  540. iel2=0
  541. DO 101 irig5=1,NRIGEL
  542.  
  543. * recup de la sous matrice d entree
  544. c xcoe5 = RI5.COERIG(irig5) =1 normalement !
  545. IPT5 = RI5.IRIGEL(1,irig5)
  546. DES5 = RI5.IRIGEL(3,irig5)
  547. XMATR5= RI5.IRIGEL(4,irig5)
  548. segact,IPT5,DES5,XMATR5
  549. NBEL5 = IPT5.NUM(/2)
  550. nddl5 = XMATR5.RE(/2)
  551.  
  552. c -- boucle sur les matrices elementaires --
  553. DO 102 iel5=1,NBEL5
  554.  
  555. * traitement de la sous matrice de sortie
  556. iel2 = iel2 + 1
  557. if(iel2.gt.NBELEM) then
  558. NBELEM=NBELEM+1
  559. segadj,IPT2
  560. NELRIG=NELRIG+1
  561. segadj,XMATR3
  562. endif
  563. c recopie du LX
  564. IPT2.NUM(1,iel2) = IPT5.NUM(1,iel5)
  565.  
  566. c boucle sur les modes
  567. DO 110 j=1,NBMOD
  568.  
  569. c point repere des modes et chpoint de deformee modale
  570. IPT2.NUM(j+1,iel2) = NUM(j,1)
  571. IPHI = MLCHP1.ICHPOI(j)
  572. XVALj = 0.d0
  573.  
  574. c boucle sur les ddls (non LX) de la relation en entree
  575. DO 120 k=2,nddl5
  576.  
  577. X5k = XMATR5.RE(1,k,iel5)
  578. c XPHIk = valeur de la jeme deformee modale au ddl u_k
  579. IP5 = DES5.NOELEP(k)
  580. IP5 = IPT5.NUM(IP5,iel5)
  581. MO5 = DES5.LISINC(k)
  582. CALL EXTRA9(IPHI,IP5,MO5,KERRE,XPHIk)
  583. XVALj = XVALj + X5k*XPHIk
  584.  
  585. 120 CONTINUE
  586.  
  587. XMATR3.RE(1,J+1,iel2) = XVALj
  588. XMATR3.RE(J+1,1,iel2) = XVALj
  589.  
  590. 110 CONTINUE
  591.  
  592. 102 CONTINUE
  593. SEGDES,IPT5,DES5,XMATR5
  594.  
  595. 101 CONTINUE
  596.  
  597. SEGDES,MELEME
  598. SEGDES,IPT2,XMATR3
  599.  
  600.  
  601.  
  602. ***********************************************************
  603. * MENAGE AVANT DE QUITTER
  604. ***********************************************************
  605. 900 CONTINUE
  606. SEGSUP,MLCHP1,MLCHP2
  607. SEGSUP,RI5
  608. SEGDES,RI1
  609. IF(RI2.NE.0) SEGDES,RI2
  610.  
  611. if(iimpi.ge.333) write(ioimp,*) 'RI1,RI2=',RI1,RI2
  612.  
  613. RETURN
  614. END
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  

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