Télécharger imped.eso

Retour à la liste

Numérotation des lignes :

  1. C IMPED SOURCE BP208322 17/01/25 21:17:06 9289
  2. SUBROUTINE IMPED
  3. *---------------------------------------------------------------------*
  4. * __________________________ *
  5. * | | *
  6. * | OPERATEUR IMPEDANCE | *
  7. * |________________________| *
  8. * *
  9. *---------------------------------------------------------------------*
  10. * *
  11. * SYNTAXE : *
  12. * *
  13. * *
  14. * RIG1 = IMPE RIG2 (RIG3) (REEL1)(| 'MASSE' | ) (FLAM); *
  15. * | 'RAIDEUR' | *
  16. * | 'AMORTISSEMENT' | *
  17. * | 'QUELCONQUE' LISREEL1 | *
  18. *
  19. * CREATION : DC 2004
  20. * MODIFS : #6131 BP 2008 : correction dans le cas 'AMOR' en Fourier
  21. * #6644 et #6653 BP 2010 : reecriture pour etre conforme au
  22. * partionnement des matrices
  23. * #6838 BP 2011 : reecriture car erreur lors de l assemblage si
  24. * non correspondance primale - duale
  25. * #7774 BP 05/2013 : extension au cas Fourier sur les ddls
  26. * symetriques seuls ( IMPE 'AMOR' C^n )
  27. * + large choix d'inconnues
  28. * + prise en compte des MULTiplicateurs LX
  29. *
  30. *---------------------------------------------------------------------*
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. *
  34. -INC SMRIGID
  35. -INC CCOPTIO
  36. -INC SMLREEL
  37. -INC SMLENTI
  38. -INC SMELEME
  39. -INC SMCOORD
  40. *
  41. EXTERNAL LONG
  42. PARAMETER(NBMO=24)
  43. CHARACTER*4 MOPRIM(NBMO),MODUAL(NBMO)
  44. CHARACTER*4 MOPRII(NBMO),MODUAI(NBMO)
  45. CHARACTER*4 LISMOT(4),LISMO2(1)
  46. CHARACTER*4 MOTEMP
  47. CHARACTER*8 LISMO3(3)
  48. REAL*8 XOME,COEFA,COEFB,COEFC,COEFD,XCOEF2
  49. LOGICAL FLAGFO,FLUT,FLRI23
  50. CHARACTER*4 MOP1,MOD1,MOP2,MOD2,MOP3,MOD3
  51. *
  52. * on utilise les noms reels NOMDD et NOMDU de CCHAMP (cf bdata)
  53. DATA MOPRIM / 'UX ','UY ','UZ ','UR ','UZ ','UT ',
  54. . 'RX ','RY ','RZ ','RT ','RS ','ALFA',
  55. . 'P ','PI ','BETA','FBET','T ','RR ',
  56. . 'TINF','TSUP','TH ','FC ','PQ ','TP '/
  57. DATA MODUAL / 'FX ','FY ','FZ ','FR ','FZ ','FT ',
  58. . 'MX ','MY ','MZ ','MT ','MS ','FALF',
  59. . 'FP ','FPI ','FBET','BETA','Q ','MR ',
  60. . 'QINF','QSUP','FLUX','ED ','FPQ ','FTP '/
  61. * on definit les noms imaginaires correspondants
  62. DATA MOPRII / 'IUX ','IUY ','IUZ ','IUR ','IUZ ','IUT ',
  63. . 'IRX ','IRY ','IRZ ','IRT ','IRS ','IALF',
  64. . 'IP ','IPI ','IBET','IFBE','IT ','IRR ',
  65. . 'ITIN','ITSU','ITH ','IFC ','IPQ ','ITP '/
  66. DATA MODUAI / 'IFX ','IFY ','IFZ ','IFR ','IFZ ','IFT ',
  67. . 'IMX ','IMY ','IMZ ','IMT ','IMS ','IFAL',
  68. . 'IFP ','IFPI','IFBE','IBET','IQ ','IMR ',
  69. . 'IQIN','IQSU','IFLU','IED ','IFPQ','IFTP'/
  70. DATA LISMOT/ 'MASS','RAID','AMOR','QUEL'/
  71. DATA LISMO2/ 'FLAM'/
  72. DATA LISMO3/ 'MASSE ','RIGIDITE','AMOR '/
  73. *
  74. *
  75. *---- Initialisations et lectures des objets -------------------------*
  76. *
  77. IRET = 1
  78. idimp1=IDIM+1
  79. *
  80. * Matrices
  81. *
  82. CALL LIROBJ('RIGIDITE',IPOIR2,1,IRETOU)
  83. IF(IRETOU.EQ.0) RETURN
  84. *
  85. CALL LIROBJ('RIGIDITE',IPOIR3,0,IRETOU)
  86. IF (IRETOU.NE.0) THEN
  87. FLAGFO = .true.
  88. ELSE
  89. FLAGFO = .false.
  90. ENDIF
  91. *
  92. * Coef multiplicatif (Vitesse de Rotation par ex.)
  93. XOME=1.D0
  94. CALL LIRREE(XOME,0,IRETOX)
  95. *
  96. * Quel Cas ? 'MASS','RAID','AMOR','QUEL'?
  97. NUMLIS = 0
  98. CALL LIRMOT(LISMOT,4,NUMLIS,0)
  99. *
  100. * Quel type de matrice en sortie ?
  101. NUMLI2 = 0
  102. CALL LIRMOT(LISMO2,1,NUMLI2,0)
  103. IFLAM=0
  104. IF(NUMLI2.EQ.1) IFLAM = 1
  105. *
  106. * Dans le cas quelconque, on a besoin d une listreel
  107. IF (NUMLIS.EQ.4) THEN
  108. if (FLAGFO) then
  109. write(6,*) 'Le cas QUELconque ne fonctionne qu avec'
  110. & ,' 1 matrice en entrée actuellement (et pas 2) !!!'
  111. call erreur (19)
  112. return
  113. endif
  114. CALL LIROBJ('LISTREEL',ICOEF,1,IRETOU)
  115. MLREEL =ICOEF
  116. SEGACT MLREEL
  117. NCOEF = PROG(/1)
  118. if (NCOEF.lt.4) then
  119. write(6,*) 'Le cas QUELconque ne fonctionne qu avec'
  120. & ,' 1 listreel d au moins 4 valeurs !!!'
  121. call erreur (21)
  122. return
  123. endif
  124. COEFA = PROG(1)
  125. COEFB = PROG(2)
  126. COEFC = PROG(3)
  127. COEFD = PROG(4)
  128. SEGDES MLREEL
  129. ENDIF
  130. *
  131. *
  132. *---- Activation de(s) matrice(s) d'entree -------------------------*
  133. *
  134. RI2 = IPOIR2
  135. SEGACT RI2
  136. NRIGE2 = RI2.IRIGEL(/1)
  137. NRIGEL2= RI2.IRIGEL(/2)
  138.  
  139. IF (FLAGFO) THEN
  140. RI3 = IPOIR3
  141. SEGACT RI3
  142. NRIGE3 = RI3.IRIGEL(/1)
  143. NRIGEL3= RI3.IRIGEL(/2)
  144. * Tests de Compatibilité avec RI2
  145. * BP: on decide de n'en garder que tres peu
  146. IF ( ((RI2.MTYMAT).NE.(RI3.MTYMAT)) .or.
  147. & ((RI2.IFORIG).NE.(RI3.IFORIG)) ) THEN
  148. WRITE(6,*) 'Plantage: RIGIDITES non compatibles !!!'
  149. WRITE(6,*) 'MTYMAT,IFORIG'
  150. WRITE(6,*) (RI2.MTYMAT),(RI2.IFORIG)
  151. WRITE(6,*) (RI3.MTYMAT),(RI3.IFORIG)
  152. call erreur (21)
  153. RETURN
  154. ENDIF
  155. * FLRI23 = meme support entre RI2 et RI3 ?
  156. FLRI23=.false.
  157. if(NRIGEL2.ne.NRIGEL3) goto 23
  158. do k=1,NRIGEL2
  159. if((RI2.irigel(1,k)).ne.(RI3.irigel(1,k))) goto 23
  160. if((RI2.irigel(2,k)).ne.(RI3.irigel(2,k))) goto 23
  161. if((RI2.coerig(k)).ne.(RI3.coerig(k))) goto 23
  162. enddo
  163. FLRI23=.true.
  164. 23 continue
  165. ELSE
  166. * on n a pas lu de 2eme matrice RI3 : on utilise RI2
  167. RI3=RI2
  168. FLRI23=.true.
  169. NRIGE3 = NRIGE2
  170. NRIGEL3= NRIGEL2
  171. ENDIF
  172. *
  173. *
  174. *---- Quel Cas ? 1='MASS',2='RAID',3='AMOR',4='QUEL'? --------------*
  175. *
  176. * si on lu un mot clé, on lutilise
  177. IF (NUMLIS.NE.0) THEN
  178. ICAS = NUMLIS
  179. ELSE
  180. * sinon par defaut on va faire une IMPEDANCE 'RAIDEUR' [K 0 ; 0 K]
  181. ICAS = 2
  182. * sauf si on a reconnu le type de la matrice d entree,
  183. * auquel cas on choisit le cas le + vraisemblable
  184. IF ((RI2.MTYMAT).EQ.LISMO3(3)) THEN
  185. ICAS = 3
  186. ELSEIF ((RI2.MTYMAT).EQ.LISMO3(1)) THEN
  187. ICAS = 1
  188. ELSEIF ((RI2.MTYMAT).EQ.LISMO3(2)) THEN
  189. ICAS = 2
  190. ENDIF
  191. ENDIF
  192. *
  193. if(IRETOX.ne.0.and.ICAS.eq.2) write(6,*) 'Cas Raideur:'
  194. & ,' Le coefficient multiplicatif n est pas pris en compte !!!'
  195. *
  196. *
  197. *---- on verifie que l'on n'a pas de multiplicateur
  198. * dans les cas autres que RAIDEUR ------------------------------*
  199. *
  200. IF (ICAS.NE.2) THEN
  201. DO 24 k=1,NRIGEL2
  202. ipt2 = RI2.IRIGEL(1,k)
  203. segact,ipt2
  204. c detection des elements de type MULTiplicateur de Lagrange
  205. if (ipt2.itypel.eq.22) then
  206. write(ioimp,*) 'Les liaisons avec MULTiplicateur ne sont'
  207. & ,' compatibles qu avec l option RAIDEUR de IMPE'
  208. call ERREUR(19)
  209. RETURN
  210. endif
  211. segdes,ipt2
  212. 24 CONTINUE
  213. ENDIF
  214.  
  215. *
  216. *
  217. *---- Creation de la matrice de sortie ----------------------------*
  218. *
  219. NRIGE = NRIGE2
  220. if (ICAS.eq.1.or.ICAS.eq.2) then
  221. NRIGEL = NRIGEL2 + NRIGEL3
  222. elseif (ICAS.eq.4) then
  223. NRIGEL = NRIGEL2
  224. else
  225. if (FLRI23) then
  226. NRIGEL = NRIGEL2
  227. else
  228. if(iimpi.ge.1) write(ioimp,*) 'supports incompatibles !'
  229. NRIGEL = NRIGEL2 + NRIGEL3
  230. endif
  231. endif
  232. *
  233. SEGINI,RI1
  234. * Pour les besoins d une analyse de 'FLAM'bage on ecrit matrice de type masse
  235. IF (IFLAM.EQ.1) THEN
  236. RI1.MTYMAT = LISMO3(1)
  237. ELSE
  238. RI1.MTYMAT = RI2.MTYMAT
  239. ENDIF
  240. RI1.IFORIG = RI2.IFORIG
  241. *
  242. *
  243. *---- Aiguillage selon le cas ----------------------------------------*
  244. *
  245. * MASS,RAID,AMOR,QUEL
  246. GOTO ( 100, 200, 300, 400),ICAS
  247. *
  248. *
  249. *---- Cas MASS [-M 0 ; 0 -M] ----------------------------------------*
  250. 100 CONTINUE
  251.  
  252. *---- 1er quadrant ----
  253. *-----Boucle sur les matrices de rigidite elementaires de RI2
  254. DO 101 IMA=1,NRIGEL2
  255.  
  256. IMA1 = IMA
  257. * COERIG
  258. XCOEF2 = (XOME**2) * RI2.COERIG(IMA)
  259. RI1.COERIG(IMA1) = -1.D0 * XCOEF2
  260. * IRIGEL(1,:)= meleme
  261. RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  262. RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  263. * IRIGEL(3,:) = descr
  264. DES2 = RI2.IRIGEL(3,IMA)
  265. RI1.IRIGEL(3,IMA1) = DES2
  266. * IRIGEL(4,:) = XMATRI
  267. RI1.IRIGEL(4,IMA1) = RI2.IRIGEL(4,IMA)
  268. * IRIGEL(5,:) = nhar
  269. RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  270. * IRIGEL(6,:) = < = >
  271. RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  272. * IRIGEL(7,:) = symetrie
  273. RI1.IRIGEL(7,IMA1) = RI2.IRIGEL(7,IMA)
  274.  
  275. 101 CONTINUE
  276. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  277.  
  278.  
  279. *---- 4eme quadrant ----
  280. *-----Boucle sur les matrices de rigidite elementaires de RI3
  281. DO 102 IMA=1,NRIGEL3
  282.  
  283. IMA1 = NRIGEL2 + IMA
  284. * COERIG
  285. XCOEF3 = (XOME**2) * RI3.COERIG(IMA)
  286. RI1.COERIG(IMA1) = -1.D0 * XCOEF3
  287. * IRIGEL(1,:)= meleme
  288. RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  289. RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  290. * IRIGEL(3,:) = descr
  291. DES3 = RI3.IRIGEL(3,IMA)
  292. segact,DES3
  293. NLIGRP= DES3.LISINC(/2)
  294. NLIGRD= DES3.LISDUA(/2)
  295. segini,DES1=DES3
  296. * on change le nom des Primal
  297. do 112 ILIGRP = 1,NLIGRP
  298. MOP3=DES3.LISINC(ILIGRP)
  299. do IBMO = 1,NBMO
  300. if (MOP3.eq.(MOPRIM(IBMO))) then
  301. DES1.LISINC(ILIGRP) = MOPRII(IBMO)
  302. goto 112
  303. endif
  304. enddo
  305. LMOP3=LONG(MOP3)
  306. if(LMOP3.ge.4) then
  307. write(ioimp,*) 'Pas de composante imaginaire connue ',
  308. & 'associée à ',MOP3
  309. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  310. & 'primale standard ou de moins de 4 caracteres'
  311. MOTERR(1:4)=MOP3
  312. call erreur(108)
  313. RETURN
  314. endif
  315. c on construit un nom imaginaire a partir du nom fourni
  316. write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  317. write(ioimp,*) '!!! On définit par défaut ',MOP1,
  318. & ' comme inconnue imaginaire de ',MOP3
  319. DES1.LISINC(ILIGRP) = MOP1
  320. 112 continue
  321. * on change le nom des Dual
  322. do 121 ILIGRD = 1,NLIGRD
  323. MOD3=DES3.LISDUA(ILIGRD)
  324. if(MOD3.eq.'FLX ') goto 121
  325. do IBMO = 1,NBMO
  326. if (MOD3.eq.(MODUAL(IBMO))) then
  327. DES1.LISDUA(ILIGRD) = MODUAI(IBMO)
  328. goto 121
  329. endif
  330. enddo
  331. LMOD3=LONG(MOD3)
  332. if(LMOD3.ge.4) then
  333. write(ioimp,*) 'Pas de composante imaginaire connue ',
  334. & 'associée à ',MOD3
  335. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  336. & 'duale standard ou de moins de 4 caracteres'
  337. MOTERR(1:4)=MOD3
  338. call erreur(108)
  339. RETURN
  340. endif
  341. c on construit un nom imaginaire a partir du nom fourni
  342. write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  343. write(ioimp,*) '!!! On définit par défaut ',MOD1,
  344. & ' comme inconnue imaginaire de ',MOD3
  345. DES1.LISDUA(ILIGRD) = MOD1
  346. 121 continue
  347. segdes,DES3,DES1
  348. RI1.IRIGEL(3,IMA1) = DES1
  349. * IRIGEL(4,:) = XMATRI
  350. RI1.IRIGEL(4,IMA1) = RI3.IRIGEL(4,IMA)
  351. * IRIGEL(5,:) = +nhar
  352. RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  353. * IRIGEL(6,:) = < = >
  354. RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  355. * IRIGEL(7,:) = symetrie
  356. RI1.IRIGEL(7,IMA1) = RI3.IRIGEL(7,IMA)
  357.  
  358. 102 CONTINUE
  359. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  360.  
  361. GOTO 900
  362. *
  363. *
  364. *---- Cas RAID [K 0 ; 0 K] ----------------------------------------*
  365. 200 CONTINUE
  366.  
  367. *---- 1er quadrant ----
  368. *-----Boucle sur les matrices de rigidite elementaires de RI2
  369. DO 201 IMA=1,NRIGEL2
  370.  
  371. IMA1 = IMA
  372. * COERIG
  373. XCOEF2 = RI2.COERIG(IMA)
  374. RI1.COERIG(IMA1) = XCOEF2
  375. * IRIGEL(1,:)= meleme
  376. RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  377. RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  378. * IRIGEL(3,:) = descr
  379. DES2 = RI2.IRIGEL(3,IMA)
  380. RI1.IRIGEL(3,IMA1) = DES2
  381. * IRIGEL(4,:) = XMATRI
  382. RI1.IRIGEL(4,IMA1) = RI2.IRIGEL(4,IMA)
  383. * IRIGEL(5,:) = nhar
  384. RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  385. * IRIGEL(6,:) = < = >
  386. RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  387. * IRIGEL(7,:) = symetrie
  388. RI1.IRIGEL(7,IMA1) = RI2.IRIGEL(7,IMA)
  389.  
  390. 201 CONTINUE
  391. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  392.  
  393.  
  394. *---- 4eme quadrant ----
  395. *-----Boucle sur les matrices de rigidite elementaires de RI3
  396. DO 202 IMA=1,NRIGEL3
  397.  
  398. IMA1 = NRIGEL2 + IMA
  399. * COERIG
  400. XCOEF3 = RI3.COERIG(IMA)
  401. RI1.COERIG(IMA1) = XCOEF3
  402. * IRIGEL(1,:)= meleme
  403. RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  404. cbp RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  405. cbp .....debut modif du meleme .........................................
  406. cbp : s'il s'agit d'une relation avec multiplicateur, il est peut etre
  407. c deja utilise (en tout cas comme on a changé les noms dinconnue,
  408. c il y a un risque de le retrouver dans une autre matrice)
  409. c => par securite, on duplique le noeud associe au LX
  410. IPT3 = RI3.IRIGEL(1,IMA)
  411. segact,IPT3
  412. IF(IPT3.ITYPEL.eq.22) THEN
  413. segact,MCOORD*mod
  414. segini,IPT1=IPT3
  415. c on suppose le LX en 1ere position (comme toujours a priori)
  416. nmult = IPT3.NUM(/2)
  417. IP1 = XCOOR(/1) / idimp1
  418. NBPTS = IP1 + nmult
  419. segadj,MCOORD
  420. DO jmult=1,nmult
  421. c creation d'un nouveau point associé au LX
  422. IP3 = IPT3.NUM(1,jmult)
  423. iref3 = (IP3-1)*idimp1
  424. iref1 = IP1 *idimp1
  425. XCOOR(iref1 +1) = XCOOR(iref3 +1)
  426. XCOOR(iref1 +2) = XCOOR(iref3 +2)
  427. if(idim.eq.3) XCOOR(iref1 +3) = XCOOR(iref3 +3)
  428. XCOOR(iref1 + idimp1) = XCOOR(iref3 + idimp1)
  429. IP1 = IP1 + 1
  430. IPT1.NUM(1,jmult) = IP1
  431. ENDDO
  432. segdes,IPT1,IPT3
  433. RI1.IRIGEL(1,IMA1) = IPT1
  434. ELSE
  435. segdes,IPT3
  436. RI1.IRIGEL(1,IMA1) = IPT3
  437. ENDIF
  438. cbp .....fin modif du meleme ..........................................
  439. * IRIGEL(3,:) = descr
  440. DES3 = RI3.IRIGEL(3,IMA)
  441. segact,DES3
  442. NLIGRP= DES3.LISINC(/2)
  443. NLIGRD= DES3.LISDUA(/2)
  444. segini,DES1=DES3
  445. * on change le nom des Primal
  446. do 212 ILIGRP = 1,NLIGRP
  447. MOP3=DES3.LISINC(ILIGRP)
  448. c on ne change pas le nom des inconnues LX, mais leur noeud
  449. if(MOP3.eq.'LX ') goto 212
  450. do IBMO = 1,NBMO
  451. if (MOP3.eq.(MOPRIM(IBMO))) then
  452. DES1.LISINC(ILIGRP) = MOPRII(IBMO)
  453. goto 212
  454. endif
  455. enddo
  456. LMOP3=LONG(MOP3)
  457. if(LMOP3.ge.4) then
  458. write(ioimp,*) 'Pas de composante imaginaire connue ',
  459. & 'associée à ',MOP3
  460. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  461. & 'primale standard ou de moins de 4 caracteres'
  462. MOTERR(1:4)=MOP3
  463. call erreur(108)
  464. RETURN
  465. endif
  466. c on construit un nom imaginaire a partir du nom fourni
  467. write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  468. write(ioimp,*) '!!! On définit par défaut ',MOP1,
  469. & ' comme inconnue imaginaire de ',MOP3
  470. DES1.LISINC(ILIGRP) = MOP1
  471. 212 continue
  472. * on change le nom des Dual
  473. do 221 ILIGRD = 1,NLIGRD
  474. MOD3=DES3.LISDUA(ILIGRD)
  475. if(MOD3.eq.'FLX ') goto 221
  476. do IBMO = 1,NBMO
  477. if (MOD3.eq.(MODUAL(IBMO))) then
  478. DES1.LISDUA(ILIGRD) = MODUAI(IBMO)
  479. goto 221
  480. endif
  481. enddo
  482. LMOD3=LONG(MOD3)
  483. if(LMOD3.ge.4) then
  484. write(ioimp,*) 'Pas de composante imaginaire connue ',
  485. & 'associée à ',MOD3
  486. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  487. & 'duale standard ou de moins de 4 caracteres'
  488. MOTERR(1:4)=MOD3
  489. call erreur(108)
  490. RETURN
  491. endif
  492. c on construit un nom imaginaire a partir du nom fourni
  493. write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  494. write(ioimp,*) '!!! On définit par défaut ',MOD1,
  495. & ' comme inconnue imaginaire de ',MOD3
  496. DES1.LISDUA(ILIGRD) = MOD1
  497. 221 continue
  498. segdes,DES3,DES1
  499. RI1.IRIGEL(3,IMA1) = DES1
  500. * IRIGEL(4,:) = XMATRI
  501. RI1.IRIGEL(4,IMA1) = RI3.IRIGEL(4,IMA)
  502. * IRIGEL(5,:) = +nhar
  503. RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  504. * IRIGEL(6,:) = < = >
  505. RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  506. * IRIGEL(7,:) = symetrie
  507. RI1.IRIGEL(7,IMA1) = RI3.IRIGEL(7,IMA)
  508.  
  509. 202 CONTINUE
  510. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  511.  
  512. GOTO 900
  513.  
  514. *
  515. *---- Cas AMOR [0 -C ; C 0] ----------------------------------------*
  516. 300 CONTINUE
  517. *
  518. *---- 2eme quadrant = -\bar{C} ----
  519.  
  520. *-----Boucle sur les matrices de rigidite elementaires de RI2
  521. DO 301 IMA=1,NRIGEL2
  522.  
  523. IMA1 = IMA
  524. * COERIG
  525. XCOEF2 = XOME * RI2.COERIG(IMA)
  526. RI1.COERIG(IMA1) = XCOEF2
  527. * IRIGEL(1,:)= meleme
  528. RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  529. RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  530.  
  531. * IRIGEL(3,:) = descr
  532. DES2 = RI2.IRIGEL(3,IMA)
  533. segact,DES2
  534. NLIGRP= DES2.LISINC(/2)
  535. NLIGRD= DES2.LISDUA(/2)
  536. if (NLIGRP.ne.NLIGRD) then
  537. call ERREUR(756)
  538. return
  539. endif
  540. * on crée un nouveau DESCR 2 fois plus long
  541. segini,DES1=DES2
  542. NLIG = NLIGRP
  543. NLIGRP = 2 * NLIG
  544. NLIGRD = 2 * NLIG
  545. segadj,DES1
  546. * on ajoute les noeuds + les noms de la partie imaginaire
  547. do 311 ILIG = 1,NLIG
  548. DES1.NOELEP(NLIG+ILIG) = DES1.NOELEP(ILIG)
  549. DES1.NOELED(NLIG+ILIG) = DES1.NOELED(ILIG)
  550. MOP2 = DES2.LISINC(ILIG)
  551. do IBMO = 1,NBMO
  552. if (MOP2.eq.(MOPRIM(IBMO))) then
  553. if ((DES2.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  554. write(6,*) 'non concordance entre l inconnue primale '
  555. write(6,*) MOP2,' et duale ',DES2.LISDUA(ILIG)
  556. call erreur(717)
  557. return
  558. endif
  559. if ((DES2.NOELEP(ILIG)).ne.(DES2.NOELED(ILIG))) then
  560. write(6,*) 'non concordance entre le noeud primal '
  561. write(6,*) DES2.NOELEP(ILIG),' et dual ',DES2.NOELED(ILIG)
  562. call erreur(717)
  563. return
  564. endif
  565. * on ajoutes les inconnues imaginaires + les noeuds associés
  566. DES1.LISINC(NLIG+ILIG) = MOPRII(IBMO)
  567. DES1.LISDUA(NLIG+ILIG) = MODUAI(IBMO)
  568. goto 311
  569. endif
  570. enddo
  571. c on n'a pas trouve le primal dans la liste,
  572. c on fabrique les noms primal et dual maginaire depuis reel
  573. c la concordance n'est plus assuree
  574. LMOP2=LONG(MOP2)
  575. if(LMOP2.ge.4) then
  576. write(ioimp,*) 'Pas de composante imaginaire connue ',
  577. & 'associée à ',MOP2
  578. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  579. & 'primale standard ou de moins de 4 caracteres'
  580. MOTERR(1:4)=MOP2
  581. call erreur(108)
  582. RETURN
  583. endif
  584. c on construit un nom imaginaire a partir du nom fourni
  585. write(MOP1,FMT='(A,A)') 'I',MOP2(1:3)
  586. write(ioimp,*) '!!! On définit par défaut ',MOP1,
  587. & ' comme inconnue imaginaire de ',MOP2
  588. DES1.LISINC(NLIG+ILIG) = MOP1
  589. c idem pour le dual
  590. MOD2=DES2.LISDUA(ILIG)
  591. LMOD2=LONG(MOD2)
  592. if(LMOD2.ge.4) then
  593. write(ioimp,*) 'Pas de composante imaginaire connue ',
  594. & 'associée à ',MOD2
  595. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  596. & 'duale standard ou de moins de 4 caracteres'
  597. MOTERR(1:4)=MOD2
  598. call erreur(108)
  599. RETURN
  600. endif
  601. c on construit un nom imaginaire a partir du nom fourni
  602. write(MOD1,FMT='(A,A)') 'I',MOD2(1:3)
  603. write(ioimp,*) '!!! On définit par défaut ',MOD1,
  604. & ' comme inconnue duale imaginaire de ',MOD2
  605. DES1.LISDUA(NLIG+ILIG) = MOD1
  606. 311 continue
  607. segdes,DES1
  608. RI1.IRIGEL(3,IMA1) = DES1
  609.  
  610. * on regarde si UT existe
  611. FLUT= .false.
  612. JG = NLIG
  613. segini,MLENTI
  614. IF (FLAGFO) THEN
  615. do ILIG = 1,NLIG
  616. cbp if ((DES2.LISINC(ILIG)).eq.'UT ') then
  617. MOTEMP=DES2.LISINC(ILIG)
  618. if (MOTEMP.eq.'UT '.OR.MOTEMP.eq.'IUT ') then
  619. LECT(ILIG) = 1
  620. FLUT= .true.
  621. endif
  622. enddo
  623. ENDIF
  624. segdes,DES2
  625.  
  626. * IRIGEL(4,:) = XMATRI
  627. * on cree une nouvelle matrice
  628. XMATR2 = RI2.IRIGEL(4,IMA)
  629. segact,XMATR2
  630. NELRIG = XMATR2.RE(/3)
  631. segini,XMATR1
  632. IF (FLUT) THEN
  633. * -- 2eme quadrant = -\bar{C} --
  634. do j=1,NLIG
  635. j1 = NLIG+j
  636. if (LECT(j).eq.1) then
  637. * la colonne j pointe vers la composante UT
  638. do i=1,NLIG
  639. do k=1,NELRIG
  640. XMATR1.RE(i,j1,k) = XMATR2.RE(i,j,k)
  641. enddo
  642. enddo
  643. else
  644. do i=1,NLIG
  645. do k=1,NELRIG
  646. XMATR1.RE(i,j1,k) = -1.D0 * XMATR2.RE(i,j,k)
  647. enddo
  648. enddo
  649. endif
  650. enddo
  651. ELSE
  652. * -- 2eme quadrant = -{C} --
  653. do k=1,NELRIG
  654. do j=1,NLIG
  655. j1 = NLIG+j
  656. do i=1,NLIG
  657. XMATR1.RE(i,j1,k) = -1.D0 * XMATR2.RE(i,j,k)
  658. enddo
  659. enddo
  660. enddo
  661. ENDIF
  662. * si possible, tous les quadrants dans la meme sous-rigidite
  663. if (FLRI23) then
  664. XMATR3 = RI3.IRIGEL(4,IMA)
  665. segact,XMATR3
  666. IF (FLUT) THEN
  667. * -- 3eme quadrant = +\bar{C} --
  668. do j=1,NLIG
  669. if (LECT(j).eq.1) then
  670. * la colonne j pointe vers la composante UT
  671. do i=1,NLIG
  672. i1 = NLIG+i
  673. do k=1,NELRIG
  674. XMATR1.RE(i1,j,k) = -1.D0 * XMATR3.RE(i,j,k)
  675. enddo
  676. enddo
  677. else
  678. do i=1,NLIG
  679. i1 = NLIG+i
  680. do k=1,NELRIG
  681. XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  682. enddo
  683. enddo
  684. endif
  685. enddo
  686. ELSE
  687. * -- 3eme quadrant = +{C} --
  688. do k=1,NELRIG
  689. do j=1,NLIG
  690. do i=1,NLIG
  691. i1 = NLIG+i
  692. XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  693. enddo
  694. enddo
  695. enddo
  696. ENDIF
  697. segdes,XMATR3
  698. endif
  699. segdes,XMATR1,XMATR2
  700. RI1.IRIGEL(4,IMA1) = XMATR1
  701.  
  702. segsup,MLENTI
  703.  
  704. * IRIGEL(5,:) = nhar
  705. RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  706. * IRIGEL(6,:) = < = >
  707. RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  708. * IRIGEL(7,:) = symetrie
  709. IF (FLAGFO.or.FLUT) THEN
  710. RI1.IRIGEL(7,IMA1) = 2
  711. ELSEIF((RI2.IRIGEL(7,IMA)).eq.0) THEN
  712. RI1.IRIGEL(7,IMA1) = 1
  713. ELSE
  714. RI1.IRIGEL(7,IMA1) = 2
  715. ENDIF
  716.  
  717. 301 CONTINUE
  718. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  719.  
  720. *---- 3eme quadrant (s'il n'pas pu etre rempli dans la boucle 301) ----
  721. if(FLRI23) goto 309
  722.  
  723. *-----Boucle sur les matrices de rigidite elementaires de RI3
  724. DO 302 IMA=1,NRIGEL3
  725.  
  726. IMA1 = NRIGEL2 + IMA
  727. * COERIG
  728. XCOEF3 = XOME * RI3.COERIG(IMA)
  729. RI1.COERIG(IMA1) = XCOEF3
  730. * IRIGEL(1,:)= meleme
  731. RI1.IRIGEL(1,IMA1) = RI3.IRIGEL(1,IMA)
  732. RI1.IRIGEL(2,IMA1) = RI3.IRIGEL(2,IMA)
  733.  
  734. * IRIGEL(3,:) = descr
  735. DES3 = RI3.IRIGEL(3,IMA)
  736. segact,DES3
  737. NLIGRP= DES3.LISINC(/2)
  738. NLIGRD= DES3.LISDUA(/2)
  739. if (NLIGRP.ne.NLIGRD) then
  740. call ERREUR(756)
  741. return
  742. endif
  743. * on crée un nouveau DESCR 2 fois plus long
  744. segini,DES1=DES3
  745. NLIG = NLIGRP
  746. NLIGRP = 2 * NLIG
  747. NLIGRD = 2 * NLIG
  748. segadj,DES1
  749. * on ajoute les noeuds + les noms de la partie imaginaire
  750. do 312 ILIG = 1,NLIG
  751. DES1.NOELEP(NLIG+ILIG) = DES1.NOELEP(ILIG)
  752. DES1.NOELED(NLIG+ILIG) = DES1.NOELED(ILIG)
  753. MOP3 = DES3.LISINC(ILIG)
  754. do IBMO = 1,NBMO
  755. if (MOP3.eq.(MOPRIM(IBMO))) then
  756. if ((DES3.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  757. write(6,*) 'non concordance entre l inconnue primale '
  758. write(6,*) DES3.LISINC(ILIG),' et duale ',DES3.LISDUA(ILIG)
  759. call erreur(717)
  760. return
  761. endif
  762. if ((DES3.NOELEP(ILIG)).ne.(DES3.NOELED(ILIG))) then
  763. write(6,*) 'non concordance entre le noeud primal '
  764. write(6,*) DES3.NOELEP(ILIG),' et dual ',DES3.NOELED(ILIG)
  765. call erreur(717)
  766. return
  767. endif
  768. * on ajoutes les inconnues imaginaires + les noeuds associés
  769. DES1.LISINC(NLIG+ILIG) = MOPRII(IBMO)
  770. DES1.LISDUA(NLIG+ILIG) = MODUAI(IBMO)
  771. goto 312
  772. endif
  773. enddo
  774. c on n'a pas trouve le primal dans la liste,
  775. c on fabrique les noms primal et dual maginaire depuis reel
  776. c la concordance n'est plus assuree
  777. LMOP3=LONG(MOP3)
  778. if(LMOP3.ge.4) then
  779. write(ioimp,*) 'Pas de composante imaginaire connue ',
  780. & 'associée à ',MOP3
  781. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  782. & 'primale standard ou de moins de 4 caracteres'
  783. MOTERR(1:4)=MOP3
  784. call erreur(108)
  785. RETURN
  786. endif
  787. c on construit un nom imaginaire a partir du nom fourni
  788. write(MOP1,FMT='(A,A)') 'I',MOP3(1:3)
  789. write(ioimp,*) '!!! On définit par défaut ',MOP1,
  790. & ' comme inconnue imaginaire de ',MOP3
  791. DES1.LISINC(NLIG+ILIG) = MOP1
  792. c idem pour le dual
  793. MOD3=DES3.LISDUA(ILIG)
  794. LMOD3=LONG(MOD3)
  795. if(LMOD3.ge.4) then
  796. write(ioimp,*) 'Pas de composante imaginaire connue ',
  797. & 'associée à ',MOD3
  798. write(ioimp,*) 'Veuillez choisir un nom d inconnue ',
  799. & 'duale standard ou de moins de 4 caracteres'
  800. MOTERR(1:4)=MOD3
  801. call erreur(108)
  802. RETURN
  803. endif
  804. c on construit un nom imaginaire a partir du nom fourni
  805. write(MOD1,FMT='(A,A)') 'I',MOD3(1:3)
  806. write(ioimp,*) '!!! On définit par défaut ',MOD1,
  807. & ' comme inconnue duale imaginaire de ',MOD3
  808. DES1.LISDUA(NLIG+ILIG) = MOD1
  809. 312 continue
  810. segdes,DES1
  811. RI1.IRIGEL(3,IMA1) = DES1
  812.  
  813. * on regarde si UT existe
  814. FLUT= .false.
  815. JG = NLIG
  816. segini,MLENTI
  817. IF (FLAGFO) THEN
  818. do ILIG = 1,NLIG
  819. cbp if ((DES3.LISINC(ILIG)).eq.'UT ') then
  820. MOTEMP=DES3.LISINC(ILIG)
  821. if (MOTEMP.eq.'UT '.OR.MOTEMP.eq.'IUT ') then
  822. LECT(ILIG) = 1
  823. FLUT= .true.
  824. endif
  825. enddo
  826. ENDIF
  827. segdes,DES3
  828.  
  829. * IRIGEL(4,:) = XMATRI
  830. * on cree une nouvelle matrice
  831. XMATR3 = RI3.IRIGEL(4,IMA)
  832. segact,XMATR3
  833. NELRIG = XMATR3.RE(/3)
  834. segini,XMATR1
  835. IF (FLUT) THEN
  836. * -- 3eme quadrant = +\bar{C} --
  837. do j=1,NLIG
  838. if (LECT(j).eq.1) then
  839. * la colonne j pointe vers la composante UT
  840. do i=1,NLIG
  841. i1 = NLIG+i
  842. do k=1,NELRIG
  843. XMATR1.RE(i1,j,k) = -1.D0 * XMATR3.RE(i,j,k)
  844. enddo
  845. enddo
  846. else
  847. do i=1,NLIG
  848. i1 = NLIG+i
  849. do k=1,NELRIG
  850. XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  851. enddo
  852. enddo
  853. endif
  854. enddo
  855. ELSE
  856. * -- 3eme quadrant = +{C} --
  857. do k=1,NELRIG
  858. do j=1,NLIG
  859. do i=1,NLIG
  860. i1 = NLIG+i
  861. XMATR1.RE(i1,j,k) = XMATR3.RE(i,j,k)
  862. enddo
  863. enddo
  864. enddo
  865. ENDIF
  866. segdes,XMATR1,XMATR3
  867. RI1.IRIGEL(4,IMA1) = XMATR1
  868.  
  869. segsup,MLENTI
  870.  
  871. * IRIGEL(5,:) = +nhar
  872. RI1.IRIGEL(5,IMA1) = abs(RI3.IRIGEL(5,IMA))
  873. * IRIGEL(6,:) = < = >
  874. RI1.IRIGEL(6,IMA1) = RI3.IRIGEL(6,IMA)
  875. * IRIGEL(7,:) = symetrie (2: quelconque)
  876. RI1.IRIGEL(7,IMA1) = 2
  877.  
  878. 302 CONTINUE
  879. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  880.  
  881. 309 CONTINUE
  882.  
  883. GOTO 900
  884.  
  885.  
  886. *
  887. *---- Cas QUELconque [a*K b*K ; c*K d*K] ----------------------------------------*
  888. 400 CONTINUE
  889.  
  890. *-----Boucle sur les matrices de rigidite elementaires de RI2
  891. DO 401 IMA=1,NRIGEL2
  892.  
  893. IMA1 = IMA
  894. * COERIG
  895. XCOEF2 = RI2.COERIG(IMA)
  896. RI1.COERIG(IMA1) = XCOEF2
  897. * IRIGEL(1,:)= meleme
  898. RI1.IRIGEL(1,IMA1) = RI2.IRIGEL(1,IMA)
  899. RI1.IRIGEL(2,IMA1) = RI2.IRIGEL(2,IMA)
  900.  
  901. * IRIGEL(3,:) = descr
  902. DES2 = RI2.IRIGEL(3,IMA)
  903. segact,DES2
  904. NLIGRP= DES2.LISINC(/2)
  905. NLIGRD= DES2.LISDUA(/2)
  906. if (NLIGRP.ne.NLIGRD) then
  907. call ERREUR(756)
  908. return
  909. endif
  910. * on crée un nouveau descr 2 fois plus long
  911. segini,DES1=DES2
  912. NLIG = NLIGRP
  913. NLIGRP = 2 * NLIG
  914. NLIGRD = 2 * NLIG
  915. segadj,DES1
  916. do ILIG = 1,NLIG
  917. do IBMO = 1,NBMO
  918. if ((DES2.LISINC(ILIG)).eq.(MOPRIM(IBMO))) then
  919. if ((DES2.LISDUA(ILIG)).ne.(MODUAL(IBMO))) then
  920. write(6,*) 'non concordance entre l inconnue primale '
  921. write(6,*) DES2.LISINC(ILIG),' et duale ',DES2.LISDUA(ILIG)
  922. call erreur(717)
  923. return
  924. endif
  925. * on ajoutes les inconnues imaginaires + les noeuds associés
  926. DES1.LISINC(NLIG+ILIG) = MOPRII(IBMO)
  927. DES1.NOELEP(NLIG+ILIG) = DES1.NOELEP(ILIG)
  928. DES1.LISDUA(NLIG+ILIG) = MODUAI(IBMO)
  929. DES1.NOELED(NLIG+ILIG) = DES1.NOELED(ILIG)
  930. endif
  931. enddo
  932. enddo
  933. segdes,DES1
  934. RI1.IRIGEL(3,IMA1) = DES1
  935.  
  936. * IRIGEL(4,:) = XMATRI
  937. * on cree une nouvelle matrice
  938. XMATR2 = RI2.IRIGEL(4,IMA)
  939. segact,XMATR2
  940. NELRIG = XMATR2.RE(/3)
  941. segini,XMATR1
  942. if(COEFA.eq.0.D0) goto 411
  943. * -- 1er quadrant --
  944. do j=1,NLIG
  945. do i=1,NLIG
  946. do k=1,NELRIG
  947. XMATR1.RE(i,j,k) = COEFA * XMATR2.RE(i,j,k)
  948. enddo
  949. enddo
  950. enddo
  951. 411 continue
  952. if(COEFB.eq.0.D0) goto 412
  953. * -- 2nd quadrant --
  954. do j=1,NLIG
  955. j1=NLIG+j
  956. do i=1,NLIG
  957. do k=1,NELRIG
  958. XMATR1.RE(i,j1,k) = COEFB * XMATR2.RE(i,j,k)
  959. enddo
  960. enddo
  961. enddo
  962. 412 continue
  963. if(COEFC.eq.0.D0) goto 413
  964. * -- 3eme quadrant --
  965. do i=1,NLIG
  966. i1 = NLIG+i
  967. do j=1,NLIG
  968. do k=1,NELRIG
  969. XMATR1.RE(i1,j,k) = COEFC * XMATR2.RE(i,j,k)
  970. enddo
  971. enddo
  972. enddo
  973. 413 continue
  974. if(COEFD.eq.0.D0) goto 414
  975. * -- 2nd quadrant --
  976. do i=1,NLIG
  977. i1 = NLIG+i
  978. do j=1,NLIG
  979. j1=NLIG+j
  980. do k=1,NELRIG
  981. XMATR1.RE(i1,j1,k) = COEFD * XMATR2.RE(i,j,k)
  982. enddo
  983. enddo
  984. enddo
  985. 414 continue
  986.  
  987. segdes,XMATR1,XMATR2
  988. RI1.IRIGEL(4,IMA1) = XMATR1
  989.  
  990. * IRIGEL(5,:) = nhar
  991. RI1.IRIGEL(5,IMA1) = RI2.IRIGEL(5,IMA)
  992. * IRIGEL(6,:) = < = >
  993. RI1.IRIGEL(6,IMA1) = RI2.IRIGEL(6,IMA)
  994. * IRIGEL(7,:) = symetrie
  995. RI1.IRIGEL(7,IMA1) = 2
  996.  
  997. 401 CONTINUE
  998. *-----fin de Boucle sur les matrices de rigidite elementaires de RI2
  999.  
  1000. GOTO 900
  1001.  
  1002.  
  1003. *---- Desactivations des objets -------------------------------------*
  1004. 900 CONTINUE
  1005. *
  1006. SEGDES,RI1,RI2
  1007. IF(FLAGFO) SEGDES,RI3
  1008.  
  1009. *---- Verification de l'unicite de la relation supportée par un
  1010. * multiplicateur de lagrange s'il existe -------------*
  1011.  
  1012.  
  1013.  
  1014. *
  1015. *---- Ecriture de la rigidite de sortie -----------------------------*
  1016. IPOIRF = RI1
  1017. IF(IRET.EQ.1) CALL ECROBJ('RIGIDITE',IPOIRF)
  1018. *
  1019. RETURN
  1020. *
  1021. END
  1022.  
  1023.  
  1024.  
  1025.  
  1026.  
  1027.  
  1028.  

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