C SYNTHE    SOURCE    CB215821  20/11/25    13:40:38     10792          
      SUBROUTINE SYNTHE
C********************************************************************
C
C     OPERATEUR SYNTHESE MODALE
C
C     TRANSFORME UN OBJET SOLUTION CONTENANT DES COMPOSANTES SUR LES
C     MODES DES SOUS-STRUCTURES EN UN OBJET SOLUTION CONTENANT DES
C     COMPOSANTES SUR LA BASE ELEMENTS FINIS PAR RECOMBINAISON MODALE
C
C     SYNTAXE : SOLEF = SYNT BASET SOLMO ;
C
C               BASET : OBJET DE TYPE BASE MODALE CONTENANT LES MODES
C                       DES SOUS-STRUCTURES, LES SOLUTIONS STATIQUES
C                       DEDUITES DES LIAISONS ET L OBJET ATTACHE
C                       DECRIVANT CES LIAISONS
C
C               SOLMO : OBJET DE TYPE SOLUTION CONTENANT LES CHAMPS
C                       DECOMPOSES SUR LA BASE DES MODES
C
C               SOLRE : OBJET DE TYPE SOLUTION CONTENANT LES CHAMPS
C                       DECOMPOSES SUR LA BASE ELEMENTS FINIS
C
C       M. PETIT SEPTEMBRE 88
C
C********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMSOLUT
-INC SMCHPOI
-INC SMLMOTS

      CHARACTER*(LOCOMP) MOT(3),MOTCLE
      DATA MOT  /'ALFA','BETA','FBET'/
      DATA NMOT/3/
C
      CALL LIROBJ ('BASEMODA',IPBASE,1,IRETOU)
      IF (IRETOU.EQ.0) GO TO 999
      CALL LIROBJ ('SOLUTION',IPSOLU,1,IRETOU)
      IF (IRETOU.EQ.0) GO TO 999
C
C     ON VERIFIE QU ON A DES MODES
C
      MSOLUT=IPSOLU
      SEGACT MSOLUT
      IF (ITYSOL.NE.'MODE') THEN
         MOTERR(1:8) ='SOLUTION'
         MOTERR(9:16)='MODE'
         CALL ERREUR(79)
         GO TO 999
      ENDIF
C
C     LISTMOTS POUR LA NORMALISATION
C
      CALL MOTS1(IPLMOT,MOTCLE)
C
C     BOUCLE 100 SUR LES MODES
C
      MSOLEN=MSOLIS(5)
      MSOLE1=MSOLIS(4)
      SEGDES MSOLUT
      SEGACT MSOLEN,MSOLE1
      NMOD=ISOLEN(/1)
      DO 100 IMOD=1,NMOD
      MCHPOI=ISOLEN(IMOD)
      SEGACT MCHPOI
C
C     ON VERIFIE QUE LE CHPOINT CONTIENT LES CONTRIBUTIONS MODALES
C
      NSOUPO=IPCHP(/1)
      DO 1 ISOU=1,NSOUPO
      MSOUPO=IPCHP(ISOU)
      SEGACT MSOUPO
      IF(NOCOMP(/2).NE.1) THEN
          CALL ERREUR(188)
          GO TO 999
      ENDIF
      DO 3 I=1,NMOT
      IF(NOCOMP(1).EQ.MOT(I)) GO TO 4
 3    CONTINUE
      CALL ERREUR(188)
      GO TO 999
 4    SEGDES MSOUPO
 1    CONTINUE
      ICHPOI=MCHPOI
C
C     RECOMBINAISON DES DEPLACEMENTS . CHPOINT RESULTAT DANS IRET
C
      CALL RECDEP(IPBASE,ICHPOI,IRET)
      IF(IERR.NE.0) GO TO 999
C
C     ON NORMALISE LES CHAMPS DE DEPLACEMENT
C     ET ON MET A JOUR LA MASSE GENERALISEE
C
      VALMAX=1.D0
      CALL MAXIM1(IRET,IPLMOT,MOTCLE,0,VALMAX)
      CALL NORMA1(IRET,IPLMOT,MOTCLE,ICHPO1)
      CALL DTCHPO(IRET)
C
C     CREATION DU MODE ET RANGEMENT DANS L OBJET SOLUTION
C
      MMODE=MSOLE1.ISOLEN(IMOD)
      SEGACT MMODE
      XMAS=FMMODD(2)/VALMAX/VALMAX
      IMMO1=IMMODD(1)
      FMMO1=FMMODD(1)
      FMMO3=FMMODD(3)
      FMMO4=FMMODD(4)
      FMMO5=FMMODD(5)
      CALL MANUSO('MODE    ',IMMO1,FMMO1,XMAS,FMMO3,
     &FMMO4,FMMO5,ICHPO1,0,0,IPMODE)
      SEGDES MMODE
C
      IF(IMOD.EQ.1) THEN
          IMO1=IPMODE
          ISOL=IPMODE
          GOTO 100
      ENDIF
      CALL FUSOLU(IMO1,IPMODE,ISOL)
      IF(IERR.NE.0) GOTO 999
      CALL DESOLU(IMO1)
      CALL DESOLU(IPMODE)
      IMO1=ISOL
100   CONTINUE
      SEGDES MSOLEN,MSOLE1
      MLMOTS=IPLMOT
      SEGSUP MLMOTS
C
      CALL ECROBJ ('SOLUTION',ISOL)
C
999   CONTINUE
      RETURN
      END