C RCCONT SOURCE CB215821 20/11/25 13:38:33 10792 SUBROUTINE RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Recombine le chpoint ICHPT en contrainte. * * * * Parametres: * * * * e ITBAS table representant une base modale * * e ICHPT chpoint modal a recombiner (si >0) * * table de listreel modal a recombiner (si <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 * * * * Auteur, date de creation: * * * * Lionel VIVAN, le 26 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) = 'RCCONT' 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 GOTO 991 ENDIF IF (NOCOMP(1).NE.'ALFA') THEN CALL ERREUR(188) SEGDES MSOUPO SEGDES MCHPOI GOTO 991 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 RCCON2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS, & ITLIA) IF (IERR.NE.0) GOTO 990 * * 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 RCCON2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS, & ITLIA) IF (IERR.NE.0) GOTO 990 IF (IB.EQ.1) THEN ICHCO = IRET ELSE N1 = 1 CALL ADCHEL(ICHCO,IRET,ICHCO,N1) ENDIF GOTO 30 ENDIF ENDIF * CALL ECROBJ('MCHAML',ICHCO) * 990 CONTINUE SEGSUP,TRAV 991 CONTINUE SEGSUP,ICPR * RETURN END