Sources Esope | Cast3M

cctbas
C CCTBAS    SOURCE    CB215821  20/11/25    13:19:08     10792          
      SUBROUTINE CCTBAS(IPSOLU,IPMASS)
C***********************************************************************
C
C                             C C T B A S
C                             -----------
C
C     SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "VIBRATION"
C
C FONCTION:
C ---------
C
C     CREATION D'UNE TABLE DE TYPE BASE_MODALE COMME SORTIE
C     DE L'OPERATEUR "VIBRATION" POUR UN PROBLEME NON SYMETRIQUE
C
C ARGUMENTS D'ENTREE:
C ------------------
C
C     IPSOLU = POINTEUR SUR L'OBJET SOLUTION
C     IPMASS = POINTEUR SUR LA MATRICE MASSE
C
C DESCRIPTION DE LA TABLE BASE_MODALE CREE:
C ----------------------------------------
C
C     TAB1 = 'TABLE' 'BASE_MODALE'               ( POINTEUR IPTAB1 )
C     TAB2 = 'TABLE' 'BASE_DE_MODES'             ( POINTEUR IPTAB2 )
C            DE MEME STRUCTURE QUE CELLE ISSUE DE LA PROCEDURE
C            TRADUIRE.
C     TAB3 = 'TABLE' 'MODE'                      ( POINTEUR IPTAB3 )
C     TAB4 = 'TABLE' 'DEPLACEMENTS_GENERALISES'  ( POINTEUR IPTAB4 )
C     TAB5 = 'TABLE' 'DEPLACEMENTS_GENERALISES_IMAGINAIRES'
C                                                ( POINTEUR IPTAB5 )
C
C ----------------------------------------
C
C     TAB1.'SOUSTYPE'                 = 'BASE_MODALE'
C     TAB1.'MODES'                    = IPTAB2
C
C     TAB2.'SOUSTYPE'                 = 'BASE_DE_MODES'
C     TAB2.'MAILLAGE'                 = IPG1 ( POINTEUR SUR LE
C                                       MAILLAGE EXTRAIT DE LA MATRICE
C                                       MASSE )
C
C PUIS POUR CHAQUE MODE IMOD1 CONTENU DANS L'OBJET SOLUTION
C
C     TAB3.'SOUSTYPE'            = 'MODE'
C     TAB4.'SOUSTYPE'            = 'DEPLACEMENTS_GENERALISES'
C
C     TAB4.1                     = QX DU MODE
C     TAB4.2                     = QY DU MODE
C     TAB4.3                     = QZ DU MODE
C
C     TAB5.'SOUSTYPE'            ='DEPLACEMENTS_GENERALISES_IMAGINAIRES'
C
C     TAB5.1                     = QX DU MODE
C     TAB5.2                     = QY DU MODE
C     TAB5.3                     = QZ DU MODE
C
C
C     TAB3.'NUMERO_MODE'                  = NUME1 (NUMERO DU MODE)
C     TAB3.'POINT_REPERE'                 = IPOIN1 (NUM DUPOINT ASSOCIE)
C                                       AU MODE )
C     TAB3.'FREQUENCE'                    = FREQ1 (REELLE)  DU MODE
C     TAB3.'MASSE_GENERALISEE'            = XMGEN1 (REELLE) DU MODE
C     TAB3.'DEPLACEMENTS_GENERALISES'     = IPTAB4
C     TAB3.'DEFORMEE_MODALE'              = IPDEP1 (POINTEUR
C                           SUR LE CHAMPDE DEPLACEMENTS REEL DU MODE)
C     TAB3.'FREQUENCE_IMAGINAIRE'         = FREQ1 (IMAGINAIRE) DU MODE
C     TAB3.'MASSE_GENERALISEE_IMAGINAIRE  = XMGEN1 (IMAGINAIRE) DU MODE
C     TAB3.'DEPLACEMENTS_GENERALISES_IMAGINAIRES'
C                                         = IPTAB4
C     TAB3.'DEFORMEE_MODALE'              = IPDEP1 (POINTEUR
C                       SUR LECHAMP DE DEPLACEMENTS IMAGINAIRE DU MODE)
C
C     TAB2.IMOD1                      = IPTAB3
C
C
C AUTEUR, DATE DE CREATION:
C -------------------------
C
C     PASCAL BOUDA        10 JUILLET 2015
C
C***********************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMSOLUT
-INC SMRIGID
-INC SMTABLE
-INC SMELEME
-INC SMLREEL
-INC SMLENTI
-INC SMCHPOI
 
      CHARACTER*8 letyp,charre
      LOGICAL boolin,ltelq
      CHARACTER *72 ITEX
