C DYNE13 SOURCE CB215821 24/04/12 21:15:38 11897 SUBROUTINE DYNE13(ITBAS,ITKM,KPREF,KCPR,LMODYN) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Op{rateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * V{rification des objets TBAS, TKM, et notamment de * * leurs supports. Liste des points de r{f{rence. * * * * Param}tres: * * * * e ITBAS Table repr{sentant une base modale * * e ITKM Table contenant les matrices de raideur et de masse * * s KPREF Segment des points de r{f{rence * * s KCPR Segment des points * * * * Auteur, date de cr{ation: * * * * Denis ROBERT-MOUGIN, le 30 mai 1989. * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMRIGID -INC SMCHPOI -INC SMELEME -INC SMCOORD -INC SMMODEL * SEGMENT,ICPR(nbpts) SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT * LOGICAL L0,L1,LMODYN CHARACTER*4 MO2 CHARACTER*8 TYPRET,CHARRE CHARACTER*40 MONMOT * IK = 0 IRIG = 0 IMAS = 0 IMESS = 0 SEGINI,ICPR KCPR = ICPR LCPR = nbpts * * 1/ Cas oº la base modale est d{finie seule * IF (ITBAS.NE.0 .AND.ITKM.EQ.0.and.(.not.lmodyn)) THEN CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0, & 'MOT',I1,X1,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN * * Cas oº la base est unique * IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN * * On r{cup}re la base de modes * CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBAS) IF (IERR.NE.0) RETURN CALL DYNE25(IBAS,KCPR,IK) IF (IERR.NE.0) RETURN * * Cas oº on a un ensemble de bases * ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN * * On boucle sur le nombre de bases * IB = 0 10 CONTINUE IB = IB + 1 TYPRET = ' ' CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITTBAS) IF (IERR.NE.0) RETURN IF (ITTBAS.NE.0) THEN IF (TYPRET.EQ.'TABLE ') THEN CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBAS) IF (IERR.NE.0) RETURN CALL DYNE25(IBAS,KCPR,IK) IF (IERR.NE.0) RETURN GOTO 10 ELSE CALL ERREUR(491) RETURN ENDIF ENDIF * * Cas oº le SOUSTYPE est incorrect * ELSE CALL ERREUR(482) RETURN ENDIF * * 2/ Cas oº les matrices raideur et de masse sont d{finies seules * ELSE IF (ITBAS.EQ.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN TYPRET = ' ' CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IRIG) IF (IERR.NE.0) RETURN IF (IRIG.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN MRIGID = IRIG SEGACT,MRIGID NRIG = IRIGEL(/2) DO 20 I=1,NRIG MELEME = IRIGEL(1,I) SEGACT,MELEME NBEL = NUM(/2) NBNN = NUM(/1) DO 25 J=1,NBEL DO 26 K=1,NBNN KNOE = NUM(K,J) IF (ICPR(KNOE).EQ.0) THEN IK = IK + 1 ICPR(KNOE) = IK IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE13 : raideur ICPR(',KNOE,')=',ICPR(KNOE) ENDIF ENDIF 26 CONTINUE * end do 25 CONTINUE * end do SEGDES,MELEME 20 CONTINUE * end do SEGDES,MRIGID * * Cas oº le SOUSTYPE est incorrect * ELSE CALL ERREUR(483) RETURN ENDIF * TYPRET = ' ' CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IMAS) IF (IERR.NE.0) RETURN IF (IMAS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN MRIGID = IMAS SEGACT,MRIGID NMAS = IRIGEL(/2) DO 30 I=1,NMAS MELEME = IRIGEL(1,I) SEGACT,MELEME NBEL = NUM(/2) NBNN = NUM(/1) DO 35 J=1,NBEL DO 36 K=1,NBNN KNOE = NUM(K,J) IF (ICPR(KNOE).EQ.0) THEN IK = IK + 1 ICPR(KNOE) = IK IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE13 : masse ICPR(',KNOE,')=',ICPR(KNOE) ENDIF ENDIF 36 CONTINUE * end do 35 CONTINUE * end do SEGDES,MELEME 30 CONTINUE * end do SEGDES,MRIGID * * Cas oº le SOUSTYPE est incorrect * ELSE CALL ERREUR(484) RETURN ENDIF * * 3/ Cas oº la base modale est d{finie * et les matrices masse et rigidit{ sont d{finies * ELSE IF (ITBAS.NE.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN CALL ERREUR(478) RETURN * * table pasapas ELSE IF (LMODYN) THEN mmodel = itbas segact mmodel do im = 1,kmodel(/1) imodel = kmodel(im) segact imodel if (nefmod.ne.45) goto 45 meleme = imamod segact meleme do ip = 1,num(/2) knoe = num(1,ip) IF (KNOE.NE.0) THEN IF (ICPR(KNOE).EQ.0) THEN IK = IK + 1 ICPR(KNOE) = IK IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE25 : basemo. ICPR(',KNOE,')=',ICPR(KNOE) ENDIF ENDIF ENDIF enddo segdes meleme 45 continue segdes imodel enddo segdes mmodel ENDIF * * 5/ Cr{ation du segment d{finissant les points supports: * NPREF = IK SEGINI,MPREF KPREF = MPREF IF (IIMPI.EQ.333) WRITE(IOIMP,*)'DYNE13 : KPREF=',KPREF,NPREF DO 100 I=1,LCPR IF (ICPR(I).NE.0) THEN IREF = ICPR(I) IPOREF(IREF) = I IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNE13 : IPOREF(',IREF,')=',IPOREF(IREF) ENDIF ENDIF 100 CONTINUE * end do * END