1 : C FUSMOD SOURCE FANDEUR 13/01/16 21:15:18 7665 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 77 : call interb(ipma1,ipma2,iret,iob1) 78 : if (iret.GT.0) goto 16 79 : ipt2 = ipma1 80 : ipt3 = ipma2 81 : ipt4 = iob1 82 : segact ipt2,ipt3,ipt4 83 : if (ipt2.num(/2).ne.ipt3.num(/2).or. 84 : & ipt2.num(/2).ne.ipt4.num(/2)) then 84 : call erreur(618) 85 : write(6,*) ' maillages non disjoints mais phase commune ' 86 : goto 999 87 : endif 88 : ENDIF 89 : 16 IF (ipma1.NE.ipma2) GOTO 20 90 : * 91 : * ---- AM 22/6/93 92 : * ON VERIFIE QU'IL N'Y A PAS DE ZONE COMMUNE, C'EST A DIRE 93 : * QUE SI LES MAILLAGES SONT IDENTIQUES, LES CONSTITUANTS EUX 94 : * SONT DIFFERENTS 95 : * 96 : IF (conm1.EQ.conm2) THEN 97 : IF (nefm1.NE.nefm2) THEN 97 : CALL ERREUR(618) 98 : ELSE 98 : CALL ERREUR(617) 99 : ENDIF 100 : GO TO 999 101 : ENDIF 102 : * ---- 103 : 20 CONTINUE 104 : * END DO 105 : 10 CONTINUE 106 : * END DO 107 : * 108 : N1=NMOD1+NMOD2 109 : SEGINI,MMODEL 110 : MODL=MMODEL 111 : * 112 : * BOUCLE SUR LES ZONES GEOMETRIQUES DU 1ER "MODELE" 113 : * 114 : IF (IIMPI.EQ.666) THEN 115 : WRITE(IOIMP,*)'*** SOUS-PROGRAMME FUSMOD ***' 116 : WRITE(IOIMP,*)'BOUCLE SUR LES ZONES DU 1ER MODELE' 117 : ENDIF 118 : DO 50 IA=1,NMOD1 119 : IMODE1=MMODE1.KMODEL(IA) 120 : SEGINI,IMODEL=imode1 121 : KMODEL(IA)=IMODEL 122 : C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT 123 : nfor = formod(/2) 123 : CALL PLACE (FORMOD,NFOR,IDARC,'DARCY') 123 : CALL PLACE (FORMOD,NFOR,IEULE,'EULER') 123 : CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES') 124 : IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))INFMOD(2)=0 125 : 50 CONTINUE 126 : * END DO 127 : * 128 : * BOUCLE SUR LES ZONES GEOMETRIQUES DU 2ND "MODELE" 129 : * 130 : IF (IIMPI.EQ.666) THEN 131 : WRITE(IOIMP,*)'*** SOUS-PROGRAMME FUSMOD ***' 132 : WRITE(IOIMP,*)'BOUCLE SUR LES ZONES DU 2ND MODELE' 133 : ENDIF 134 : DO 80 IB=1,NMOD2 135 : IMODE2=MMODE2.KMODEL(IB) 136 : SEGINI,IMODEL=imode2 137 : KMODEL(IB+NMOD1)=IMODEL 138 : 139 : C CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT 140 : nfor = formod(/2) 140 : CALL PLACE (FORMOD,NFOR,IDARC,'DARCY') 140 : CALL PLACE (FORMOD,NFOR,IEULE,'EULER') 140 : CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES') 141 : IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))INFMOD(2)=0 142 : 80 CONTINUE 143 : * END DO 144 : * 145 : 999 CONTINUE 146 : SEGDES,MMODE1,MMODE2 147 : IF (MODL.EQ.0) RETURN 148 : * 149 : * on va maintenant fusionner les zones geometriques de memes caracteristiques 150 : * 151 : do 100 i=1,kmodel(/1) 152 : imode1=kmodel(i) 153 : c* segact imode1 154 : if (imode1.eq.0) goto 100 155 : ipt1=imode1.imamod 156 : if (ipt1.eq.0) goto 100 157 : nefm1=imode1.nefmod 158 : conm1=imode1.conmod 159 : segact ipt1 160 : ityp1=ipt1.itypel 161 : bXFEM = NUMMFR(nefm1).EQ.63 162 : c* bXFEM = imode1.infele(13).EQ.63 163 : do 110 j=i+1,kmodel(/1) 164 : imode2=kmodel(j) 165 : if (imode2.eq.0) goto 110 166 : c* segact imode2 167 : if (imode2.nefmod.ne.nefm1) goto 110 168 : if (imode2.conmod.ne.conm1) goto 110 169 : ipt2=imode2.imamod 170 : segact ipt2 171 : if (ipt2.itypel.ne.ityp1) goto 110 172 : if (imode2.cmatee.ne.imode1.cmatee) goto 110 173 : ** if (imode2.infmod(/1).ne.imode1.infmod(/1)) goto 110 174 : ** do k=1,imode1.infmod(/1) 175 : ** if (imode2.infmod(k).ne.imode1.infmod(k)) goto 110 176 : ** enddo 177 : if (imode2.formod(/2).ne.imode1.formod(/2)) goto 110 178 : do k=1,imode1.formod(/2) 179 : if (imode2.formod(k).ne.imode1.formod(k)) goto 110 180 : enddo 181 : if (imode2.matmod(/2).ne.imode1.matmod(/2)) goto 110 182 : do k=1,imode1.matmod(/2) 183 : if (imode2.matmod(k).ne.imode1.matmod(k)) goto 110 184 : enddo 185 : if (imode2.ipdpge.ne.imode1.ipdpge) goto 110 186 : if (imode2.inatuu.ne.imode1.inatuu) goto 110 187 : if (imode2.lnomid(/1).ne.imode1.lnomid(/1)) goto 110 188 : ** do k=1,imode1.lnomid(/1) 189 : ** if (imode2.lnomid(k).ne.imode1.lnomid(k)) goto 110 190 : ** enddo 191 : if (imode2.infele(/1).ne.imode1.infele(/1)) goto 110 192 : do k=1,imode1.infele(/1) 193 : if (imode2.infele(k).ne.imode1.infele(k)) goto 110 194 : enddo 195 : if (.NOT. bXFEM) then 196 : if (imode2.tymode(/2).ne.imode1.tymode(/2)) goto 110 197 : do k=1,imode1.tymode(/2) 198 : if (imode2.tymode(k).ne.imode1.tymode(k)) goto 110 199 : enddo 200 : if (imode2.ivamod(/1).ne.imode1.ivamod(/1)) goto 110 201 : do k=1,imode1.ivamod(/1) 202 : if (imode2.ivamod(k).ne.imode1.ivamod(k)) goto 110 203 : enddo 204 : endif 205 : * fusion des meleme 206 : nbnn =ipt1.num(/1) 207 : nbel1=ipt1.num(/2) 208 : nbel2=ipt2.num(/2) 209 : nbelem=nbel1+nbel2 210 : nbref=0 211 : nbsous=0 212 : segini meleme 213 : itypel=ityp1 214 : do iel= 1,nbel1 215 : do ino=1,nbnn 216 : num(ino,iel)=ipt1.num(ino,iel) 217 : enddo 218 : icolor(iel)=ipt1.icolor(iel) 219 : enddo 220 : do iel =1,nbel2 221 : jel = iel+nbel1 222 : do ino =1,nbnn 223 : num(ino,jel)=ipt2.num(ino,iel) 224 : enddo 225 : icolor(jel)=ipt2.icolor(iel) 226 : enddo 227 : ipt1=meleme 228 : c* segact imode1*mod,imode2*mod 229 : imode1.imamod=ipt1 229 : IF (bXFEM) CALL FUCHXR(imode1,imode2,0) 230 : c* imode2.imamod=0 231 : c* segsup,imode2 232 : kmodel(j)=0 233 : 110 continue 233 : IF (bXFEM) CALL PARTXR(0,ipt1,imode1) 234 : 100 continue 235 : * desactivation & compactage du modele 236 : idec=0 237 : do 130 i=1,kmodel(/1) 238 : imode1=kmodel(i) 239 : if (imode1.eq.0) then 240 : idec=idec+1 241 : else 242 : kmodel(i-idec)=imode1 243 : segdes,imode1 244 : endif 245 : 130 continue 246 : if (idec.gt.0) then 247 : n1=kmodel(/1)-idec 248 : segadj mmodel 249 : endif 250 : 251 : RETURN 252 : END 253 : 254 : 255 : 256 :
© Cast3M 2003 - All rights reserved.
Disclaimer