C
C---  RECUPERATION DU MAILLAGE DANS LA MATRICE MASSE
C
      MRIGID=IPMASS
      SEGACT MRIGID
      NBSOUS=IRIGEL(/2)
      IPG1=IRIGEL(1,1)
C
      IF (NBSOUS.GT.1) THEN
        DO 10 I=2,NBSOUS
        IPP2=IRIGEL(1,I)
        ltelq=.false.
        CALL FUSE(IPG1,IPP2,IRET,ltelq)
        IPG1=IRET
  10    CONTINUE
      ENDIF
      SEGDES MRIGID
 
C---  CREATION DE LA TABLE BASE_DE_MODES
C
      CALL CRTABL(IPTAB2)
      CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     #                   'MOT',0,0.D0,'BASE_DE_MODES',.TRUE.,0)
      CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'MAILLAGE',.TRUE.,0,
     #            'MAILLAGE',0,0.D0,' ',.TRUE.,IPG1)
C
C---  EXTRACTION DES INFORMATIONS DE L'OBJET SOLUTION
 
      MSOLUT=IPSOLU
      SEGACT MSOLUT
 
      MSOLE1=MSOLIS(4)
* msolis(4) contient la liste des modes calcules
      if (msole1.ne.0) then
      SEGACT MSOLE1
* Chaque mode a une partie reelle et une partie imaginaire (nulle ou
*non) nombre de mode est donc egal a la moitie de la dimension du
* du tableau de stockage
      NBMOD1=MSOLE1.ISOLEN(/1)/2
      MSOLE2=MSOLIS(5)
      SEGACT MSOLE2
 
 
 
 
 
      DO 20 I=1,NBMOD1
************************************************************
*Les indices impairs correspondent aux parties reelles
      IMOD1=2*I-1
*Boucle sur les parties reelles
************************************************************
C---  CREATION DE LA TABLE MODE
C
      CALL CRTABL(IPTAB3)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     #                   'MOT',0,0.D0,'MODE',.TRUE.,0)
