C DYNE17 SOURCE CB215821 26/08/24 21:16:19 12622 SUBROUTINE DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA, &KSAM,lmodyn) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Creation des CHPOINTs qui contiendront les resultats. * * Creation des LISTREELs qui contiendront les resultats. * * Creation des POINTS qui contiendront les variables de liaison * * necessaires a une reprise. * * * * Parametres: * * * * e ITBAS Table representant une base modale * * e ITKM Table contenant les matrices XK et XM * * e IPMAIL Maillage de reference * * es KTRES Segment de sauvegarde des resultats * * e KPREF Segment des points de reference * * 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 crees vont pointer * * sur le meme MELEME afin de limiter au maximum la memoire * * utilisee. * * * * Auteur, date de creation: * * * * Denis ROBERT-MOUGIN, le 30 juin 1989. * * * *--------------------------------------------------------------------* -INC PPARAM -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 * representeront chaque variable pour chaque pas de sortie. * IPOREP contient les pointeurs sur les CHPOINTs * necessaires a une reprise eventuelle 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(NRESPO,NPRES),IPOREP(NREP) INTEGER ILIRES(NRESLI,NCRES) 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 c segment local pour verifier que les matrices sont deja assemblees et c pas 2 fois la meme inconnue (composante + noeud) dans 2 sous-matrices SEGMENT MVU c CHARACTER*4 COMPVU(NCVU) c INTEGER IDEJVU(NIVU,NCVU) INTEGER IDEJVU(NIVU) ENDSEGMENT * LOGICAL L0,L1,lmodyn * MTRES = KTRES MPREF = KPREF MSAM = KSAM NPREF = IPOREF(/1) NVES = ICHRES(/1) NRES = XRES(/1) NCRES = XRES(/2) NPRES = XRES(/3) NREP = XREP(/1) NLSA = IPLRLA(/1) NLSB = IPLRLB(/1) NLIAB = XMREP(/1) NLIAA = ILPOLA(/1) NPLBB = JPLIBB(/1) NTVAR = ILIRNB(/2) * *=========== CAS D'UNE BASE MODALE =========== * IF (ITBAS.NE.0.AND.ITKM.EQ.0) THEN * --- syntaxe table PASAPAS --- IF(LMODYN) THEN * maillage 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 * --- syntaxe tables DYNE normales --- 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 * *=========== CAS DE MATRICES MODALES EN ENTREE =========== * ELSE IF (ITKM.NE.0) THEN * * On se refere au descripteur de la rigidite, mais attention: * les composantes peuvent differer d'une zone elementaire a * une autre. * CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0, & 'RIGIDITE',I1,X1,' ',L1,IRIGI) * * Creation du CHPOINT de reference: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*) & 'DYNE17: creation selon un descripteur de rigidite' ENDIF MRIGID = IRIGI SEGACT,MRIGID NRIGI = IRIGEL(/2) IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*) & 'DYNE17: nombre de rigidites elementaires ',NRIGI ENDIF NSOUPO = NRIGI NAT=1 SEGINI,MCHPOI IPCHPO = MCHPOI MTYPOI = ' ' * nature diffuse JATTRI(1) = 1 IFOPOI = IFOUR c creation du segment de verif NIVU = NPREF SEGINI,MVU 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 element * NBEL est le nombre d'elements dans la zone * NC est le nombre de composantes par noeud dans la zone NBNO = IPT1.NUM(/1) NBEL = 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 element ',NBNO WRITE(IOIMP,*)'DYNE17: nombre d''elements dans la zone ',NBEL WRITE(IOIMP,*)'DYNE17: nombre de composantes par noeud ',NC ENDIF SEGINI,MSOUPO IPCHP(I) = MSOUPO DO 40 IC=1,NC IF (LISINC(IC).NE.'ALFA'.and.LISINC(IC).NE.'BETA') THEN WRITE(IOIMP,*) 'DYNE: la raideur K de la table RAIDEUR_ET_MASSE', & ' ne peut avoir que ALFA ou BETA pour composante!' CALL ERREUR(483) RETURN ENDIF NOCOMP(IC) = LISINC(IC) NOHARM(IC) = NIFOUR 40 CONTINUE * * Combien de noeuds references dans cette zone ? * c BP : le chpoint repose necessairement sur des elements POI1 NBSOUS=0 NBREF =0 NBNN =1 NBELEM=NBNO*NBEL SEGINI,MELEME ITYPEL=1 IGEOC = MELEME DO 341 IEL=1,NBEL DO 50 INO=1,NBNO c ce noeud appartient-il bien a la liste MPREF.IPOREF ? CALL PLACE2(IPOREF,NPREF,ILYEST,IPT1.NUM(INO,IEL)) IF (ILYEST.EQ.0) GOTO 50 c rem : si ILYEST = 0 , on a un pb --> erreur dans devtra c BP : ce noeud a t'il deja ete vu dans une autre zone? IF(IDEJVU(ILYEST).EQ.0) THEN c tout va bien on ajoute ce noeud pour ces composantes NYSONT = NYSONT + 1 NUM(1,NYSONT) = IPT1.NUM(INO,IEL) IDEJVU(ILYEST)=NYSONT ELSE c noeud deja vu a l element NYSONT : on ne fait rien c on suppose qu'1 noeud => 1 inconnue ENDIF 50 CONTINUE 341 CONTINUE IF(NYSONT.lt.NBELEM) THEN NBELEM=NYSONT SEGADJ,MELEME ENDIF 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,MELEME,MSOUPO 30 CONTINUE SEGDES,MRIGID SEGSUP,MVU ENDIF *=========== FIN DES CAS BASE MODALE / MATRICES MODALES =========== * * Variables demandees en sortie: c II = 0 IIPO = 0 c IILI = 0 c boucle sur les variables (deplacement, vitesse ... ) DO 60 ICR=1,8 * - Duplication du CHPOINT pour les variables demandees * a tous les pas de sortie IF (ICHRES(ICR).EQ.1) THEN c II = II + 1 IIPO=IIPO+1 DO 70 IPAS=1,NPRES CALL COPIE5(IPCHPO,IPCHP1) IPORES(IIPO,IPAS) = IPCHP1 70 CONTINUE * - creation des LISTREEL pour les variables demandees * et tous les modes ELSEIF(ICHRES(ICR).EQ.2) THEN c II = II + 1 c IILI=IILI+1 c if (NCRES.gt.IPORES(/2)) then c write(ioimp,*) 'il faut plus de pas que de modes !' c call erreur(481) c return c endif c DO 71 IMODE=1,NCRES c JG=NPRES c segini,MLREEL c ILIRES(IILI,IMODE) = MLREEL c c rem : on range le MLREEL ici en supposant qu'il y a plus c c de pas que de modes cbp : on ne fait quasi-rien ici, on travaillera dans devso2 71 CONTINUE ENDIF 60 CONTINUE * * Cas des CHPOINTs necessaires a la reprise du calcul: * DO 80 I = 1,NREP CALL COPIE5(IPCHPO,IPCHP1) IPOREP(I) = IPCHP1 80 CONTINUE * * Cas des POINTS necessaires a la reprise du calcul: * IDIM1 = IDIM + 1 segact mcoord*mod NPTS = nbpts NBPTS = NPTS + 4 * NLIAB SEGADJ MCOORD DO 342 I = 1,NLIAB DO 90 II = 1,4 NPTS = NPTS + 1 IPPREP(I,II) = NPTS 90 CONTINUE 342 CONTINUE * MCHPOI = IPCHPO SEGSUP,MCHPOI * * Creation des LISTREELs qui contiendront les resultats * JG = NPRES SEGINI,MLREEL IPOLR(1) = MLREEL * * liaisons en base A DO 100 IL = 1,NLSA NLR = ICHRES(10 + IL) DO 105 IN = 1,NLR JG = NPRES SEGINI,MLREEL IPLRLA(IL,IN) = MLREEL 105 CONTINUE 100 CONTINUE * 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 en base A en vue d'une reprise * DO 200 I = 1,NLIAA * liaisons POLYNOMIALEs IF (ILPOLA(I,1).EQ.1) THEN JG = NPLAA * 2 SEGINI,MLENTI ILPOLA(I,1) = MLENTI JG = NXPALA SEGINI,MLREEL ILPOLA(I,2) = MLREEL * liaisons COUPLAGE_DEPLACEMENT + CONVOLUTION ELSEIF(ILPOLA(I,1).EQ.2) THEN * on ne fait rien ici : * on branchera les listreels creees par dyne19 dans devso4 ENDIF 200 CONTINUE * * liaisons en base B DO 300 IL=1,NLSB II=0 DO 310 IV = 1,NTVAR * -Creation de listreels IF (ILIREB(IL,IV).EQ.1) THEN II=II+1 JG = NPRES SEGINI,MLREEL IPLRLB(IL,II) = MLREEL * -Creation d'une table de chpoints ELSEIF (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 * Creation 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 310 CONTINUE 300 CONTINUE * END