C DYNE17 SOURCE KICH 09/11/27 21:16:11 6552 SUBROUTINE DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA, &KSAM,lmodyn) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Op{rateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Cr{ation des CHPOINTs qui contiendront les r{sultats. * * Cr{ation des LISTREELs qui contiendront les r{sultats. * * Cr{ation des POINTS qui contiendront les varaibles de liaison * * n{cessaires @ une reprise. * * * * Param}tres: * * * * e ITBAS Table repr{sentant une base modale * * e ITKM Table contenant les matrices XK et XM * * e IPMAIL Maillage de r{f{rence * * es KTRES Segment de sauvegarde des r{sultats * * e KPREF Segment des points de r{f{rence * * e NPLAA Nombre max de pts pour les liaisons en base A * * e NXPALA Nombre max de var internes pour ces memes liaisons * * * * Remarque importante: tous les CHPOINTs cr{{s vont pointer * * sur le mªme MELEME afin de limiter au maximum la m{moire * * utilis{e. * * * * Auteur, date de cr{ation: * * * * Denis ROBERT-MOUGIN, le 30 juin 1989. * * * *--------------------------------------------------------------------* -INC CCOPTIO -INC SMCHARG -INC SMCHPOI -INC SMELEME -INC SMRIGID -INC SMLREEL -INC SMLENTI -INC SMCOORD -INC SMTABLE * * IPORES contient les pointeurs sur les CHPOINTs qui * repr{senteront chaque variable pour chaque pas de sortie. * IPOREP contient les pointeurs sur les CHPOINTs * n{cessaires @ une reprise {ventuelle de calcul. * SEGMENT,MTRES REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) REAL*8 XMREP(NLIAB,4,IDIMB) INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) INTEGER ILPOLA(NLIAA,2) ENDSEGMENT SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT * Segment pour Champoints SEGMENT,MSAM integer jplibb(NPLB) ENDSEGMENT * LOGICAL L0,L1,lmodyn * MTRES = KTRES MPREF = KPREF MSAM =KSAM NPREF = IPOREF(/1) NRES = XRES(/1) NVES = ICHRES(/1) NCRES = XRES(/1) NPRES = XRES(/3) NREP = XREP(/1) NLSA = IPLRLA(/1) NLSB = IPLRLB(/1) NLIAB = XMREP(/1) NLIAA = ILPOLA(/1) NPLBB=JPLIBB(/1) NTVAR = ILIRNB(/2) * IF (ITBAS.NE.0.AND.ITKM.EQ.0) THEN IF(LMODYN) THEN meleme = ipmail segact meleme if (lisous(/1).eq.0) then ipmmod = ipmail ipmsta = 0 else ipmmod = lisous(1) ipmsta = lisous(2) endif * * production chpoint forces base A (devso2) * NSOUPO = 1 if(ipmmod.gt.0.and.ipmsta.gt.0) nsoupo = 2 NAT=1 SEGINI,MCHPOI IPCHPO = MCHPOI MTYPOI = 'FLIAISONS' IFOPOI = IFOUR * nature diffuse JATTRI(1) = 1 nmost0 = 0 KIPCHP = 0 if (ipmmod.gt.0) then NC = 1 SEGINI,MSOUPO KIPCHP = KIPCHP + 1 IPCHP(KIPCHP) = MSOUPO NOCOMP(1) = 'ALFA' NOHARM(1) = NIFOUR IGEOC = ipmmod ipt1 = ipmmod segact ipt1 N = ipt1.num(/2) nmost0 = N SEGINI,MPOVAL IPOVAL = MPOVAL endif if (ipmsta.gt.0) then NC = 1 SEGINI,MSOUPO KIPCHP = KIPCHP + 1 IPCHP(KIPCHP) = MSOUPO NOCOMP(1) = 'BETA' NOHARM(1) = NIFOUR IGEOC = ipmsta ipt1 = ipmsta segact ipt1 N = ipt1.num(/2) SEGINI,MPOVAL IPOVAL = MPOVAL endif ELSE * * Cas de la base modale, on n'a qu'une composante: 'ALFA' * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE17: cas de la base modale' ENDIF NSOUPO = 1 NAT=1 SEGINI,MCHPOI IPCHPO = MCHPOI MTYPOI = ' ' IFOPOI = IFOUR * nature diffuse JATTRI(1) = 1 NC = 1 SEGINI,MSOUPO IPCHP(1) = MSOUPO NOCOMP(1) = 'ALFA' NOHARM(1) = NIFOUR NOCOMP(1) = 'ALFA' NOHARM(1) = NIFOUR IGEOC = IPMAIL N = NPREF SEGINI,MPOVAL IPOVAL = MPOVAL ENDIF ELSE IF (ITKM.NE.0) THEN * * On se r{f}re au descripteur de la rigidit{, mais attention: * les composantes peuvent diff{rer d'une zone {l{mentaire @ * une autre. * CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0, & 'RIGIDITE',I1,X1,' ',L1,IRIGI) * * Cr{ation du CHPOINT de r{f{rence: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*) & 'DYNE17: cr{ation selon un descripteur de rigidit{' ENDIF MRIGID = IRIGI SEGACT,MRIGID NRIGI = IRIGEL(/2) IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*) & 'DYNE17: nombre de rigidit{s {l{mentaires ',NRIGI ENDIF NSOUPO = NRIGI NAT=1 SEGINI,MCHPOI IPCHPO = MCHPOI MTYPOI = ' ' * nature diffuse JATTRI(1) = 1 IFOPOI = IFOUR DO 30 I=1,NRIGI NYSONT = 0 DESCR = IRIGEL(3,I) IPT1 = IRIGEL(1,I) SEGACT,DESCR,IPT1 * * NTOTC est le nombre total d'inconnues * NBNO est le nombre de noeuds par {l{ment * NBELEM est le nombre d'{l{ments dans la zone * NC est le nombre de composantes par noeud dans la zone * NBNO = IPT1.NUM(/1) NBELEM = IPT1.NUM(/2) NTOTC = LISINC(/2) NC = NTOTC / NBNO IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE17: nombre total d''inconnues ',NTOTC WRITE(IOIMP,*)'DYNE17: nombre de noeuds par {l{ment ',NBNO WRITE(IOIMP,*)'DYNE17: nombre d''{l{ments dans la zone ',NBELEM WRITE(IOIMP,*)'DYNE17: nombre de composantes par noeud ',NC ENDIF SEGINI,MSOUPO IPCHP(I) = MSOUPO IGEOC = IPT1 DO 40 IC=1,NC NOCOMP(IC) = LISINC(IC) NOHARM(IC) = NIFOUR 40 CONTINUE * end do * * Combien de noeuds r{f{renc{s dans cette zone ? * DO 50 IEL=1,NBELEM DO 50 INO=1,NBNO CALL PLACE2(IPOREF,NPREF,ILYEST,IPT1.NUM(INO,IEL)) IF (ILYEST.NE.0) NYSONT = NYSONT + 1 50 CONTINUE * end do IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE17: nombre de noeuds dans la zone ',NYSONT ENDIF N = NYSONT SEGINI,MPOVAL IPOVAL = MPOVAL SEGDES,DESCR,IPT1 30 CONTINUE * end do SEGDES,MRIGID ENDIF * * Duplication du CHPOINT pour les variables demand{es, * @ tous les pas de sortie: * II = 0 DO 60 ICR=1,8 IF (ICHRES(ICR).EQ.1) THEN II = II + 1 DO 70 IPAS=1,NPRES CALL COPIE5(IPCHPO,IPCHP1) IPORES(II,IPAS) = IPCHP1 70 CONTINUE * end do ENDIF 60 CONTINUE * end do * * Cas des CHPOINTs n{cessaires @ la reprise du calcul: * DO 80 I = 1,NREP CALL COPIE5(IPCHPO,IPCHP1) IPOREP(I) = IPCHP1 80 CONTINUE * end do * * Cas des POINTS n{cessaires @ la reprise du calcul: * IDIM1 = IDIM + 1 NPTS = XCOOR(/1) / IDIM1 NBPTS = NPTS + 4 * NLIAB SEGADJ MCOORD DO 90 I = 1,NLIAB DO 90 II = 1,4 NPTS = NPTS + 1 IPPREP(I,II) = NPTS 90 CONTINUE * end do * MCHPOI = IPCHPO SEGSUP,MCHPOI * * Cr{ation des LISTREELs qui contiendront les r{sultats * JG = NPRES SEGINI,MLREEL IPOLR(1) = MLREEL * DO 100 IL = 1,NLSA NLR = ICHRES(10 + IL) DO 105 IN = 1,NLR JG = NPRES SEGINI,MLREEL IPLRLA(IL,IN) = MLREEL 105 CONTINUE * end do 100 CONTINUE * end do * DO 110 IL = 1,NLSB * NLR = ICHRES(10 + NLSA + IL) * DO 115 IN = 1,NLR * JG = NPRES * SEGINI,MLREEL * IPLRLB(IL,IN) = MLREEL * 115 CONTINUE * end do * 110 CONTINUE * end do * * Creation des LISTENTIs et des LISTREELs pour sauvegarde * des liaisons POLYNOMIALEs en base A en vue d'une reprise * DO 200 I = 1,NLIAA IF (ILPOLA(I,1).EQ.1) THEN JG = NPLAA * 2 SEGINI,MLENTI ILPOLA(I,1) = MLENTI JG = NXPALA SEGINI,MLREEL ILPOLA(I,2) = MLREEL ENDIF 200 CONTINUE * DO 300 IL=1,NLSB II=0 DO 310 IV = 1,NTVAR IF (ILIREB(IL,IV).EQ.1) THEN II=II+1 JG = NPRES SEGINI,MLREEL IPLRLB(IL,II) = MLREEL ELSE IF (ILIREB(IL,IV).EQ.2) THEN M=NPRES SEGINI,MTABLE MLOTAB=M DO 320 IM=1,NPRES MTABTI(IM)='ENTIER' MTABTV(IM)='CHPOINT' MTABII(IM)=IM 320 CONTINUE SEGDES,MTABLE IPLRLB(IL,II+1)=MTABLE * Création d un champoint NSOUPO=1 SEGINI,MCHPOI IPCHPO = MCHPOI MOCHDE = 'Force_de_choc' * nature diffuse NC=2 SEGINI,MSOUPO NOCOMP(1)='NORM' NOCOMP(2)='TANG' IPCHP(1)=MSOUPO N=NPLBB SEGINI,MPOVAL IPOVAL=MPOVAL NBELEM=NPLBB NBNN=1 NBREF=0 NBSOUS=0 SEGINI,MELEME DO 330 IE=1,NPLBB NUM(1,IE)=JPLIBB(IE) 330 CONTINUE IGEOC=MELEME JG=NPRES SEGINI,MLENTI DO 340 I = 1,NPRES CALL COPIE5(IPCHPO,IPCHP1) LECT(I) = IPCHP1 340 CONTINUE SEGDES,MLENTI IPLRLB(IL,II+2)=MLENTI MCHPOI=IPCHPO SEGSUP,MCHPOI * II=II+NPLBB*2 ENDIF ENDIF 310 CONTINUE 300 CONTINUE * end do * END