Sources Esope | Cast3M

chcha2
C CHCHA2    SOURCE    CB215821  20/11/10    09:45:24     10766          
      SUBROUTINE CHCHA2 (IBAS,ILEN1,ILEN2,ICONT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C====================================================================
C     SUBROUTINE  POUR CHERCHER DANS UNE TABLE DE SOUSTYPE
C    "BASE_DE_MODES" LES DEFORMEES MODALES ET LES POINTS REPERES ASSOCIE
C     UTILISE PR EVRECO
C       IBAS     (E) POINTEUR SUR LA TABLE DONT ON PART
C       ILEN1    (S) POINTEUR SUR LA LISTE DES DEFORMEE-MODALES
C       ILEN2    (S) POINTEUR SUR LA LISTE DES POINTS REPERE
C======================================================================
      LOGICAL L0,L1
      CHARACTER*8 TYPRET
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC SMLENTI
*
      ILEN1 = 0
      ILEN2 = 0
*
      MTABLE = IBAS
      SEGACT MTABLE
*     NINDIC = nombre de tables de modes.
*                       Le premier indice est le SOUSTYPE
*                       Le deuxi}me indice est le MAILLAGE
      NINDIC = MLOTAB-2
      SEGDES MTABLE
      JG     = NINDIC
      SEGINI MLENT1,MLENT2
      ILEN1  = MLENT1
      ILEN2  = MLENT2
*
*     on boucle sur les modes
*
      JG=0
      DO 100 IN = 1 , NINDIC
         TYPRET=' '
         CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0,
     &                    TYPRET,I1,X1,' ',L1,ITMOD)
         IF(IERR.NE.0) RETURN
         IF(TYPRET.ne.'TABLE') GOTO 100
         JG=JG+1
         IF (ICONT.EQ.0) THEN
            CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
     &                    'CHPOINT',I1,X1,' ',L1,ICDEP)
            IF(IERR.NE.0) RETURN
            CALL ACTOBJ('CHPOINT ',ICDEP,1)
         ELSE IF (ICONT.EQ.2) THEN
            CALL ACCTAB(ITMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
     &                    'CHPOINT',I1,X1,' ',L1,ICDEP)
            IF(IERR.NE.0) RETURN
            CALL ACTOBJ('CHPOINT ',ICDEP,1)
         ELSE
            CALL ACCTAB(ITMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
     &                   'MCHAML',I1,X1,' ',L1,ICHAM)
            IF(IERR.NE.0) RETURN
            CALL ACTOBJ('MCHAML  ',ICHAM,1)
            CALL CHAMPO(ICHAM,1,ICDEP,IRET)
            IF ( IRET .NE. 1) RETURN
         ENDIF
         MLENT1.LECT(IN) = ICDEP
         CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
     &                   'POINT',I1,X1,' ',L1,IPTR)
         IF(IERR.NE.0) RETURN
         MLENT2.LECT(IN) = IPTR
  100 CONTINUE
      IF (JG .NE. NINDIC) SEGADJ,MLENT1,MLENT2
      END