C SEISM2    SOURCE    CB215821  25/04/23    21:15:44     12247          
      SUBROUTINE SEISM2(IBAS,IPLA2,ICHPT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     G{n}re un CHPOINT qui repr{sente la r{partition spatiale du    *
*     chargement sismique.                                           *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   ITBAS   Table repr{sentant une base modale                     *
* e   IPLA2   num{ro du d{placement g{n{ralis{                       *
*  s  ICHPT   chpoint cr{{                                           *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 17 mai 1990.                                  *
*                                                                    *
*--------------------------------------------------------------------*
*                                                                    *

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCHPOI
-INC SMCOORD
-INC SMELEME
*
      LOGICAL L0,L1
      CHARACTER*8 TYPRET,CHARRE
*
      IM = 0
      NBMODE = 0
 10   CONTINUE
      IM = IM + 1
      TYPRET = ' '
      CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
     &                   TYPRET,I1,X1,CHARRE,L1,ITMOD)
      IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
         NBMODE = NBMODE + 1
         GOTO 10
      ENDIF
*
      NBNN = 1
      NBELEM = NBMODE
      NBSOUS = 0
      NBREF = 0
      SEGINI MELEME
      IMAIL = MELEME
      ITYPEL = 1
*
      NSOUPO = 1
      NAT= 1
      SEGINI MCHPOI
      JATTRI(1)=2
      ICHPT = MCHPOI
      IFOPOI = IFOUR
      NC = 1
      SEGINI MSOUPO
      IPCHP(1)=MSOUPO
      NOHARM(1) = NIFOUR
      NOCOMP(1) = 'FALF'
      N = NBMODE
      SEGINI MPOVAL
      IPOVAL = MPOVAL
      DO 20 IM = 1,NBMODE
         CALL ACCTAB(IBAS,'ENTIER',IM,X0,' ',L0,IP0,
     &                     'TABLE',I1,X1,' ',L1,ITMOD)
         CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
     &                   'POINT',I1,X1,' ',L1,IPTR)
         NUM(1,IM) = IPTR
         ICOLOR(IM) = IDCOUL
         CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEPLACEMENTS_GENERALISES',L0,
     &                     IP0,'TABLE',I1,X1,' ',L1,ITDEP)
         CALL ACCTAB(ITDEP,'ENTIER',IPLA2,X0,' ',L0,IP0,
     &                   'FLOTTANT',I1,XQN,' ',L1,IP1)
         VPOCHA(IM,1) = -1.D0 * XQN
 20      CONTINUE
*     end do
      SEGDES MELEME
      SEGDES MPOVAL
      IGEOC = IMAIL
      SEGDES MSOUPO
      SEGDES MCHPOI
*
      END