C COMCRE SOURCE FANDEUR 12/07/18 21:15:09 7435 SUBROUTINE COMCRE(iqmod,ipcon,irang,mocomp,lscont,IPMINT, & lesupp,iwrk53,jluc,iretou) *- * cree les deche necessaires associees aux noms de composantes * et au rang argument (en sortie a priori) * garde les adresses dans une pile *- *---------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC CCOPTIO -INC SMMODEL -INC SMCHAML c*-INC SMINTE -INC DECHE * imodel = iqmod wrk53 = iwrk53 lilcon = ipcon iilcon=lilcon(/1) ijlcon=iilcon pilnec = lscont ** segact pilnec*mod mobl = pilobl(/1) mfac = pilfac(/1) *------------------------------------------------- *** jecree=0 veut dire de ne pas recreer le champ s'il existe en entrée *** mais le récupérer. jecree = 1 jtestj = 0 if (jluc.eq.2.or.jluc.eq.15) then jecree=0 else if (jluc.eq.14) then jecree=0 else if(jluc.eq.13) then if (formod(1).eq.'MECANIQUE') then jecree=0 else if (formod(1).eq.'POREUX') then if (inplas.ge.0) jecree=0 else if (formod(1).eq.'LIAISON') then jecree=0 else if (formod(1).eq.'MELANGE') then if (cmate.eq.'PARALLEL') jecree=0 endif * specifique pour endommagement sic_sic if (inplas.eq. 88) jtestj=15 * specifique pour viscoplastique parfait if (inplas.eq. 43) jtestj=6 * specifique pour plastique isotrope tuyau if (inplas.eq. 5) jtestj=3 * specifique pour orthotrope viscoplastique mistral if (inplas.eq. 94) jtestj=15 endif nomid = mocomp ** segact nomid*nomod nobl = lesobl(/2) nfac = lesfac(/2) call cotype(iqmod,jluc,motype,iwrk53,nobl,nfac) notype = motype nbtype = 0 if (notype.NE.0) then nbtype = type(/2) ENDIF if (nbtype.ne.0) GOTO 200 * do jm =1,mobl dec1=pilobl(jm,2) if(dec1.eq.0) then dec1=pilobl(jm,1) endif if (FORMOD(1).EQ.'MELANGE'.and.cmate.eq.'PARALLEL' &.and.pilobl(jm,3).gt.0 ) dec1 = pilobl(jm,3) if (dec1.gt.0) then segini,deche=dec1 indec = irang ijlcon=ijlcon+1 if(ijlcon.gt.iilcon) then iilcon=iilcon+mobl+mfac segadj lilcon endif lilcon(ijlcon) = deche if (jecree.eq.1) then if (typdec(1:8).eq.'REAL*8') then N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 else N2PTEL=NBPTEL N2EL=NEL N1PTEL=0 N1EL=0 endif segini melval ieldec = melval ** segdes melval else * write(6,*) 'deche imite',nomdec,ieldec,n1ptel,n1el,condec,jecree endif ** segdes deche pilobl(jm,irang)= deche endif enddo do jm =1,mfac dec1=pilfac(jm,2) if (dec1.gt.0) then segini,deche=dec1 indec = irang ijlcon=ijlcon+1 if(ijlcon.gt.iilcon) then iilcon=iilcon+mfac segadj lilcon endif lilcon(ijlcon) = deche if(jecree.eq.1) then if (typdec(1:8).eq.'REAL*8') then N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 else N2PTEL=NBPTEL N2EL=NEL N1PTEL=0 N1EL=0 endif segini melval ieldec = melval ** segdes melval endif ** segdes deche pilfac(jm,irang)= deche endif enddo GOTO 50 200 CONTINUE deche = lilcon(1) ** segact deche*nomod * n3 a revoir n3 = infdec(/1) ** segdes deche do 30 jm = 1, mobl dec1=pilobl(jm,irang-1) if(dec1.eq.0) dec1=pilobl(jm,1) segini deche ijlcon=ijlcon+1 if( ijlcon.gt.iilcon) then iilcon=iilcon + mobl + mfac segadj lilcon endif lilcon(ijlcon) = deche pilobl(jm,irang)=deche nomdec = lesobl(jm) imadec = imamod ICMN=MIN(jm,NBTYPE) typdec = type(icmn) condec = conmod ifodec = IFOUR indec = irang infdec(1) = 0 infdec(2) = 0 infdec(3) = NIFOUR infdec(4) = IPMINT infdec(5) = 0 infdec(6) = lesupp * if(jecree.eq.0) then if(jm.le.jtestj.and.jluc.eq.13)go to 356 if(dec1.ne.0) then segact dec1 ieldec = dec1.ieldec * write(6,*) 'dec rep', nomdec, ieldec, deche,condec ******** segdes dec1 go to 345 endif endif 356 continue if (type(icmn)(1:8).eq.'REAL*8') then N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 else N2PTEL=NBPTEL N2EL=NEL N1PTEL=0 N1EL=0 endif segini melval * write(6,*) 'cree ',nomdec,melval,n1ptel,n1el,condec ieldec = melval ** segdes melval 345 continue ** segdes deche 30 continue do 31 jm =1,mfac dec1=pilfac(jm,irang-1) if(dec1.eq.0) dec1=pilfac(jm,1) if (jluc.eq.20) then if (formod(1).eq.'LIAISON') goto 340 * kich : composantes facultatives MODAL / STATIQUE else if (jluc.eq.11) then if (imatee.eq.9 .or. imatee.eq.10) goto 340 endif if(dec1.eq.0) go to 31 340 segini deche ijlcon=ijlcon+1 if(ijlcon.gt.iilcon) then iilcon = iilcon+mfac segadj lilcon endif lilcon(ijlcon) = deche pilfac(jm,irang)=deche nomdec = lesfac(jm) imadec = imamod ICMN=MIN(jm+nobl,NBTYPE) typdec = type(icmn) condec = conmod ifodec = IFOUR indec = irang infdec(1) = 0 infdec(2) = 0 infdec(3) = NIFOUR infdec(4) = IPMINT infdec(5) = 0 infdec(6) = lesupp if(jecree.eq.0.and.dec1.gt.0) then segact dec1 ieldec=dec1.ieldec ** segdes dec1 * write(6,*) 'dec fac rep', nomdec, ieldec, deche,condec go to 346 endif if (type(icmn)(1:8).eq.'REAL*8') then N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 else N2PTEL=NBPTEL N2EL=NEL N1PTEL=0 N1EL=0 endif * segini melval * write(6,*) 'cree fac',cmatee,nomdec,melvaln1ptel,n1el,condec ieldec = melval *********** segdes melval 346 continue ******** segdes deche 31 continue 50 CONTINUE ** segdes nomid,pilnec segsup notype * if (iilcon.ne.ijlcon) then iilcon=ijlcon segadj lilcon endif RETURN END