Télécharger comalo.eso

Retour à la liste

Numérotation des lignes :

  1. C COMALO SOURCE BP208322 17/03/01 21:16:02 9325
  2. SUBROUTINE COMALO(ipmode,itruli,ipmel)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------
  6. * CF DEVALO.ESO et DEVTRA.ESO
  7. * indexe infos deformees modales , deplacements
  8. *--------------------------------------------------------
  9. -INC SMCOORD
  10. -INC DECHE
  11. -INC CCOPTIO
  12. -INC CCGEOME
  13. -INC SMCHAML
  14. -INC SMELEME
  15. -INC SMMODEL
  16. -INC SMLENTI
  17. -INC CCREEL
  18. *
  19. segment wrktvu
  20. integer jtvu(lilmel(/1))
  21. endsegment
  22. segment mwinit
  23. integer jpdep,jpvit,jrepr
  24. endsegment
  25. *
  26. * Segment des variables generalisees:
  27. *
  28. SEGMENT,MTQ
  29. REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  30. REAL*8 WEXT(NA1,2),WINT(NA1,2)
  31. ENDSEGMENT
  32. SEGMENT,MTKAM
  33. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  34. REAL*8 XOPER(NB1,NB1,NOPER)
  35. ENDSEGMENT
  36.  
  37. * Segment pour Champoints
  38. SEGMENT,MSAM
  39. integer jplibb(NPLB)
  40. ENDSEGMENT
  41. *
  42. *** segment sous-structures dynamiques
  43. segment struli
  44. integer itlia,itbmod,momoda, mostat,itmail,molia
  45. integer ldefo(np1),lcgra(np1),lsstru(np1)
  46. integer nsstru,nndefo,nliab,nsb,na2,idimb
  47. integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  48. INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  49. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  50. INTEGER ICHAIN
  51. endsegment
  52.  
  53. SEGMENT MOLIAI
  54. integer modtla,modtlb
  55. ENDSEGMENT
  56. *
  57. * Segment de travail pour reprise force POLYNOMIALE base A
  58. *
  59. SEGMENT,MTRA
  60. INTEGER IPLA(NTRA)
  61. ENDSEGMENT
  62.  
  63. SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
  64. SEGMENT,MCPR(XCOOR(/1)/(IDIM+1))
  65. SEGMENT,MPREF
  66. INTEGER IPOREF(NPREF)
  67. ENDSEGMENT
  68. segment icma(0)
  69. segment icnna2(0)
  70. PARAMETER (MDEPL=20)
  71. LOGICAL REPRIS,LMODYN,RIGIDE,ilogmo,ilogst,ilogre,L0,LVA1,LVAR
  72. CHARACTER*4 LISDEP(MDEPL),LISVIT(MDEPL),TESDEP
  73. CHARACTER*6 MO2
  74. CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE
  75. CHARACTER*10 MO1
  76. CHARACTER*40 MONMOT
  77. DATA LISDEP/ 'UX ','UY ','UZ ','UR ','UT ','RX ','RY ',
  78. &'RZ ','RT ','ALFA','BETA','IUX ','IUY ','IUZ ','IUR ','IUT ',
  79. &'IRX ','IRY ','IRZ ','IRT '/
  80. DATA LISVIT/ 'VTX ','VTY ','VTZ ','VTR ','VTT ','VWX ','VWY ',
  81. &'VWZ ','VWT ','VALF','VBET','IVTX','IVTY','IVTZ','IVTR','IVTT',
  82. &'IVWX','IVWY','IVWZ','IVWT'/
  83. *
  84. * si IFOMOD = -1 : mod?le PLAN
  85. * si IFOMOD = 0 : mod?le AXIS
  86. * si IFOMOD = 1 : mod?le FOUR
  87. * si IFOMOD = 2 : mod?le TRID
  88. *
  89. *
  90. ITREP = 0
  91. MTQ = 0
  92. MTKAM = 0
  93. MTPHI = 0
  94. MTLIAA = 0
  95. MTLIAB = 0
  96. MTFEX = 0
  97. MTPAS = 0
  98. MTRES = 0
  99. MTNUM = 0
  100. MTRA = 0
  101. XTINI = 0.D0
  102. ITLA = 0
  103. ITLB = 0
  104. REPRIS = .FALSE.
  105.  
  106. lilmel = ipmel
  107. struli = itruli
  108. jliaib = 0
  109. nmost = 0
  110. nmost0 = 0
  111. kovaen = 0
  112. kovare = 0
  113. * identifie materiau MODAL ou STATIQUE
  114.  
  115. itmod = ipmode
  116. *
  117. call ecrcha('MODAL')
  118. call ecrcha('MATE')
  119. call ecrobj('MMODEL',ITMOD)
  120. call exis
  121. call lirlog(ilogmo,0,iret)
  122. IF (ilogmo) THEN
  123. call ecrcha('MECANIQUE')
  124. call ecrcha('FORM')
  125. call ecrobj('MMODEL',ITMOD)
  126. call extrai
  127. call lirobj('MMODEL',momod1,0,iret)
  128. call ecrcha('MODAL')
  129. call ecrcha('MATE')
  130. call ecrobj('MMODEL',momod1)
  131. call extrai
  132. call lirobj('MMODEL',ipmodz,0,iret)
  133. momoda = ipmodz
  134. mmode1 = ipmodz
  135. segact mmode1
  136. nmost0 = mmode1.kmodel(/1)
  137. nmost = nmost + nmost0
  138. ENDIF
  139. call ecrcha('STATIQUE')
  140. call ecrcha('MATE')
  141. call ecrobj('MMODEL',ITMOD)
  142. call exis
  143. call lirlog(ilogst,0,iret)
  144. IF (ilogst) THEN
  145. call ecrcha('MECANIQUE')
  146. call ecrcha('FORM')
  147. call ecrobj('MMODEL',ITMOD)
  148. call extrai
  149. call lirobj('MMODEL',momod1,0,iret)
  150. call ecrcha('STATIQUE')
  151. call ecrcha('MATE')
  152. call ecrobj('MMODEL',momod1)
  153. call extrai
  154. call lirobj('MMODEL',ipmodz,0,iret)
  155. mostat = ipmodz
  156. mmode1 = ipmodz
  157. segact mmode1
  158. nmost = nmost + mmode1.kmodel(/1)
  159. ENDIF
  160. na1 = nmost
  161. mmode2 = itlia
  162. segact mmode2
  163. nliat = mmode2.kmodel(/1)
  164. mmode1 = ipmode
  165. segact mmode1
  166. ilogre = (mmode1.kmodel(/1) - na1 - nliat).gt.0
  167.  
  168. n1 = nmost
  169. segini mmodel
  170. mmode1 = momoda
  171. do im = 1,nmost0
  172. kmodel(im) = mmode1.kmodel(im)
  173. enddo
  174. IF (ilogst) THEN
  175. mmode1 = mostat
  176. do im = 1,mmode1.kmodel(/1)
  177. kmodel(nmost0 + im) = mmode1.kmodel(im)
  178. enddo
  179. ENDIF
  180. itbmod = mmodel
  181. np1 = nmost
  182. segadj struli
  183. *
  184. * collecte deplacements, vitesses, deformation , centre gravite
  185. segini wrktvu
  186. iptvu = wrktvu
  187. do 2010 mvu = 1,lilmel(/1)
  188. deche = lilmel(mvu)
  189. if(ilogmo) then
  190. if (nomdec.eq.'ALFA'.and.indec.eq.1) then
  191. jtvu(mvu) = 101
  192. goto 2010
  193. endif
  194. if (nomdec.eq.'ALFA'.and.indec.gt.1) then
  195. jtvu(mvu) = 102
  196. goto 2010
  197. endif
  198. if (nomdec.eq.'FALF'.and.indec.gt.1) then
  199. jtvu(mvu) = 105
  200. goto 2010
  201. endif
  202. if (nomdec.eq.'VALF'.and.indec.eq.1) then
  203. jtvu(mvu) = 106
  204. goto 2010
  205. endif
  206. if (nomdec.eq.'VALF'.and.indec.gt.1) then
  207. jtvu(mvu) = 107
  208. goto 2010
  209. endif
  210. endif
  211. if(ilogst) then
  212. if (nomdec.eq.'BETA'.and.indec.eq.1) then
  213. jtvu(mvu) = 201
  214. goto 2010
  215. endif
  216. if (nomdec.eq.'BETA'.and.indec.gt.1) then
  217. jtvu(mvu) = 202
  218. goto 2010
  219. endif
  220. if (nomdec.eq.'FBET'.and.indec.gt.1) then
  221. jtvu(mvu) = 205
  222. goto 2010
  223. endif
  224. if (nomdec.eq.'VBET'.and.indec.eq.1) then
  225. jtvu(mvu) = 206
  226. goto 2010
  227. endif
  228. if (nomdec.eq.'VBET'.and.indec.gt.1) then
  229. jtvu(mvu) = 207
  230. goto 2010
  231. endif
  232. endif
  233. if(ilogmo.or.ilogst) then
  234. if (nomdec.eq.'DEFO'.and.indec.gt.1) then
  235. jtvu(mvu)= 302
  236. goto 2010
  237. endif
  238. if (nomdec.eq.'AMOR'.and.indec.gt.1) then
  239. jtvu(mvu)= 305
  240. goto 2010
  241. endif
  242. endif
  243. if(ilogmo) then
  244. if (nomdec.eq.'CGRA'.and.indec.gt.1) then
  245. jtvu(mvu)= 303
  246. goto 2010
  247. endif
  248. if (nomdec.eq.'FREQ'.and.indec.gt.1) then
  249. jtvu(mvu)= 304
  250. goto 2010
  251. endif
  252. if (nomdec.eq.'MASS'.and.indec.gt.1) then
  253. jtvu(mvu)= 305
  254. goto 2010
  255. endif
  256. endif
  257. if (ilogre) then
  258. do mdep = 1,MDEPL
  259. if (nomdec.eq.lisdep(mdep)) then
  260. jtvu(mvu)= mdep
  261. goto 2010
  262. endif
  263. if (nomdec.eq.lisvit(mdep)) then
  264. jtvu(mvu)= mdep * (-1)
  265. goto 2010
  266. endif
  267. enddo
  268. endif
  269.  
  270. if (nomdec.eq.'SORT') then
  271. jtvu(mvu) = 501
  272. goto 2010
  273. endif
  274.  
  275. if (nomdec.eq.'VAEN') then
  276. jtvu(mvu) = 506
  277. kovaen = kovaen + 1
  278. goto 2010
  279. endif
  280.  
  281. if (nomdec.eq.'VARE') then
  282. jtvu(mvu) = 507
  283. kovare = kovare + 1
  284. goto 2010
  285. endif
  286.  
  287.  
  288. jtvu(mvu) = -100
  289.  
  290. 2010 continue
  291.  
  292. IK = 0
  293. SEGINI,ICPR
  294. LCPR = XCOOR(/1)/(IDIM+1)
  295.  
  296. MMODEL = itbmod
  297. segact MMODEL
  298. do 60 im = 1,kmodel(/1)
  299. imodel = kmodel(im)
  300. segact imodel*nomod
  301. meleme = imamod
  302. segact meleme
  303. * a priori 1 seul point
  304. do ip = 1,num(/2)
  305. knoe = num(1,ip)
  306. IF (KNOE.NE.0) THEN
  307. IF (ICPR(KNOE).EQ.0) THEN
  308. IK = IK + 1
  309. ICPR(KNOE) = IK
  310. IF (IIMPI.EQ.333) THEN
  311. WRITE(IOIMP,*)'COMALO : basemo. ICPR(',KNOE,')=',ICPR(KNOE)
  312. ENDIF
  313. ENDIF
  314. ENDIF
  315. enddo
  316. 60 continue
  317. *
  318.  
  319. *
  320. * 5/ Cr{ation du segment d{finissant les points supports:
  321. *
  322. NPREF = IK
  323. SEGINI,MPREF
  324. KPREF = MPREF
  325. ikpref = KPREF
  326. DO 100 I=1,LCPR
  327. IF (ICPR(I).NE.0) THEN
  328. IREF = ICPR(I)
  329. IPOREF(IREF) = I
  330. IF (IIMPI.EQ.333) THEN
  331. WRITE(IOIMP,*)'COMALO : IPOREF(',IREF,')=',IPOREF(IREF)
  332. ENDIF
  333. ENDIF
  334. 100 CONTINUE
  335.  
  336. *
  337. * creation et remplissage MTQ (revoir indices dans DYNE 1=actuel 2=avant)
  338. *
  339. NA1 = nmost
  340. NB1K = 1
  341. NB1C = 1
  342. NB1M = 1
  343. NB1 = 1
  344. NOPER = 0
  345. segini MTQ,MTKAM
  346. ktq = MTQ
  347. ktkam = MTKAM
  348. do ia1 = 1,na1
  349. xk(ia1,1) = 1.d0
  350. enddo
  351. mmodel = itbmod
  352.  
  353. do 3010 mvu = 1,lilmel(/1)
  354. if (jtvu(mvu).ne.101.and.jtvu(mvu).ne.102.and.
  355. &jtvu(mvu).ne.106.and.jtvu(mvu).ne.107.and.
  356. &jtvu(mvu).ne.201.and.jtvu(mvu).ne.202.and.
  357. &jtvu(mvu).ne.206.and.jtvu(mvu).ne.207.and.
  358. &jtvu(mvu).ne.105.and.jtvu(mvu).ne.205.and.
  359. &jtvu(mvu).ne.304.and.jtvu(mvu).ne.305) goto 3010
  360. deche = lilmel(mvu)
  361. melval = ieldec
  362. ** segact melval
  363.  
  364. do 3050 im = 1,kmodel(/1)
  365. imodel = kmodel(im)
  366. if (imadec.ne.imamod.or.condec.ne.conmod) goto 3050
  367. meleme = imamod
  368. IA = ICPR(num(1,1))
  369. * en gros ordre du MMODEL
  370. if (nomdec.eq.'ALFA'.or.nomdec.eq.'BETA') then
  371. if (indec.eq.1) Q1(ia,2) = velche(1,1)
  372. if (indec.gt.1) Q1(ia,1) = velche(1,1)
  373. q1(ia,3) = q1(ia,2)
  374. endif
  375. if (nomdec.eq.'VALF'.or.nomdec.eq.'VBET') then
  376. if (indec.eq.1) Q2(ia,2) = velche(1,1)
  377. if (indec.gt.1) Q2(ia,1) = velche(1,1)
  378. q2(ia,3) = q2(ia,2)
  379. endif
  380. if (nomdec.eq.'FALF'.or.nomdec.eq.'FBET') then
  381. if (indec.gt.1) then
  382. Q3(ia,2) = velche(1,1)
  383. endif
  384. endif
  385. if (nomdec.eq.'FREQ') then
  386. OMEGA = velche(1,1) * 2.d0* xpi
  387. xk(ia,1) = xk(ia,1) * omega * omega
  388. endif
  389. if (nomdec.eq.'MASS') then
  390. xm(ia,1) = velche(1,1)
  391. xk(ia,1) = velche(1,1) * xk(ia,1)
  392. endif
  393. if (nomdec.eq.'AMOR') then
  394. xasm(ia,1) = velche(1,1)
  395. endif
  396. goto 3009
  397. 3050 continue
  398. 3009 continue
  399. *** segdes melval
  400.  
  401. 3010 continue
  402. segsup icpr
  403.  
  404. 5001 continue
  405.  
  406. * (kich : traitement sur base modale-stat pour l instant)
  407. *
  408. ipmodz = itbmod
  409. call ecrcha('MAIL')
  410. call ecrobj('MMODEL',ipmodz)
  411. call extrai
  412. call lirobj('MAILLAGE',ipt1,0,iret)
  413. itmail = ipt1
  414. if (ierr.ne.0) return
  415. if (iret.ne.1) then
  416. write(6,*) 'pb developpement comalo'
  417. ierr = 2
  418. return
  419. endif
  420. segact ipt1
  421. segini mcpr
  422. do ie = 1,ipt1.num(/2)
  423. mcpr(ipt1.num(1,ie)) = 1
  424. enddo
  425.  
  426. mmodel = itlia
  427. segact mmodel
  428. n1 = kmodel(/1)
  429. segini mmode1,mmode2
  430. klia = 0
  431. klib = 0
  432. do ik = 1,kmodel(/1)
  433. imodel = kmodel(ik)
  434. * liaisons issues de DYNE
  435. segact imodel
  436. meleme = imamod
  437. if (imatee.lt.23) then
  438. segact meleme
  439.  
  440. if (mcpr(num(1,1)).gt.0) then
  441. klia = klia + 1
  442. mmode1.kmodel(klia) = imodel
  443. else
  444. klib = klib + 1
  445. mmode2.kmodel(klib) = imodel
  446. endif
  447.  
  448. endif
  449. enddo
  450. nliady = klia+klib
  451. n1 = klia
  452. itla = mmode1
  453. segadj mmode1
  454. n1 = klib
  455. segadj mmode2
  456. itlb = mmode2
  457. segsup mcpr
  458. segini moliai
  459. modtla = itla
  460. if (klia.eq.0) modtla = 0
  461. modtlb = itlb
  462. if (klib.eq.0) modtlb = 0
  463. * distingue liaisons A et B
  464. IMOLIA = MOLIAI
  465. molia = moliai
  466.  
  467. * recense variables internes de continuation, rustique !
  468. if (kovare.eq.kovaen.and.kovare.eq.klia + klib) then
  469. segsup wrktvu
  470. return
  471. endif
  472.  
  473. *
  474. * dimensionnement MTPHI : repere les deformees modales
  475. wrktvu =iptvu
  476.  
  477. segini icma,icnna2
  478. MMODEL = itbmod
  479. segact MMODEL
  480. kstru = 0
  481. kdefo = 0
  482. do 50 im = 1,kmodel(/1)
  483. imodel = kmodel(im)
  484. segact imodel*nomod
  485. meleme = imamod
  486. segact meleme
  487. ** recherche sommaire nombre de sous-structures independantes (NSB)
  488. ** nombre maxi de modes pour une meme sous-structure (NA2)
  489. do 46 in = 1,jtvu(/1)
  490. if (jtvu(in).ne.302.and.jtvu(in).ne.303) goto 46
  491. deche = lilmel(in)
  492. if (condec(1:16).ne.conmod(1:16).or.imamod.ne.imadec) goto 46
  493.  
  494. * assume point support reduit à 1 point
  495. if (nomdec(1:4).eq.'CGRA') then
  496. * recherche corps rigide
  497. if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  498. if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  499. melval = ieldec
  500. ** segact melval
  501. icdg = ielche(1,1)
  502. lcgra(im) = icdg
  503. ** segdes melval
  504. else if (nomdec(1:4).eq.'DEFO') then
  505. melval = ieldec
  506. ** segact melval
  507. * assume que le maillage modele se reduit au point support
  508. icdef1 = ielche(1,1)
  509. ** segdes melval
  510. call ecrcha('NOMU')
  511. call ecrcha('MAIL')
  512. call ecrobj('CHPOINT ',icdef1)
  513. call extrai
  514. call lirobj('MAILLAGE', icmaio,1,iret)
  515. if (ierr.ne.0) return
  516. if (kstru.eq.0) goto 44
  517.  
  518. ipt5 = icmaio
  519. do ic = 1,kstru
  520. icmic = icma(ic)
  521. CALL INTERB(icmaio,icmic,IRETIB,icinte)
  522. if (iretib.eq.0) then
  523. ipt6 = icinte
  524. segact ipt6,ipt5
  525. if (ipt5.num(/2).eq.ipt6.num(/2)) then
  526. segsup ipt6
  527. icnna2(ic) = icnna2(ic) + 1
  528. lsstru(im) = ic
  529. goto 45
  530. endif
  531. segsup ipt6
  532. endif
  533. enddo
  534. 44 continue
  535. kstru = kstru + 1
  536. icma(**) = icmaio
  537. icnna2(**) = 1
  538. lsstru(im) = kstru
  539. 45 continue
  540. do ism = 1,im
  541. if (icdef1.ne.0.and.icdef1.eq.ldefo(ism)) then
  542. c write(6,*) 'deformee ',icdef1,'utilisee autre support', ism,im
  543. call erreur(26)
  544. return
  545. endif
  546. enddo
  547. ldefo(im) = icdef1
  548. kdefo = kdefo + 1
  549. goto 46
  550. endif
  551. 46 continue
  552. if (ldefo(im).eq.0) then
  553. c write(6,*) 'manque deformee modale pour support', imamod
  554. call erreur(26)
  555. return
  556. endif
  557.  
  558. 47 continue
  559. 49 continue
  560. 50 continue
  561. NSB = icma(/1)
  562. NA2 = icnna2(1)
  563. do ic = 1,icnna2(/1)
  564. na2 = MAX(icnna2(ic),NA2)
  565. enddo
  566. nsstru = kstru
  567. nndefo = kdefo
  568. if (nndefo.ne.nmost) then
  569. call erreur(26)
  570. return
  571. endif
  572. if (nsstru.ne.nsb) then
  573. call erreur(26)
  574. return
  575. endif
  576. segsup icma,icnna2
  577. segsup wrktvu
  578. *
  579. RETURN
  580. END
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  

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