C
C---  CREATION DE LA TABLE DEPLACEMENTS_GENERALISES
C
      CALL CRTABL(IPTAB4)
      CALL ECCTAB(IPTAB4,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     # 'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_REELS',.TRUE.,0)
C
C---  CREATION DE LA TABLE DEPLACEMENTS_GENERALISES_IMAGINAIRES
      CALL CRTABL(IPTAB5)
      CALL ECCTAB(IPTAB5,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     # 'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_IMAGINAIRES',.TRUE.,0)
 
      MMODE=MSOLE1.ISOLEN(IMOD1)
      CALL TITMOD(MMODE,ITEX)
      SEGACT MMODE*MOD
*Recuperation de toutes les informations sur le mode
*       -numero
*       -frequence reelle
*       -deformee reelle
*       -deplacements generalises
*       -masse generalisee reelle
 
      NUME1=IMMODD(1)
      FRQ1=FMMODD(1)
      XMGEN1=FMMODD(2)
      QX1=FMMODD(3)
      QY1=FMMODD(4)
      QZ1=FMMODD(5)
      MELEME=MSOLIS(3)
      SEGACT MELEME
      IPOIN1=NUM(1,IMOD1)
      SEGDES MELEME
C
      IPDEP=MSOLE2.ISOLEN(IMOD1)
c     ajout du titre au chpoint
      MCHPOI=IPDEP
      SEGACT MCHPOI*MOD
 
      MOCHDE=ITEX
      IPDEP=MCHPOI
      SEGDES MCHPOI
 
 
      SEGDES MMODE
 
C---  REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES
C
      CALL ECCTAB(IPTAB4,'ENTIER',1,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QX1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB4,'ENTIER',2,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QY1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB4,'ENTIER',3,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QZ1,' ',.TRUE.,0)
C
C---  REMPLISSAGE DE LA TABLE MODE
C
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'NUMERO_MODE',.TRUE.,0,
     #                   'ENTIER',NUME1,0.D0,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
     #                   'POINT',0,0.D0,' ',.TRUE.,IPOIN1)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE_REELLE',.TRUE.,0,
     #                   'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE_REELLE',
     #     .TRUE.,0,'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_REELS',
     #            .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB4)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE_REELLE',.TRUE.,0,
     #                   'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP)
C
c C---  SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
c C
c       CALL ECCTAB(IPTAB2,'ENTIER',IMOD1,0.D0,' ',.TRUE.,0,
c      #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
 
 
 
 
************************************************************
*Les indices pairs correspondent aux parties imaginaires
      IMOD1=2*I
*Boucle sur les parties imaginaires
************************************************************
 
 
      MMODE=MSOLE1.ISOLEN(IMOD1)
*formation du titre de la deformee modale
      CALL TITMOD(MMODE,ITEX)
      SEGACT MMODE
 
*Recuperation de toutes les informations sur la partie imaginaire
*associe au mode reel recupere au-dessus
*       -frequence imaginaire
*       -deformee imaginaire
*       -deplacements generalises imaginaires
*       -masse generalisee imaginaire
 
      NUME1=IMMODD(1)
      FRQ1=FMMODD(1)
      XMGEN1=FMMODD(2)
      QX1=FMMODD(3)
      QY1=FMMODD(4)
      QZ1=FMMODD(5)
 
      IPDEP2=MSOLE2.ISOLEN(IMOD1)
c     ajout du titre au chpoint
      MCHPOI=IPDEP2
      SEGACT MCHPOI*MOD
      MOCHDE=ITEX
      IPDEP2=MCHPOI
      SEGDES MCHPOI
      SEGDES MMODE
 
 
C---  REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES_IMAGINAIRES
C
      CALL ECCTAB(IPTAB5,'ENTIER',1,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QX1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB5,'ENTIER',2,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QY1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB5,'ENTIER',3,0.D0,' ',.TRUE.,0,
     #                   'FLOTTANT',0,QZ1,' ',.TRUE.,0)
C
C---  SUITE DU REMPLISSAGE DE LA TABLE MODE
 
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE_IMAGINAIRE',.TRUE.,0,
     #                   'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE_IMAGINAIRE',
     #        .TRUE.,0,'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,
     #                   'DEPLACEMENTS_GENERALISES_IMAGINAIRES',
     #            .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB5)
      CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE_IMAGINAIRE',
     #          .TRUE.,0,'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP2)
 
 
 
 
C---  SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
C
      CALL ECCTAB(IPTAB2,'ENTIER',NUME1,0.D0,' ',.TRUE.,0,
     #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
C
 
 
  20  CONTINUE
 
 
      SEGDES MSOLE1
      SEGDES MSOLE2
      SEGDES MSOLUT
 
      ENDIF
 
C-----CREATION DE LA TABLE FINALE
      CALL CRTABL(IPTAB1)
      CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     #                   'MOT',0,0.D0,'BASE_MODALE',.TRUE.,0)
      CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'MODES',.TRUE.,0,
     #                   'TABLE',0,0.D0,' ',.TRUE.,IPTAB2)
      CALL ECROBJ('TABLE',IPTAB1)
C
      END