Sources Esope | Cast3M

rcdepl
C RCDEPL    SOURCE    CB215821  20/11/25    13:38:35     10792          
      SUBROUTINE RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,ITYP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Recombine les deplacements modaux au temps XTEMP               *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   ITBAS   table representant une base modale                     *
* e   ICHPT   chpoint modal a recombiner (si >0)                     *
*             table de listreel modal a recombiner (si &lt;0)           *
* e   KCHAR   chargement de la structure                             *
* e   XTEMP   temps de recombinaison                                 *
* e   ITRES   table resultat issue de l'operateur DYNE               *
* e   IPOS    position de XTEMP dans le listreel des temps           *
* e   ITLIA   table des liaisons                                     *
* e   ITYP    = 0 , on recombine les deplacements                    *
*             = 2 , on recombine les reactions                       *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Lionel VIVAN, le 18 avril 1990.                                *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMELEME
-INC SMCOORD
-INC SMTABLE
-INC SMLREEL
      SEGMENT ICPR(nbpts)
      SEGMENT TRAV(NPOIN)*D
      LOGICAL L0,L1
      CHARACTER*8 TYPRET,CHARRE
      CHARACTER*40 TYPBAS
 
*-----------------------------------------------------------------------
*     on met les contributions modales ICHPT dans ICPR et TRAV
*-----------------------------------------------------------------------
 
      IF (ICHPT.GT.0) GOTO 100
 
* --- Cas des sortie DYNE de type table de LISTREEL ---
      MTABLE=-1*ICHPT
      SEGACT,MTABLE
      SEGINI ICPR
      KCPR = ICPR
      IKI = 0
      DO 1 I=1,MLOTAB
        IF(MTABTI(I).NE.'POINT   ') GOTO 1 
        IF(MTABTV(I).NE.'LISTREEL') GOTO 1 
        IKI=IKI+1
        ICPR(MTABII(I))=IKI
   1  CONTINUE
      NPOIN = IKI
      SEGINI TRAV
      KTRAV = TRAV
      IKI = 0
      DO 2 I=1,MLOTAB
        IF(MTABTI(I).NE.'POINT   ') GOTO 2 
        IF(MTABTV(I).NE.'LISTREEL') GOTO 2
        IKI=IKI+1
        MLREEL=MTABIV(I)
        SEGACT,MLREEL
        TRAV(IKI)=PROG(IPOS)
        SEGDES,MLREEL
   2  CONTINUE
 
      GOTO 200
 
 
 100  CONTINUE
* --- Cas des sortie DYNE de type CHPOINT ---
 
      MCHPOI = ICHPT
      IF (MCHPOI.EQ.0) THEN
*        le CHPOINT des contributions modales est nul
         MOTERR(1:8) = 'RCDEPL'
         CALL ERREUR(170)
         RETURN
      ENDIF
      SEGINI ICPR
      KCPR = ICPR
      SEGACT MCHPOI
      NSOU = IPCHP(/1)
      IKI = 0
      DO 10 ISOU = 1,NSOU
         MSOUPO = IPCHP(ISOU)
         SEGACT MSOUPO
*        on cherche un CHPOINT qui contient des contributions modales
         IF (NOCOMP(/2).NE.1) THEN
            CALL ERREUR(188)
            SEGDES MSOUPO
            SEGDES MCHPOI
            SEGSUP ICPR
            RETURN
         ENDIF
         IF (NOCOMP(1).NE.'ALFA') THEN
            CALL ERREUR(188)
            SEGDES MSOUPO
            SEGDES MCHPOI
            SEGSUP ICPR
            RETURN
         ENDIF
         MELEME = IGEOC
         SEGACT MELEME
         N2 = NUM(/2)
         DO 12 I = 1,N2
            IKI = IKI + 1
            ICPR(NUM(1,I)) = IKI
 12      CONTINUE
         SEGDES MELEME,MSOUPO
 10   CONTINUE
      NPOIN = IKI
      SEGINI TRAV
      KTRAV = TRAV
      IKI = 0
      DO 20 ISOU = 1,NSOU
         MSOUPO = IPCHP(ISOU)
         SEGACT MSOUPO
         MPOVAL = IPOVAL
         SEGACT MPOVAL
         N2 = VPOCHA(/1)
         DO 22 I = 1,N2
            IKI = IKI + 1
            TRAV(IKI) = VPOCHA(I,1)
 22      CONTINUE
         SEGDES MPOVAL,MSOUPO
 20   CONTINUE
      SEGDES MCHPOI
 
 200  CONTINUE
 
*-----------------------------------------------------------------------
*     recup de la base modale
*-----------------------------------------------------------------------
 
      CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
     &                  'MOT',I1,X1,TYPBAS,L1,IP1)
*
*     Cas ou la base est unique
*
      IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
         CALL RCDEP2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS,
     &               ITLIA,ITYP)
         IF (IERR.NE.0) THEN
            SEGSUP TRAV,ICPR
            RETURN
         ENDIF
*
*     Cas ou on a un ensemble de bases
*
      ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
*
*        On boucle sur le nombre de bases
*
         IB = 0
 30      CONTINUE
         TYPRET = ' '
         IB = IB + 1
         CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
     &                       TYPRET,I1,X1,CHARRE,L1,ITTBAS)
         IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
            CALL RCDEP2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,
     &               ITLIA,ITYP)
            IF (IERR.NE.0) THEN
               SEGSUP TRAV,ICPR
               RETURN
            ENDIF
            IF (IB.EQ.1) THEN
               ICHDE = IRET
            ELSE
               N1 = 1
               CALL ADCHPO(ICHDE,IRET,ICHDE,1D0,1D0)
            ENDIF
            GOTO 30
         ENDIF
      ENDIF
*
      SEGSUP TRAV,ICPR
*
      CALL ECROBJ('CHPOINT ',ICHDE)
*
      END