Télécharger coml2.eso

Retour à la liste

Numérotation des lignes :

coml2
  1. C COML2 SOURCE JK148537 23/08/21 21:15:08 11723
  2.  
  3. SUBROUTINE COML2(IPMODL,IPMEL,INDESO,IRETOU)
  4.  
  5. *---------------------------------------------------------------------
  6. * coml2 : trie et boucle sur les modeles elementaires
  7. * selectionne les composantes de meme support
  8. * passe a coml6
  9. * complete les deche resultats
  10. *----------------------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC CCHAMP
  18. -INC SMCHAML
  19. -INC SMELEME
  20. -INC SMCOORD
  21. -INC SMMODEL
  22. POINTEUR IMOSTA.IMODEL
  23. -INC SMINTE
  24. -INC SMLENTI
  25. * segment deroulant le mcheml
  26. -INC DECHE
  27. C
  28. SEGMENT INFO
  29. INTEGER INFELL(16)
  30. ENDSEGMENT
  31. ** pile des deche contruits pour changer de support
  32. segment lichan(iichan)
  33. ** pile des deche pour construire le champ de caracteristiques geometriques
  34. segment licarb(iicarb)
  35. ** pile des noms de composantes a proteger
  36. segment linomp(iinomp)
  37. ** pile modeles elementaires
  38. segment limode(NSM)
  39. ** segment sous-structures dynamiques
  40. segment struli
  41. integer itlia,itbmod,momoda, mostat,itmail,molia
  42. integer ldefo(np1),lcgra(np1),lsstru(np1)
  43. integer nsstru,nndefo,nliab,nsb,na2,idimb
  44. integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas
  45. INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib
  46. * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0)
  47. INTEGER ICHAIN
  48. endsegment
  49. c
  50. LOGICAL LOME1,LOME2
  51. *
  52. * Liste des formulations
  53. PARAMETER (MFORMU=19)
  54. CHARACTER*16 LISFOR(MFORMU)
  55. DATA LISFOR /
  56. & 'THERMIQUE ','MECANIQUE ','LIQUIDE ',
  57. & 'CONVECTION ','POREUX ','DARCY ',
  58. & 'FROTTEMENT ','RAYONNEMENT ','MAGNETODYNAMIQUE',
  59. & 'NAVIER_STOKES ','MELANGE ','EULER ',
  60. & 'FISSURE ','LIAISON ','THERMOHYDRIQUE ',
  61. & 'ELECTROSTATIQUE ','DIFFUSION ','METALLURGIE ',
  62. & 'MECANIQUE+LIQUID'/
  63. C
  64. c call gibtem (xkt)
  65. c write(ioimp,*) ' entree coml2 '
  66. C
  67. MMODEL = IPMODL
  68. NSOUS = KMODEL(/1)
  69. NSM = NSOUS
  70. SEGINI,LIMODE
  71. C -----------------------------------------------------------------
  72. C Traitement particulier pour la formulation LIAISON
  73. C -----------------------------------------------------------------
  74. itruli = 0
  75. struli = 0
  76. iplia = 0
  77. * Test sur la presence de la formulation LIAISON
  78. N1 = 0
  79. DO im = 1, NSOUS
  80. imodel = kmodel(im)
  81. if (formod(1)(1:8).EQ.'LIAISON ') then
  82. N1 = N1 + 1
  83. limode(N1) = imodel
  84. ENDIF
  85. ENDDO
  86. * Definition du modele (iplia) associe a la seule formulation LIAISON
  87. if (N1.ne.0) then
  88. segini,mmode1
  89. DO im = 1, N1
  90. mmode1.kmodel(im) = limode(im)
  91. ENDDO
  92. iplia = mmode1
  93. * Initialisation du segment struli
  94. np1 = 0
  95. segini struli
  96. itruli = struli
  97. itlia = iplia
  98. * Remplissage avec les donnees dependant des sous-modeles MODAL / STATIQUE
  99. call comalo(ipmodl,itruli,ipmel)
  100. ENDIF
  101. C -----------------------------------------------------------------
  102. SEGSUP,LIMODE
  103. *
  104. lilmel = ipmel
  105. iimel = lilmel(/1)
  106. c
  107. C En cas de changement de support, appel a chasup qui travaille sur
  108. C un mmodel et un mchelm. ces structures sont creees ici puis
  109. C completees si besoin dans la boucle 1000
  110. N1 = 1
  111. SEGINI,mmode1
  112. IPMOD1 = mmode1
  113. C
  114. N1 = 1
  115. L1 = 1
  116. N3 = 6
  117. SEGINI,mchelm
  118. titche = ' '
  119. conche(1) = ' '
  120. c* ifoche = 0
  121. c* imache(1) = 0
  122. c* DO i = 1, N3
  123. c* infche(1,i) = 0
  124. c* ENDDO
  125. n2 = 1
  126. SEGINI,mchaml
  127. ichaml(1) = mchaml
  128. nomche(1) = ' '
  129. typche(1) = ' '
  130. c* ielval(1) = 0
  131. IPOI1 = mchelm
  132. C
  133. C ----------------------------------------
  134. C Boucle (1000) sur les modeles elementaires
  135. C ----------------------------------------
  136. DO 1000 isous = 1, NSOUS
  137. *
  138. imodel = kmodel(isous)
  139. iqmod = imodel
  140.  
  141. mmode1 = IPMOD1
  142. mmode1.kmodel(1) = iqmod
  143. * write(*,*) 'INPLAS = ',inatuu
  144. *
  145. * write(ioimp,*) 'coml2 modele elementaire numero ',isous
  146. * write(6,*) 'coml2 formulation ',formod(1),' cons ',conmod
  147. * moterr(1:6) = 'COML2 '
  148. * moterr(7:15) = 'IMODEL '
  149. * interr(1) = im
  150. * call erreur(-329)
  151. C
  152. C ===============================================================
  153. C DETERMINATION DE LA FORMULATION DU MODELE
  154. C ===============================================================
  155. NFORMU = FORMOD(/2)
  156. iform1 = 0
  157. CALL PLACE(LISFOR,MFORMU,iform1,FORMOD(1))
  158. lformu = iform1
  159. IF (nformu.EQ.2) THEN
  160. iform2 = 0
  161. CALL PLACE(LISFOR,MFORMU,iform2,FORMOD(2))
  162. lformu = 0
  163. IF ( (iform1.eq.2 .and. iform2.eq.3) .or.
  164. & (iform1.eq.3 .and. iform2.eq.2) ) lformu = 19
  165. ENDIF
  166. C
  167. C Normalement coml a fait le tri
  168. IF (lformu.EQ.0) THEN
  169. WRITE(IOIMP,*) 'COML2 : FORMULATION NON PREVUE ICI'
  170. GOTO 1000
  171. ENDIF
  172. C
  173. C NE TRAITER QUE LES FORMULATIONS CONCERNEES PAR L'INTEGRATION
  174. IF ((lformu.NE. 2).AND.(lformu.NE. 3).AND.(lformu.NE. 5).AND.
  175. & (lformu.NE.11).AND.(lformu.NE.14).AND.(lformu.NE.17).AND.
  176. & (lformu.NE.18).AND.(lformu.NE.19)) GOTO 1000
  177. C
  178. C ===============================================================
  179. C DETERMINATION DU SUPPORT DES CHAMPS (PAR DEFAUT A 5)
  180. C ===============================================================
  181. cof : a stocker dans un segment de travail pour la suite ?
  182. lesupp = 5
  183. jtruli = 0
  184. C Formulation METALLURGIE
  185. if (lformu.EQ.18) then
  186. lesupp = 6
  187. C Formulation MELANGE
  188. else if (lformu.eq.11) then
  189. lesupp = 3
  190. if (ivamod(/1).gt.0) then
  191. lesupp = 5
  192. endif
  193. C Formulation LIAISON
  194. else if (lformu.EQ.14) then
  195. lesupp = 1
  196. jtruli = itruli
  197. endif
  198. C
  199. C ===============================================================
  200. C INFORMATION SUR L'ELEMENT FINI
  201. C ===============================================================
  202. info = 0
  203. ipinf = 0
  204. MELE1 =NEFMOD
  205. MELEME=IMAMOD
  206. if (infmod(/1).lt.2+lesupp) then
  207. CALL ELQUOI(MELE1,0,lesupp,IPINF,IMODEL)
  208. IF (IERR.NE.0) THEN
  209. SEGDES IMODEL*NOMOD,MMODEL*NOMOD
  210. RETURN
  211. ENDIF
  212. INFO = IPINF
  213. MFR2 = INFELL(13)
  214. ELSE
  215. MFR2 = INFELE(13)
  216. ENDIF
  217.  
  218. C
  219. C stationnaire
  220. imosta = 0
  221. do im = 1,ivamod(/1)
  222. if (tymode(im).eq.'STATIO ') imosta = ivamod(im)
  223. enddo
  224.  
  225. C
  226. C ===============================================================
  227. C CHAMPS QUI CONCERNENT LE MODELE ELEMENTAIRE
  228. C ===============================================================
  229. C REDUAF a mis en correspondance les maillages supports des
  230. C modeles elementaires et ceux du mchaml. Il suffit de tester
  231. C l'egalite des pointeurs .
  232. iinomp=iimel
  233. ijnomp=0
  234. segini linomp
  235. DO 90 ICHMP = 1, IIMEL
  236. DECHE = LILMEL(ICHMP)
  237. c if (nomdec.eq.'T') then
  238. c write(6,*) 'c2-90',deche,nomdec,indec,condec
  239. c endif
  240. IF (IMAMOD.EQ.IMADEC) THEN
  241. *jk148537 : très laxiste, ça laisse tout le travail a faire ...
  242. ijnomp = ijnomp + 1
  243. linomp(ijnomp) = DECHE
  244. ENDIF
  245. if (imosta.gt.0) then
  246. if (imosta.imamod.eq.imadec.and.indec.eq.3.and.
  247. &imosta.conmod.eq.condec) then
  248. * on initialise avec les resultats
  249. segini,dec1=deche
  250. dec1.condec = conmod
  251. dec1.indec = 1
  252. ** dec1.imadec = imamod
  253. ijnomp = ijnomp + 1
  254. linomp(ijnomp) = dec1
  255. endif
  256. endif
  257. 90 CONTINUE
  258. IF (IJNOMP.NE.IINOMP) THEN
  259. IINOMP=IJNOMP
  260. SEGADJ LINOMP
  261. ENDIF
  262. C
  263. C Segment pour changer les supports d integration
  264. iichan=iinomp
  265. ijchan=0
  266. segini lichan
  267. C
  268. C Segment contenant les deche sur les bons supports
  269. iilcon=iinomp
  270. ijlcon=0
  271. segini lilcon
  272. ipcon = lilcon
  273. c
  274. c pour gagner du temps
  275. c --- on vise les etudes d ingenierie donc la selection est faite sur
  276. c la formulation --- on ne passe dans coml6 que les deche qui correspondent
  277. c au support. ce n est pas bien parce que la philosophie de COMP
  278. c est justement de faire descendre le maximum d info. o tristesse.kich (05/01)
  279. c
  280. if (((mfr2.ge.11.or.mfr2.eq.7).and.mfr2.ne.33) .or.
  281. & lformu.eq.14) then
  282. do ldn=1,iinomp
  283. lilcon(ldn) = linomp(ldn)
  284. enddo
  285. ijlcon=iinomp
  286. goto 201
  287. endif
  288. c
  289. c tri sommaire des deche : support geometrique
  290. c
  291. if(lformu.eq.11.and.cmatee.eq.'PARALLEL') then
  292. *
  293. if (ivamod(/1).le.0) then
  294. call erreur(21)
  295. return
  296. endif
  297. c
  298. c rassemble les deche lies aux phases
  299. do 910 ide = 1,lilmel(/1)
  300. deche = lilmel(ide)
  301. if (.false.) then
  302. if (indec.eq.indeso.and.imadec.eq.imamod) then
  303. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  304. ijlcon = ijlcon + 1
  305. lilcon(ijlcon) = deche
  306. else
  307. do im = 1,ivamod(/1)
  308. if (tymode(im).eq.'IMODEL ') then
  309. imode1 = ivamod(im)
  310. if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  311. &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  312. ijlcon = ijlcon + 1
  313. lilcon(ijlcon) = deche
  314. endif
  315. endif
  316. enddo
  317. endif
  318. elseif (indec.eq.2.and.imadec.eq.imamod.and.
  319. & condec(1:LCONMO).ne.conmod(1:LCONMO)) then
  320. do im = 1,ivamod(/1)
  321. if (tymode(im).eq.'IMODEL ') then
  322. imode1 = ivamod(im)
  323. if ((condec(1:LCONMO).eq.imode1.conmod(1:LCONMO)).or.
  324. &(nomdec(1:4).eq.imode1.conmod(17:20))) then
  325. ijlcon = ijlcon + 1
  326. lilcon(ijlcon) = deche
  327. endif
  328. endif
  329. enddo
  330. endif
  331. endif
  332. if (indec.ge.2.and.imadec.eq.imamod) then
  333. ijlcon = ijlcon + 1
  334. lilcon(ijlcon) = deche
  335. endif
  336. 910 continue
  337. iilcon = ijlcon
  338. segadj lilcon
  339. iilcon0 = iilcon
  340.  
  341. else
  342. c cas general
  343. C write(6,*) ' passage a la cloche mfr2 ', mfr2,lilmel(/1)
  344. do 200 iol=1,iinomp
  345. deche = linomp(iol)
  346. *
  347. * on change eventuellement sur les points d integration
  348. * convenables ... ce qui suppose en fait que l information
  349. * fournie a COMP n est pas redondante
  350. * en mecanique on utilise directement les champs fournis aux pgauss rigidite
  351. lome1 = infdec(6).eq.3.and.lesupp.eq.5
  352. lome2 = nomdec(1:4).eq.'TEMP'.or.
  353. & nomdec(1:4).eq.'LX '.or.
  354. & nomdec(1:4).eq.'FLX '
  355. if (infdec(6).ne.lesupp.and..not.lome1.and..not.lome2) then
  356. c write(6,*) 'change ', deche, nomdec
  357. iem = indec
  358. * cree un mchaml
  359. mchelm = IPOI1
  360. ifoche=ifodec
  361. conche(1) = condec
  362. imache(1) = imadec
  363. do j = 1,infdec(/1)
  364. infche(1,j) = infdec(j)
  365. enddo
  366. mchaml = ichaml(1)
  367. nomche(1) = nomdec
  368. typche(1) = typdec
  369. ielval(1) =ABS(ieldec)
  370. * write(6,*) ' changement de support nomdec ',nomdec
  371. call CHASUP(IPMOD1,IPOI1,IPOI2,IRET,lesupp)
  372. if (IRET.NE.0) then
  373. CALL ERREUR(IRET)
  374. return
  375. endif
  376. if (ierr.ne.0) return
  377. mchelm = ipoi2
  378. n1 = ichaml(/1)
  379. if (n1.ne.1) then
  380. * bizarre , contacter support
  381. moterr(17:24) = 'COML2'
  382. interr(1) = 1
  383. call erreur(943)
  384. return
  385. endif
  386. mchaml = ichaml(1)
  387. n2 = ielval(/1)
  388. if (n2.ne.1) then
  389. * bizarre , contacter support
  390. moterr(17:24) = 'COML2'
  391. interr(1) = 2
  392. call erreur(943)
  393. return
  394. endif
  395. * creer un deche
  396. n3 = infche(/2)
  397. segini deche
  398. indec = iem
  399. ieldec = ielval(1)
  400. typdec = typche(1)
  401. typree = typdec(1:6).eq.'REAL*8'
  402. nomdec = nomche(1)
  403. imadec = imache(1)
  404. condec = conche(1)
  405. ifodec = ifoche
  406. do in3 = 1, n3
  407. infdec(in3) = infche(1,in3)
  408. enddo
  409. segsup mchaml,mchelm
  410. * mettre dans une pile
  411. ijchan=ijchan+1
  412. if(ijchan.gt.iichan) then
  413. iichan=iichan+100
  414. segadj lichan
  415. endif
  416. lichan(ijchan) = deche
  417. endif
  418. C
  419. C write(6,*) 'lilcon ',deche,nomdec,typdec,condec,imadec,indec
  420. ijlcon=ijlcon+1
  421. if(ijlcon.gt.iilcon) then
  422. iilcon=iilcon+100
  423. segadj lilcon
  424. endif
  425. lilcon(ijlcon) = deche
  426. 200 CONTINUE
  427. endif
  428. C
  429. 201 CONTINUE
  430. C
  431. imodel = iqmod
  432. if (ijchan.ne.iichan) then
  433. iichan = ijchan
  434. segadj lichan
  435. endif
  436. C
  437. if (ijlcon.ne.iilcon) then
  438. iilcon=ijlcon
  439. segadj lilcon
  440. endif
  441. C
  442. C ===============================================================
  443. C INTEGRATION DE LA LOI DE COMPORTEMENT
  444. C ===============================================================
  445. if (lilcon(/1).ge.1) then
  446. * call gibtem(xkt)
  447. * write(6,*) ' coml2 : appel a coml6 ', xkt
  448. * do ioup=1,lilcon(/1)
  449. * deche=lilcon(ioup)
  450. * write(6,*)deche,' ',nomdec,' ',imadec,' ',indec,' ',condec
  451. * enddo
  452. * WRITE(*,*) 'APPEL A COML6 ',conmod,cmatee,inatuu
  453. call coml6(iqmod,ipmel,ipcon,ipinf,indeso,lesupp,jtruli,lformu,
  454. &IRETOU)
  455.  
  456. * call gibtem(xkt)
  457. * write(6,*) ' coml2 : retour de coml6 ',xkt
  458. else
  459. c write(6,*) 'pas de composante pour le sous-model ',imodel
  460. endif
  461. * write(6,*) 'coml2 : ierr ', ierr , 'iretou ', iretou
  462. if (ierr.gt.1) return
  463. C
  464. C ===============================================================
  465. * complete la pile des deche en sortie / desactive les DECHE et les MELVAL
  466. lilcon = ipcon
  467. ijmel=lilmel(/1)
  468. do 800 ioc =iilcon+1,lilcon(/1)
  469. deche = lilcon(ioc)
  470. if (indec.lt.indeso) then
  471. else if (indec.eq.indeso.and.
  472. & condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  473. * si on a ete coherent on ne peut creer 2 fois le meme deche
  474. * on ne rajoute que les deche crees sur le constituant
  475. * on ne met pas dans lilmel les deches intermediaires
  476. c if (cmatee.eq.'PARALLEL')
  477. c &write(6,*) 'c2lilcon',ioc,deche,nomdec
  478. if (ijchan.gt.0) then
  479. do iyf = 1,ijchan
  480. if (lichan(iyf).eq.deche) goto 800
  481. enddo
  482. endif
  483. ijmel=ijmel+1
  484. if(ijmel.gt.iimel) then
  485. iimel=iimel+100
  486. segadj lilmel
  487. endif
  488. lilmel(ijmel) = deche
  489. else
  490. endif
  491. 800 continue
  492. iimel=ijmel
  493. segadj lilmel
  494. segsup lilcon,linomp
  495.  
  496. * supprime melval intermediaire
  497. if (ijchan.gt.0) then
  498. do iop = 1,ijchan
  499. deche = lichan(iop)
  500. c write(6,*) 'deche ', nomdec , indec, ieldec
  501. do il = 1,lilmel(/1)
  502. dec1 = lilmel(il)
  503. c write(6,*) 'de1 ', dec1.nomdec , dec1.indec, dec1.ieldec
  504. if (dec1.indec.eq.indeso.and.dec1.ieldec.eq.ieldec) goto 810
  505. enddo
  506. melval =ABS(ieldec)
  507. c write(6,*) 'supprime deche ',nomdec,melval,deche
  508. segsup melval
  509. 810 continue
  510. segsup deche
  511. enddo
  512. endif
  513. segsup lichan
  514. C
  515. if (ierr.ne.0) return
  516. if (iretou.ne.0) return
  517. C
  518. if (info.ne.0) then
  519. segsup info
  520. info=0
  521. endif
  522.  
  523. 1000 CONTINUE
  524. C ----------------------------------------------
  525. C Fin de boucle (1000) sur les modeles elementaires
  526. C ----------------------------------------------
  527. C
  528. C Destruction du segment struli (si utilise)
  529. if (itruli.ne.0) then
  530. if (momoda.gt.0) then
  531. mmode2 = momoda
  532. segsup mmode2
  533. endif
  534. if (mostat.gt.0) then
  535. mmode2 = mostat
  536. segsup mmode2
  537. endif
  538. if (itbmod.gt.0) then
  539. mmode2 = itbmod
  540. segsup mmode2
  541. endif
  542. if (itlia.gt.0) then
  543. mmode2 = itlia
  544. segsup mmode2
  545. endif
  546. if (ichain.gt.0) then
  547. mlent3 = ichain
  548. segsup mlent3
  549. endif
  550. segsup struli
  551. endif
  552. C
  553. C Destruction autres segments
  554. mmode1 = IPMOD1
  555. segsup mmode1
  556. mchelm = IPOI1
  557. mchaml = ichaml(1)
  558. segsup,mchaml,mchelm
  559. * write(ioimp,*) ' sortie coml2 ' , xkt
  560. END
  561.  
  562.  
  563.  

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