Sources Esope | Cast3M

reclch
C RECLCH    SOURCE    CB215821  20/11/25    13:38:43     10792          
      SUBROUTINE RECLCH(ILCHP1,ITBAS1,NBMOD1,ILCHP2)
************************************************************************
* NOM         : RECLCH
* DESCRIPTION : Recombine les coefficients de projection d'un signal
*               instationnaires avec les modes correspondants
************************************************************************
* APPELE PAR : recomb.eso
************************************************************************
* ENTREES : ILCHP1 = pointeur vers le LISTCHPO des coefficients de
*                    projection (voir l'operateur PJBA)
*           ITBAS1 = pointeur vers la TABLE de sous-type BASE_MODALE
*           NBMOD1 = nombre de modes concernes (0 => tous)
* SORTIES : ILCHP2 = pointeur vers l'objet LISTCHPO contenant le
*                    signal instationnaire projete sur les NBMOD1 
*                    premiers modes
************************************************************************
* SYNTAXE (GIBIANE) :
*
*                LCHPO2 = RECO LCHPO1 TBAS1 (NMOD1) ;
*
************************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)    
 
-INC PPARAM
-INC CCOPTIO
-INC SMLCHPO
-INC SMCHPOI
-INC SMELEME
-INC SMTABLE
*
      SEGMENT,ICHMOD(NMO)
      SEGMENT,IPOMOD(NMO)
      SEGMENT,COEMOD(NMO)*D
*
      CHARACTER*8  CHA8
      CHARACTER*12 CH12
*
      LOGICAL ZLOGI     
*
*
*     NOMBRE DE MODES CONTENUS DANS LA TABLE
*     ======================================
      CALL ACCTAB(ITBAS1,'MOT',0,0.D0,'MODES',.TRUE.,0,
     &                   'TABLE',IVAL,XVAL,CHA8,ZLOGI,MTAB1)
      SEGACT,MTAB1
      MLOTA=MTAB1.MLOTAB
      NBMOD2=0
      DO I=1,MLOTA
         IF (MTAB1.MTABTI(I).EQ.'ENTIER') NBMOD2=NBMOD2+1
      ENDDO
      SEGDES,MTAB1
      IF (NBMOD2.EQ.0) THEN
         MOTERR(1:8)='TABLE'
         CALL ERREUR(1027)
         RETURN
      ENDIF
*
*
*     NOMBRE DE MODES SUR LESQUELS CALCULER LA PROJECTION
*     ===================================================
      IF (NBMOD1.GT.0) THEN
         IF (NBMOD1.GT.NBMOD2) THEN
            INTERR(1)=NBMOD1
            CALL ERREUR(36)
            RETURN
         ENDIF
         NMO=NBMOD1
      ELSE
         NMO=NBMOD2
      ENDIF
*
*
*     MEMORISATION DU POINTEUR DU CHPOINT ET DU NOEUD DE CHAQUE MODE
*     ==============================================================
      SEGINI,ICHMOD,IPOMOD
      DO IMO=1,NMO
         CALL ACCTAB(MTAB1,'ENTIER',IMO,0.D0,'MOT',.TRUE.,0,
     &                     'TABLE',IVAL,XVAL,CHA8,ZLOGI,ITAB2)
         IF (IERR.NE.0) RETURN
*
         CALL ACCTAB(ITAB2,'MOT',0,0.D0,'DEFORMEE_MODALE',.TRUE.,0,
     &                     'CHPOINT',IVAL,XVAL,CHA8,ZLOGI,ICHP3)
         IF (IERR.NE.0) RETURN
         ICHMOD(IMO)=ICHP3
*
         CALL ACCTAB(ITAB2,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
     &                     'POINT',IVAL,XVAL,CHA8,ZLOGI,IPOI3)
         IF (IERR.NE.0) RETURN
         IPOMOD(IMO)=IPOI3
*
      ENDDO
*
*
*
*     CALCUL DE LA RECOMBINAISON MODALE, POUR CHAQUE PAS DE TEMPS
*     ===========================================================
*
      MLCHP1=ILCHP1
      SEGACT,MLCHP1
      N1=MLCHP1.ICHPOI(/1)
*
      SEGINI,MLCHP2
      ILCHP2=MLCHP2
*
      WRITE(CHA8,FMT='(I8)') NMO
      CALL LIMCHA(CHA8,I1,I2)
*
*     BOUCLE SUR LES PAS DE TEMPS
      DO IT=1,N1
         ICHPO1=MLCHP1.ICHPOI(IT)
         MCHPO1=ICHPO1
         SEGACT,MCHPO1
         MSOUP1=MCHPO1.IPCHP(1)
         SEGACT,MSOUP1
         IPT1=MSOUP1.IGEOC
         SEGACT,IPT1
         NPO1=IPT1.NUM(/2)
         MPOVA1=MSOUP1.IPOVAL
         SEGACT,MPOVA1
 
         SEGINI,COEMOD
*
*        BOUCLE SUR LES MODES
         DO IMO=1,NMO
            IPO1=IPOMOD(IMO)
            DO K=1,NPO1
               IF (IPT1.NUM(1,K).EQ.IPO1) GOTO 10
            ENDDO
            INTERR(1)=IMO
            WRITE(CHA8,FMT='(I8)') IT
            CALL LIMCHA(CHA8,I1,I2)
            MOTERR(1:8)=CHA8(I1:I2)
            CALL ERREUR(1054)
            RETURN
 10         COEMOD(IMO)=MPOVA1.VPOCHA(K,1)
         ENDDO
*
         CALL COMBIL(ICHMOD,COEMOD,NMO,ICHPO2)
         IF (IERR.NE.0) RETURN
         MCHPO2=ICHPO2
         SEGACT,MCHPO2*MOD
         WRITE(CH12,FMT='(I12)') IT
         CALL LIMCHA(CH12,I3,I4)
         WRITE(MCHPO2.MOCHDE,FMT='(5A)') " PROJECTION SUR ",CHA8(I1:I2),
     &                               " MODES A L'INSTANT #",CH12(I3:I4)
         MLCHP2.ICHPOI(IT)=ICHPO2
*
         SEGDES,MPOVA1,IPT1,MSOUP1,MCHPO1,MCHPO2
         SEGSUP,COEMOD
*
      ENDDO
*
      SEGDES,MLCHP1,MLCHP2
      SEGSUP,ICHMOD,IPOMOD
*
      RETURN
*
      END
*
*