Sources Esope | Cast3M

massmo
C MASSMO    SOURCE    PV        07/11/23    21:17:48     5978
      SUBROUTINE MASSMO
C=======================================================================
C      APPELE PAR MASSE POUR L'ANALYSE MODALE
C
C      SYNTAXES POSSIBLES :  MAS2 = MASSE M ;
C                            MAS3 = MASSE P S ;
C                            MAS4 = MASSE M P S ;
C                            MAS5 = MASSE B ;
C     M : OBJET SOLUTION DE SOUS TYPE MODE
C     P : OBJET SOLUTION DE SOUS TYPE SOLU STAT
C     S : OBJET STRUCTURE
C     B : OBJET BASE MODALE
C  MAS2 : MASSE DUE AUX MODES SEULS ( MN )
C  MAS3 : MASSE DUE AU COUPLAGE DES SOLUTIONS STATIQUES SUR UNE STRUCTUR
C  MAS4 : MASSE DUE AU COUPLAGE DES SOLUTIONS STATIQUES ET DES MODES
C  MAS5 : CALCUL AUTOMATIQUE DE MAS2, MAS3 ET MAS4.
C
C      PROGRAMMEUR FARVACQUE
C      VERSION      JUIN 84
C
C      L. VIVAN, le 22/03/91 : ajout de l'option TABLE
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      logical l0,l1
      character*4 charre
 
-INC PPARAM
-INC CCOPTIO
-INC SMBASEM
-INC SMSOLUT
-INC SMSTRUC
*
*     La base modale est donn{e sous forme d'une TABLE
*
      CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
      IF (IRETOU.NE.0) THEN
       CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
     &                    'TABLE',I1,X1,CHARRE,L1,ITMOD)
       itbas = itmod
      ENDIF
      CALL LIRTAB('LIAISONS_STATIQUES',ITBST,0,IRETO1)
      if (ireto1.ne.0) then
         call lirobj('RIGIDITE',ir1,1,iretou)
         if (ierr.ne.0) return
*         call utmu(ir1,itbst)
         call prmu(ir1,itbst)
         if (ierr.ne.0) return
      endif
      IF (IRETOU.NE.0.or.ireto1.ne.0) THEN
         CALL RIGTAB(ITBAS,itbst,1,KRIGI)
         IF(KRIGI.EQ.0) GOTO 666
         GOTO 800
      ENDIF
*
*     La base modale est donn{e sous forme d'un objet SOLUTION, ...
*
      IMODE=0
      ISOLS=0
  706 CALL LIROBJ ('SOLUTION',IPOI1,0,IRT1)
      IF(IRT1.EQ.0) GO TO 701
      MSOLUT=IPOI1
      SEGACT MSOLUT
C
C  **** EST CE UN MODE ?
C
      IF(ITYSOL.NE.'MODE    ') GO TO 703
      IF(IMODE.EQ.0) GO TO 704
      MOTERR(1:8)='SOLUTION'
      MOTERR(9:16)='MODE'
      CALL ERREUR(130)
      SEGDES MSOLUT
      GO TO 666
  704 CONTINUE
      IMODE=MSOLUT
      SEGDES MSOLUT
      IF(ISOLS.EQ.0) GO TO 706
      GO TO 701
C
C  **** EST CE UN SOLSTA ?
C
  703 CONTINUE
      IF(ITYSOL.NE.'SOLUSTAT') GO TO 708
      IF(ISOLS.EQ.0) GO TO 710
      MOTERR(1:8)='SOLUTION'
      MOTERR(9:16)='SOLUSTAT'
      CALL ERREUR(130)
      SEGDES MSOLUT
      GO TO 666
  710 CONTINUE
      ISOLS=MSOLUT
      SEGDES MSOLUT
      IF(IMODE.EQ.0) GO TO 706
      GO TO 701
  708 CONTINUE
      MOTERR(1:8)='SOLUTION'
      MOTERR(9:16)=ITYSOL
      CALL ERREUR(131)
      SEGDES MSOLUT
      GO TO 666
C
  701 CONTINUE
      IF(ISOLS.EQ.0. AND .IMODE.EQ.0) GO TO 723
      IF(ISOLS.EQ.0) GO TO 720
      CALL LIROBJ('STRUCTUR',IPOI2,1,IRT2)
      IF(IERR.NE.0) GO TO 666
      MSTRUC=IPOI2
      SEGACT MSTRUC
      IF(LISTRU(/1).EQ.1) GO TO 721
      MOTERR(1:8)='STRUCTUR'
      CALL ERREUR(132)
      SEGDES MSTRUC
      GO TO 666
  721 ISTRU=LISTRU(1)
      SEGDES MSTRUC
      IF(IMODE.EQ.0) GO TO 725
      CALL RGLIMO(IMODE,ISOLS,ISTRU,1,KRIGI)
      IF(KRIGI.EQ.0) GO TO 666
      GO TO 800
C
  725 CONTINUE
      CALL RGLILI(ISOLS,ISTRU,1,KRIGI)
      IF(KRIGI.EQ.0) GO TO 666
      GO TO 800
C
  720 CONTINUE
      CALL RIGMOD(IMODE,1,KRIGI)
      IF(KRIGI.EQ.0) GO TO 666
      GO TO 800
C
  723 CONTINUE
      CALL LIROBJ('BASEMODA',IPOI2,1,IRT2)
      IF(IERR.NE.0) GO TO 666
      CALL RGBASE(IPOI2,1,KRIGI)
      IF(KRIGI.EQ.0) GO TO 666
C
  800 CONTINUE
      CALL ECROBJ('RIGIDITE',KRIGI)
  666 CONTINUE
      RETURN
      END