C SUBNNM SOURCE CHAT 11/03/16 21:31:52 6902 SUBROUTINE SUBNNM(IPM,IPNN,IMD,IRET) C====================================================================C C C C OPERATEUR CABLE : Localisation d un element d un cable dans C C dans un element massif par la position de son milieu C le cable original a deja ete fragmente aux limites des C C elements massifs qu'il traverse par passage dans subinc C C C ENTREES : C C C C IPM(1 et 2) : Pointeurs sur les modèles de béton et d'aciers C C IMD : Nombre de modeles introduits dans IPM C 1 beton plus pour le moment 1 seul cable par modele C sauf pour les cerc axis C C C C SORTIES : C C C C IPM(3) : Pointeur sur le modele acier modifié C C IPNN C C--------------------------------------------------------------------C C C C====================================================================C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC CCOPTIO -INC CCHAMP *- -INC CCREEL -INC SMELEME -INC SMMODEL -INC SMCOORD -INC SMLREEL -INC SMINTE -INC SMCHAML -INC CCGEOME segment icount integer ieint(2,nodes),maxpz(1) real*8 qqq(3,nodes) endsegment segment icosom integer iptt(nbsz) endsegment segment iexclu integer idejvu(nbpts) endsegment segment wrk1 real*8 x1(3),x2(3),dx(3),p1(3),p2(3),p3(3) endsegment segment itabu integer inzel(2,nbpts) endsegment segment iccmai integer icmail(nsous) endsegment segment icofac integer inodfa1(25),inodfa2(25),icomn(10) endsegment segment ipnn integer ipnnum(nsous) endsegment segment nnum integer nnm(nbn,nbele),nbem(2,nbele) endsegment C SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT C C CHARACTER*4 CMOT CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) DIMENSION IPM(*) DATA EPSI/1.D-3/ C IPCHE=0 IPCHE2=0 MELVAL=0 IRET=1 IM=2 C IF(IM.EQ.IMD+1.AND.IMD.NE.1) GOTO 9999 IF(IMD.EQ.1) GOTO 5 C C --- ACTIVATION DU model cable C MMODEL = IPM(IM) IM=IM+1 SEGACT MMODEL NSOU1 = KMODEL(/1) 5 CONTINUE IF(IMD.EQ.1) NSOU1=1 C C --- boucle sur les elemenst cable ( en fait 1 seul pour le moment) C DO 40 ISOU1=1,NSOU1 IF(ISOU1.GT.1) THEN MMODEL = IPM(IM-1) SEGACT MMODEL END IF IMODEL=KMODEL(ISOU1) SEGACT IMODEL*MOD MELC = NEFMOD MELEM=MELE IPMAIL= IMAMOD CONM = CONMOD * CALL ELQUOI(MELC,0,3,IPINF,IMODEL) IF ( IERR.NE.0 ) THEN SEGDES IMODEL,MMODEL IRET=0 RETURN END IF * INFO=IPINF * SEGSUP INFO C MELEME=IPMAIL SEGACT MELEME C attention pour le moment seg2 uniquement C activation du modele beton MMODEL = IPM(1) SEGACT MMODEL NSOUS = KMODEL(/1) NS=NSOUS segini IPNN nbpti = xcoor(/1)/(idim+1) nbpts=nbpti ipt2 = ipmail segact ipt2 if(melc.ne.95) then idi4=idim+1 nbnn=1 nbelem=ipt2.num(/2) NBSOUS=0 NBREF=0 segini ipt3 ipt3.itypel=1 nbpts=nbpti+nbelem segadj mcoord do 400 k=1,nbelem i1=ipt2.num(1,k) i2=ipt2.num(2,k) ip =nbpti+k ipt3.num(1,k) =ip xmil=(xcoor((i1-1)*idi4+1)+xcoor((i2-1)*idi4+1))/2.D0 ymil=(xcoor((i1-1)*idi4+2)+xcoor((i2-1)*idi4+2))/2.D0 xcoor((ip-1)*idi4+1) = xmil xcoor((ip-1)*idi4+2) = ymil if(idim.eq.3) then zmil=(xcoor((i1-1)*idi4+3)+xcoor((i2-1)*idi4+3))/2.D0 xcoor((ip-1)*idi4+3) = zmil endif 400 continue else segini ,ipt3=ipt2 endif segdes ipt3 C nodes = ipt2.num(/2) C on aura besoin du point initial C ipinit = ipt2.num(1,1) C C on veut savoir si il y a des point vus deux fois (interfaces sous zones) segini iexclu iexx = iexclu C C --- BOUCLE SUR LES ZONES ELEMENTAIRES DU BETON C NBSZ = NSOUS segini icosom iaccro = 0 DO 22 ISOUS=1,NSOUS IMODEL=KMODEL(ISOUS) SEGACT IMODEL MELE = NEFMOD IPMAIL= IMAMOD MELEME=IPMAIL SEGACT MELEME if (itypel.lt.4) then call erreur(16) C attention a completer probablement segdes meleme return endif C segdes meleme C icmail(isous) = ipmail C ICI LE ZONAGE C============================================ CALL ZONAG(ipmail,ipt3,ICC,IEXX,1) C============================================ C C TABLE DES POINTEURS SUR LES TABLEAUX DE CORRESPONDANCE C WRITE(6,*) 'POINTEUR ZONE ',IOB,ICC IPTT(isous) = ICC ICOUNT = ICC SEGACT ICOUNT iaccro = iaccro + MAXPZ(1) C do 777 i=1,MAXPZ(1) C write(6,*)'zone ',i' 'point ',IEINT(1,I),'elem ',IEINT(2,I) C 777 continue C SEGDES ICOUNT 22 CONTINUE C segsup wrk1 40 continue segsup iexclu nbpts = xcoor(/1)/(idim+1) segini itabu do 140 izon = 1,nsous icc = iptt(izon) icount= icc C segact icount if(maxpz(1).eq.0) goto 139 do 141 i=1,maxpz(1) kk = ieint(1,i) inzel(1,kk) = izon inzel(2,kk) = ieint(2,i) C write(6,*) kk ,izon,ieint(2,i) 141 continue 139 segdes icount 140 continue nbn=ipt2.num(/1) nbele=ipt2.num(/2) segini nnum ipnnum(1)=nnum C write(6,*) 'subinn ipnn nnum ',ipnn,nnum C segact ipt2 izel = 0 do 100 iel=1,nbele do 110 il=1,nbn nnm(il,iel)=ipt2.num(il,iel) 110 continue if(melc.ne.95) then C sous zone a laquelle appartientt l element iel nbem(2,iel) = inzel(1,nbpti+iel) C element beton contenant le cable iel nbem(1,iel) = inzel(2,nbpti+iel) else nbem(2,iel) = inzel(1,ipt2.num(1,iel)) nbem(1,iel) = inzel(2,ipt2.num(1,iel)) endif C write(6,2222)iel, nnm(1,iel),nnm(2,iel),nbem(1,iel), C & nbem(2,iel) 100 continue segsup itabu,icosom nbpts=nbpti segadj mcoord segdes nnum C110 continue 2222 FORMAT(I4,2X,2I4,2X,2I4) IMD = 2 segsup ipt3 SEGDES IMODEL,ipnn,ipt2 C RETURN END