C DEVLIR SOURCE CHAT 11/03/16 21:19:12 6902 SUBROUTINE DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT, & NINS,ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Op{rateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Lecture et coh{rence des op{randes, v{rification des supports * * objets TBAS, TKM, TA et TINIT. * * Obtention de la liste des points de r{f{rence. * * * * Param}tres: * * * * s ITBAS Table repr{sentant une base modale * * s ITKM Table contenant les matrices de raideur et de masse * * s ITA Table contenant la matrice des amortissements * * s ITLIA Table rassemblant la description des liaisons * * s ITCHAR Table contenant les chargements * * s ITINIT Table donnant les conditions initiales * * s NP Nombre de pas de temps * * s PDT Valeur du pas de temps * * s NINS On veut un r{sultat tous les NINS pas de calcul * * s ITSORT Table d{finissant les r{sultats attendus * * s ITREDU Table contenant les noms d'inconnues de la base B * * auxquelles on se restreint * * s KPREF Segment des points de r{f{rence * * s KCPR Segment des points * * * * Auteur, date de cr{ation: * * * * Denis ROBERT-MOUGIN, le 25 mai 1989. * * * *--------------------------------------------------------------------* -INC CCOPTIO -INC SMMODEL segment mwinit integer jpdep,jpvit,jrepr endsegment segment mtbas integer itbmod,lsstru(np1),nsstru endsegment * PARAMETER ( ZERO=0.D0 , NTABLE=8 ) LOGICAL LMODYN, LOAMOR,L0,L1 CHARACTER*8 TYPOBJ CHARACTER*72 CHARRE,CHARRI * NINS = 1 MPSOR = 0 LMODYN = .false. ITDYN = 0 * IMESS = 0 ITBAS = 0 ITKM = 0 ITA = 0 ITLIA = 0 ITCHAR = 0 ITINIT = 0 ITSORT = 0 ITREDU = 0 ITINV = 0 ITIND = 0 CALL LIRTAB('PASAPAS',ITDYN,0,IRET) if (iret.ne.0) lmodyn = .true. * * A/ Lecture des op{randes, les tables puis les autres: * if (lmodyn) then CALL ACCTAB(ITDYN,'MOT',IM,X0,'MODELE',L0,IP0, & 'MMODEL',I1,X1,CHARRE,L1,ITMOD) IF (IERR.NE.0) RETURN CALL ACCTAB(ITDYN,'MOT',IM,X0,'CARACTERISTIQUES',L0,IP0, & 'MCHAML',I1,X1,CHARRE,L1,ITCARA) IF (IERR.NE.0) RETURN call ecrcha('MECANIQUE') call ecrcha('FORM') call ecrobj('MMODEL',ITMOD) call extrai call lirobj('MMODEL',ITMO1,0,iret) mmodel = itmod segact mmodel np1 = kmodel(/1) segini mtbas itbas = mtbas itbmod = itmo1 else CALL MESLIR(-261) CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET) IF (IRET.EQ.0) THEN CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,0,IRET) ENDIF IF (IERR.NE.0) RETURN IF (ITBAS.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*)' on a lu la table d{finissant la base modale.' ENDIF endif * if (lmodyn) then else CALL MESLIR(-262) CALL LIRTAB('RAIDEUR_ET_MASSE',ITKM,0,IRET) IF (IERR.NE.0) RETURN IF (ITKM.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*) & ' on a lu la table d{finissant les matrices de raideurs.' ENDIF endif * if (lmodyn) then call ecrobj('MCHAML',itcara) call ecrobj('MMODEL',itbmod) call redu call lirobj('MCHAML',ipche1,1,iret) call ecrcha('AMOR') call ecrobj('MCHAML',ipche1) call exis call lirlog(loamor,1,iret) if (loamor) then call ecrobj('MCHAML',itcara) call ecrobj('MMODEL',itmod) call amor call lirobj('RIGIDITE',ITA,1,iret) IF (IERR.NE.0) RETURN endif else CALL MESLIR(-263) CALL LIRTAB('AMORTISSEMENT',ITA,0,IRET) IF (IERR.NE.0) RETURN IF (ITA.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*) & ' on a lu la table d{finissant une matrice d''amortissement.' ENDIF endif * if (lmodyn) then call ecrcha('LIAISON') call ecrcha('FORM') call ecrobj('MMODEL',ITMOD) call exis call lirobj('LOGIQUE',itlog,0,iret) if (itlog.eq.1) then call ecrcha('LIAISON') call ecrcha('FORM') call ecrobj('MMODEL',ITMOD) call extrai call lirobj('MMODEL',itlia,0,iret) endif if (ierr.ne.0) return else CALL MESLIR(-264) CALL LIRTAB('LIAISON',ITLIA,0,IRET) IF (IERR.NE.0) RETURN IF (ITLIA.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*)' on a lu la table d{finissant les liaisons.' ENDIF endif * if (lmodyn) then typobj = ' ' irep = 0 ITCHAR = 0 CALL ACCTAB(ITDYN,'MOT',IM,X0,'CHARGEMENT',L0,IP0, & typobj,I1,X1,CHARRE,L1,irep) if (typobj.eq.'CHARGEME') ITCHAR = irep else CALL MESLIR(-265) CALL LIRTAB('CHARGEMENT',ITCHAR,0,IRET) IF (IERR.NE.0) RETURN IF (ITCHAR.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*)' on a lu la table d{finissant les chargements.' ENDIF endif * if (lmodyn) then typobj = ' ' irep = 0 CALL ACCTAB(ITDYN,'MOT',IM,X0,'INIT_DYNE',L0,IP0, & typobj,I1,X1,CHARRE,L1,IREP) if (typobj.eq.'TABLE') then segini mwinit itinit = mwinit jrepr = irep else itinv = 0 itind = 0 typobj = ' ' CALL ACCTAB(ITDYN,'MOT',IM,X0,'DEPLACEMENTS',L0,IP0, & typobj,I1,X1,CHARRE,L1,ITAD) if (typobj.eq.'TABLE') then CALL ACCTAB(ITAD,'ENTIER',0,X0,' ',L0,IP0, & 'CHPOINT',I1,X1,CHARRE,L1,ITIND) endif typobj = ' ' CALL ACCTAB(ITDYN,'MOT',IM,X0,'VITESSES',L0,IP0, & typobj,I1,X1,CHARRE,L1,ITAV) if (typobj.eq.'TABLE') then CALL ACCTAB(ITAV,'ENTIER',0,X0,' ',L0,IP0, & 'CHPOINT',I1,X1,CHARRE,L1,ITINV) endif if(itinv.gt.0.or.itind.gt.0) then segini mwinit jpdep = itind jpvit = itinv itinit = mwinit endif endif else CALL MESLIR(-266) CALL LIRTAB('INITIAL',ITINIT,0,IRET) IF (IERR.NE.0) RETURN IF (ITINIT.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*) &' on a lu la table d{finissant les conditions initiales.' ENDIF endif if (lmodyn) then * le traitement des reprises semble �tre fait dans devalo else CALL LIRTAB('REPRISE',IREP,0,IRET) IF (IERR.NE.0) RETURN IF (IREP.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*) &' on a lu la table d{finissant la reprise' ENDIF endif * if (lmodyn) then ITSORT = 0 typobj = ' ' CALL ACCTAB(ITDYN,'MOT',IM,X0,'SORTIE',L0,IP0, & typobj,I1,X1,CHARRE,L1,ITSOR1) if (typobj.eq.'TABLE') then ITSORT = ITSOR1 endif else CALL MESLIR(-267) CALL LIRTAB('SORTIE',ITSORT,0,IRET) IF (IERR.NE.0) RETURN IF (ITSORT.NE.0 .AND. IIMPI.EQ.333) THEN WRITE(IOIMP,*)' on a lu la table d{finissant les sorties.' ENDIF endif * if (lmodyn) then else CALL MESLIR(-268) CALL LIRTAB('RESTRICTION',ITREDU,0,IRET) IF (IERR.NE.0) RETURN endif * if (lmodyn) then CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_TEMPS',L0,IP0, & 'FLOTTANT',I1,pdt,CHARRE,L1,IP1) CALL ACCTAB(ITDYN,'MOT',IM,X0,'NOMBRE_PAS',L0,IP0, & 'ENTIER',np,X1,CHARRE,L1,IP1) typobj = ' ' nins = 1 CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_SORTIE',L0,IP0, & typobj,I1,X1,CHARRE,L1,IP1) if (typobj.eq.'ENTIER') nins = I1 else CALL MESLIR(-269) CALL LIRENT(NP,1,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-270) CALL LIRREE(PDT,1,IRET) IF (IERR.NE.0) RETURN * CALL MESLIR(-271) CALL LIRENT(NINS,0,IRET) IF (IERR.NE.0) RETURN endif * * B/ Coh{rence des op{randes * IF (ITBAS.EQ.0 .AND. ITKM.EQ.0) THEN CALL ERREUR(478) RETURN ENDIF IF (ITCHAR.EQ.0 .AND. ITINIT.EQ.0 .AND. IREP.EQ.0) THEN CALL ERREUR(479) RETURN ENDIF IF (NP.LE.0) THEN CALL ERREUR(480) RETURN ENDIF IF (PDT.LE.ZERO) THEN CALL ERREUR(481) RETURN ENDIF * * C/ V{rification des supports des objets TBAS, TKM, TA et TINIT * et obtention de la liste des points de r{f{rence * if (lmodyn) then it1 = itbmod else it1 = itbas endif CALL DYNE13(IT1,ITKM,KPREF,KCPR,LMODYN) IF (IERR.NE.0) RETURN * END