Télécharger fusmod.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSMOD SOURCE GG250959 17/09/20 21:15:26 9554
  2.  
  3. SUBROUTINE FUSMOD(MODL1,MODL2,MODL)
  4.  
  5. *--------------------------------------------------------------------*
  6. * *
  7. * REUNION DE DEUX OBJETS MODELE *
  8. * *
  9. * ENTREES/SORTIE: *
  10. * *
  11. * MODL1 POINTEUR SUR LE PREMIER OBJET MODELE *
  12. * MODL2 POINTEUR SUR LE SECOND OBJET MODELE *
  13. * MODL POINTEUR SUR L'OBJET MODELE RESULTAT *
  14. * = 0 SINON *
  15. * *
  16. * AM 22/6/93 ON EXCLUT LA POSSIBILITE DE ZONE COMMUNE *
  17. * *
  18. *--------------------------------------------------------------------*
  19. *
  20. * - UNE ZONE ELEMENTAIRE EST DITE COMMUNE AUX DEUX "MODELE" SI:
  21. * LES GEOMETRIES ELEMENTAIRES
  22. * LES NOMS DE CONSTITUANTS
  23. * LES NUMEROS DES TYPES D'ELEMENTS-FINIS
  24. * LES INFMOD
  25. * LES FORMULATIONS
  26. * LES TYPES DE MATERIAUX
  27. * SONT LES MEMES.
  28. *
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC CCOPTIO
  33. -INC SMMODEL
  34. -INC SMELEME
  35. *
  36. CHARACTER*(LCONMO) CONM1,CONM2
  37. LOGICAL bXFEM
  38. *
  39. * INITIALISATION
  40. *
  41. MODL=0
  42. MMODE1=MODL1
  43. MMODE2=MODL2
  44. SEGACT,MMODE1,MMODE2
  45. NMOD1=MMODE1.KMODEL(/1)
  46. NMOD2=MMODE2.KMODEL(/1)
  47. *
  48. IF (IIMPI.EQ.666) THEN
  49. WRITE(IOIMP,*)'*** SOUS-PROGRAMME FUSMOD ***'
  50. WRITE(IOIMP,*)'NOMBRE DE ZONES ELEMENTAIRES : ',NMOD1
  51. WRITE(IOIMP,*)'NOMBRE DE ZONES ELEMENTAIRES : ',NMOD2
  52. ENDIF
  53. *
  54. DO 10 I10=1,NMOD1
  55. *
  56. * BOUCLE SUR LES ZONES ELEMENTAIRES DU 1ER "MODELE"
  57. *
  58. IMODE1=MMODE1.KMODEL(I10)
  59. SEGACT,IMODE1
  60. nefm1=IMODE1.NEFMOD
  61. ipma1=IMODE1.IMAMOD
  62. conm1=IMODE1.CONMOD
  63. *
  64. DO 20 I20=1,NMOD2
  65. *
  66. * BOUCLE SUR LES ZONES ELEMENTAIRES DU 2ND "MODELE"
  67. *
  68. IMODE2=MMODE2.KMODEL(I20)
  69. SEGACT,IMODE2
  70. nefm2=IMODE2.NEFMOD
  71. ipma2=IMODE2.IMAMOD
  72. conm2=IMODE2.CONMOD
  73. ckich quand la phase est identique et le type d element identique
  74. c c est tout ou rien
  75. IF (nefm1.EQ.nefm2 .AND. conm1.EQ.conm2 .AND.
  76. & imode1.formod(1).EQ.imode2.formod(1)) THEN
  77. iret = 0
  78. call interb(ipma1,ipma2,iret,iob1)
  79. if (iret.GT.0) goto 16
  80. ipt2 = ipma1
  81. ipt3 = ipma2
  82. ipt4 = iob1
  83. segact ipt2,ipt3,ipt4
  84. if (ipt2.num(/2).ne.ipt3.num(/2).or.
  85. & ipt2.num(/2).ne.ipt4.num(/2)) then
  86. call erreur(618)
  87. write(6,*) ' maillages non disjoints mais phase commune '
  88. goto 999
  89. endif
  90. ENDIF
  91. 16 IF (ipma1.NE.ipma2) GOTO 20
  92. *
  93. * ---- AM 22/6/93
  94. * ON VERIFIE QU'IL N'Y A PAS DE ZONE COMMUNE, C'EST A DIRE
  95. * QUE SI LES MAILLAGES SONT IDENTIQUES, LES CONSTITUANTS EUX
  96. * SONT DIFFERENTS
  97. *
  98. IF (conm1.EQ.conm2) THEN
  99. IF (nefm1.NE.nefm2) THEN
  100. CALL ERREUR(618)
  101. ELSE
  102. CALL ERREUR(617)
  103. ENDIF
  104. GO TO 999
  105. ENDIF
  106. * ----
  107. 20 CONTINUE
  108. * END DO
  109. 10 CONTINUE
  110. * END DO
  111. *
  112. N1=NMOD1+NMOD2
  113. SEGINI,MMODEL
  114. MODL=MMODEL
  115. *
  116. * BOUCLE SUR LES ZONES GEOMETRIQUES DU 1ER "MODELE"
  117. *
  118. IF (IIMPI.EQ.666) THEN
  119. WRITE(IOIMP,*)'*** SOUS-PROGRAMME FUSMOD ***'
  120. WRITE(IOIMP,*)'BOUCLE SUR LES ZONES DU 1ER MODELE'
  121. ENDIF
  122. DO 50 IA=1,NMOD1
  123. IMODE1=MMODE1.KMODEL(IA)
  124. SEGINI,IMODEL=imode1
  125. KMODEL(IA)=IMODEL
  126. C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  127. nfor = formod(/2)
  128. CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  129. CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  130. CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  131. IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))INFMOD(2)=0
  132. 50 CONTINUE
  133. * END DO
  134. *
  135. * BOUCLE SUR LES ZONES GEOMETRIQUES DU 2ND "MODELE"
  136. *
  137. IF (IIMPI.EQ.666) THEN
  138. WRITE(IOIMP,*)'*** SOUS-PROGRAMME FUSMOD ***'
  139. WRITE(IOIMP,*)'BOUCLE SUR LES ZONES DU 2ND MODELE'
  140. ENDIF
  141. DO 80 IB=1,NMOD2
  142. IMODE2=MMODE2.KMODEL(IB)
  143. SEGINI,IMODEL=imode2
  144. KMODEL(IB+NMOD1)=IMODEL
  145.  
  146. C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  147. nfor = formod(/2)
  148. CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  149. CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  150. CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  151. IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))INFMOD(2)=0
  152. 80 CONTINUE
  153. * END DO
  154. *
  155. 999 CONTINUE
  156. SEGDES,MMODE1,MMODE2
  157. IF (MODL.EQ.0) RETURN
  158. *
  159. * on va maintenant fusionner les zones geometriques de memes caracteristiques
  160. *
  161. do 100 i=1,kmodel(/1)
  162. imode1=kmodel(i)
  163. c* segact imode1
  164. if (imode1.eq.0) goto 100
  165. ipt1=imode1.imamod
  166. if (ipt1.eq.0) goto 100
  167. nefm1=imode1.nefmod
  168. conm1=imode1.conmod
  169. segact ipt1
  170. ityp1=ipt1.itypel
  171. bXFEM = NUMMFR(nefm1).EQ.63
  172. c* bXFEM = imode1.infele(13).EQ.63
  173. do 110 j=i+1,kmodel(/1)
  174. imode2=kmodel(j)
  175. if (imode2.eq.0) goto 110
  176. c* segact imode2
  177. if (imode2.nefmod.ne.nefm1) goto 110
  178. if (imode2.conmod.ne.conm1) goto 110
  179. ipt2=imode2.imamod
  180. segact ipt2
  181. if (ipt2.itypel.ne.ityp1) goto 110
  182. if (imode2.cmatee.ne.imode1.cmatee) goto 110
  183. ** if (imode2.infmod(/1).ne.imode1.infmod(/1)) goto 110
  184. ** do k=1,imode1.infmod(/1)
  185. ** if (imode2.infmod(k).ne.imode1.infmod(k)) goto 110
  186. ** enddo
  187. if (imode2.formod(/2).ne.imode1.formod(/2)) goto 110
  188. do k=1,imode1.formod(/2)
  189. if (imode2.formod(k).ne.imode1.formod(k)) goto 110
  190. enddo
  191. if (imode2.matmod(/2).ne.imode1.matmod(/2)) goto 110
  192. do k=1,imode1.matmod(/2)
  193. if (imode2.matmod(k).ne.imode1.matmod(k)) goto 110
  194. enddo
  195. if (imode2.ipdpge.ne.imode1.ipdpge) goto 110
  196. if (imode2.inatuu.ne.imode1.inatuu) goto 110
  197. if (imode2.lnomid(/1).ne.imode1.lnomid(/1)) goto 110
  198. * BP, 2016-03-25 : ajout test car en sortie de RAFF
  199. * on a 2 ou 3 sous modeles identiques aux noms de composantes pres
  200.  
  201. IF (nefm1.eq.22) THEN
  202. do k=1,imode1.lnomid(/1)
  203. if (imode2.lnomid(k).ne.imode1.lnomid(k)) goto 110
  204. enddo
  205. ENDIF
  206. * GG : si deux sure de couleurs differentes pas de fusion
  207. IF (nefm1.eq.259) THEN
  208. if (ipt1.ICOLOR(1).ne.ipt2.ICOLOR(1)) goto 110
  209. ENDIF
  210. if (imode2.infele(/1).ne.imode1.infele(/1)) goto 110
  211. do k=1,imode1.infele(/1)
  212. if (imode2.infele(k).ne.imode1.infele(k)) goto 110
  213. enddo
  214. if (.NOT. bXFEM) then
  215. if (imode2.tymode(/2).ne.imode1.tymode(/2)) goto 110
  216. do k=1,imode1.tymode(/2)
  217. if (imode2.tymode(k).ne.imode1.tymode(k)) goto 110
  218. enddo
  219. if (imode2.ivamod(/1).ne.imode1.ivamod(/1)) goto 110
  220. do k=1,imode1.ivamod(/1)
  221. if (imode2.ivamod(k).ne.imode1.ivamod(k)) goto 110
  222. enddo
  223. endif
  224. * fusion des meleme
  225. nbnn =ipt1.num(/1)
  226. nbel1=ipt1.num(/2)
  227. nbel2=ipt2.num(/2)
  228. nbelem=nbel1+nbel2
  229. nbref=0
  230. nbsous=0
  231. segini meleme
  232. itypel=ityp1
  233. do iel= 1,nbel1
  234. do ino=1,nbnn
  235. num(ino,iel)=ipt1.num(ino,iel)
  236. enddo
  237. icolor(iel)=ipt1.icolor(iel)
  238. enddo
  239. do iel =1,nbel2
  240. jel = iel+nbel1
  241. do ino =1,nbnn
  242. num(ino,jel)=ipt2.num(ino,iel)
  243. enddo
  244. icolor(jel)=ipt2.icolor(iel)
  245. enddo
  246. ipt1=meleme
  247. c* segact imode1*mod,imode2*mod
  248. imode1.imamod=ipt1
  249. IF (bXFEM) CALL FUCHXR(imode1,imode2,0)
  250. c* imode2.imamod=0
  251. c* segsup,imode2
  252. kmodel(j)=0
  253. 110 continue
  254. IF (bXFEM) CALL PARTXR(0,ipt1,imode1)
  255. 100 continue
  256. * desactivation & compactage du modele
  257. idec=0
  258. do 130 i=1,kmodel(/1)
  259. imode1=kmodel(i)
  260. if (imode1.eq.0) then
  261. idec=idec+1
  262. else
  263. kmodel(i-idec)=imode1
  264. segdes,imode1
  265. endif
  266. 130 continue
  267. if (idec.gt.0) then
  268. n1=kmodel(/1)-idec
  269. segadj mmodel
  270. endif
  271.  
  272. RETURN
  273. END
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  

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