Télécharger comalo.eso

Retour à la liste

Numérotation des lignes :

  1. C COMALO SOURCE CB215821 18/09/13 21:15:09 9917
  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(1:4).eq.lisdep(mdep)) then
  260. jtvu(mvu)= mdep
  261. goto 2010
  262. endif
  263. if (nomdec(1:4).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.
  367. & condec(1:LCONMO).ne.conmod(1:LCONMO)) goto 3050
  368. meleme = imamod
  369. IA = ICPR(num(1,1))
  370. * en gros ordre du MMODEL
  371. if (nomdec.eq.'ALFA '.or.nomdec.eq.'BETA ') then
  372. if (indec.eq.1) Q1(ia,2) = velche(1,1)
  373. if (indec.gt.1) Q1(ia,1) = velche(1,1)
  374. q1(ia,3) = q1(ia,2)
  375. endif
  376. if (nomdec.eq.'VALF '.or.nomdec.eq.'VBET ') then
  377. if (indec.eq.1) Q2(ia,2) = velche(1,1)
  378. if (indec.gt.1) Q2(ia,1) = velche(1,1)
  379. q2(ia,3) = q2(ia,2)
  380. endif
  381. if (nomdec.eq.'FALF '.or.nomdec.eq.'FBET ') then
  382. if (indec.gt.1) then
  383. Q3(ia,2) = velche(1,1)
  384. endif
  385. endif
  386. if (nomdec.eq.'FREQ ') then
  387. OMEGA = velche(1,1) * 2.d0* xpi
  388. xk(ia,1) = xk(ia,1) * omega * omega
  389. endif
  390. if (nomdec.eq.'MASS ') then
  391. xm(ia,1) = velche(1,1)
  392. xk(ia,1) = velche(1,1) * xk(ia,1)
  393. endif
  394. if (nomdec.eq.'AMOR ') then
  395. xasm(ia,1) = velche(1,1)
  396. endif
  397. goto 3009
  398. 3050 continue
  399. 3009 continue
  400. *** segdes melval
  401.  
  402. 3010 continue
  403. segsup icpr
  404.  
  405. 5001 continue
  406.  
  407. * (kich : traitement sur base modale-stat pour l instant)
  408. *
  409. ipmodz = itbmod
  410. call ecrcha('MAIL')
  411. call ecrobj('MMODEL',ipmodz)
  412. call extrai
  413. call lirobj('MAILLAGE',ipt1,0,iret)
  414. itmail = ipt1
  415. if (ierr.ne.0) return
  416. if (iret.ne.1) then
  417. write(6,*) 'pb developpement comalo'
  418. ierr = 2
  419. return
  420. endif
  421. segact ipt1
  422. segini mcpr
  423. do ie = 1,ipt1.num(/2)
  424. mcpr(ipt1.num(1,ie)) = 1
  425. enddo
  426.  
  427. mmodel = itlia
  428. segact mmodel
  429. n1 = kmodel(/1)
  430. segini mmode1,mmode2
  431. klia = 0
  432. klib = 0
  433. do ik = 1,kmodel(/1)
  434. imodel = kmodel(ik)
  435. * liaisons issues de DYNE
  436. segact imodel
  437. meleme = imamod
  438. if (imatee.lt.23) then
  439. segact meleme
  440.  
  441. if (mcpr(num(1,1)).gt.0) then
  442. klia = klia + 1
  443. mmode1.kmodel(klia) = imodel
  444. else
  445. klib = klib + 1
  446. mmode2.kmodel(klib) = imodel
  447. endif
  448.  
  449. endif
  450. enddo
  451. nliady = klia+klib
  452. n1 = klia
  453. itla = mmode1
  454. segadj mmode1
  455. n1 = klib
  456. segadj mmode2
  457. itlb = mmode2
  458. segsup mcpr
  459. segini moliai
  460. modtla = itla
  461. if (klia.eq.0) modtla = 0
  462. modtlb = itlb
  463. if (klib.eq.0) modtlb = 0
  464. * distingue liaisons A et B
  465. IMOLIA = MOLIAI
  466. molia = moliai
  467.  
  468. * recense variables internes de continuation, rustique !
  469. if (kovare.eq.kovaen.and.kovare.eq.klia + klib) then
  470. segsup wrktvu
  471. return
  472. endif
  473.  
  474. *
  475. * dimensionnement MTPHI : repere les deformees modales
  476. wrktvu =iptvu
  477.  
  478. segini icma,icnna2
  479. MMODEL = itbmod
  480. segact MMODEL
  481. kstru = 0
  482. kdefo = 0
  483. do 50 im = 1,kmodel(/1)
  484. imodel = kmodel(im)
  485. segact imodel*nomod
  486. meleme = imamod
  487. segact meleme
  488. ** recherche sommaire nombre de sous-structures independantes (NSB)
  489. ** nombre maxi de modes pour une meme sous-structure (NA2)
  490. do 46 in = 1,jtvu(/1)
  491. if (jtvu(in).ne.302.and.jtvu(in).ne.303) goto 46
  492. deche = lilmel(in)
  493. if (condec(1:16).ne.conmod(1:16).or.imamod.ne.imadec) goto 46
  494.  
  495. * assume point support reduit a 1 point
  496. if (nomdec(1:4).eq.'CGRA') then
  497. * recherche corps rigide
  498. if (IDIM.eq.2 .and. IDIMB.lt.3) IDIMB = 3
  499. if (IDIM.eq.3 .and. IDIMB.lt.6) IDIMB = 6
  500. melval = ieldec
  501. ** segact melval
  502. icdg = ielche(1,1)
  503. lcgra(im) = icdg
  504. ** segdes melval
  505. else if (nomdec(1:4).eq.'DEFO') then
  506. melval = ieldec
  507. ** segact melval
  508. * assume que le maillage modele se reduit au point support
  509. icdef1 = ielche(1,1)
  510. ** segdes melval
  511. call ecrcha('NOMU')
  512. call ecrcha('MAIL')
  513. call ecrobj('CHPOINT ',icdef1)
  514. call extrai
  515. call lirobj('MAILLAGE', icmaio,1,iret)
  516. if (ierr.ne.0) return
  517. if (kstru.eq.0) goto 44
  518.  
  519. ipt5 = icmaio
  520. do ic = 1,kstru
  521. icmic = icma(ic)
  522. CALL INTERB(icmaio,icmic,IRETIB,icinte)
  523. if (iretib.eq.0) then
  524. ipt6 = icinte
  525. segact ipt6,ipt5
  526. if (ipt5.num(/2).eq.ipt6.num(/2)) then
  527. segsup ipt6
  528. icnna2(ic) = icnna2(ic) + 1
  529. lsstru(im) = ic
  530. goto 45
  531. endif
  532. segsup ipt6
  533. endif
  534. enddo
  535. 44 continue
  536. kstru = kstru + 1
  537. icma(**) = icmaio
  538. icnna2(**) = 1
  539. lsstru(im) = kstru
  540. 45 continue
  541. do ism = 1,im
  542. if (icdef1.ne.0.and.icdef1.eq.ldefo(ism)) then
  543. c write(6,*) 'deformee ',icdef1,'utilisee autre support', ism,im
  544. call erreur(26)
  545. return
  546. endif
  547. enddo
  548. ldefo(im) = icdef1
  549. kdefo = kdefo + 1
  550. goto 46
  551. endif
  552. 46 continue
  553. if (ldefo(im).eq.0) then
  554. c write(6,*) 'manque deformee modale pour support', imamod
  555. call erreur(26)
  556. return
  557. endif
  558.  
  559. 47 continue
  560. 49 continue
  561. 50 continue
  562. NSB = icma(/1)
  563. NA2 = icnna2(1)
  564. do ic = 1,icnna2(/1)
  565. na2 = MAX(icnna2(ic),NA2)
  566. enddo
  567. nsstru = kstru
  568. nndefo = kdefo
  569. if (nndefo.ne.nmost) then
  570. call erreur(26)
  571. return
  572. endif
  573. if (nsstru.ne.nsb) then
  574. call erreur(26)
  575. return
  576. endif
  577. segsup icma,icnna2
  578. segsup wrktvu
  579. *
  580. RETURN
  581. END
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  

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