C RCCON2 SOURCE FANDEUR 10/12/14 21:19:09 6812 SUBROUTINE RCCON2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS, & ITLIAV) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Recombine le chpoint ICHPT en contrainte. * * * * Param}tres: * * * * e IBAS table repr{sentant une base modale * * e KCHAR chargement de la structure * * e XTEMP temps de recombinaison * * e ITRES table r{sultat issue de l'op{rateur DYNE * * e IPOS position de XTEMP dans le listreel des temps * * e ITLIA table des liaisons * * * * Auteur, date de cr{ation: * * * * Lionel VIVAN, le 26 avril 1990. * * * * REMARQUE :NORMALEMENT CHACUN DES MCHAML DE CONTRAINTE MODALE * * SONT SIMILAIRES.LES VERIFICATIONS DE CONFORMITE DE * * CHACUN DES MCHAMLs SERA DONC REDUIT AU MINIMUM. * * A SAVOIR LES SOUS ZONE PORTE BIEN LE MEME POINTEUR DE * * MAILLAGE ET LES NOMS DES COMPOSANTES QUE L ON MULTIPLIE * * SONT IDENTIQUES. * * * * Passage aux nouveaux chamelem par jm CAMPENON le 01/91 * * * *--------------------------------------------------------------------* -INC CCOPTIO -INC SMCOORD -INC SMCHAML SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) SEGMENT ITRA1(NSOUS,4) SEGMENT TRAV(NPOIN)*D LOGICAL L0,L1 CHARACTER*8 TYPRET,CHARRE * TRAV = KTRAV ICPR = KCPR * CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBBB) * * initialisation du MCHAML * N1 = 1 CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0, & 'TABLE',I1,X1,' ',L1,ITBMOD) TYPRET = ' ' CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IPHC1) IF (IPHC1.NE.0) THEN IF (TYPRET.EQ.'MCHAML ') GOTO 100 ENDIF * MOTERR(1:8) = 'RCCON2 ' INTERR(1) = N1 CALL ERREUR(169) RETURN * 100 CONTINUE MCHEL1 = IPHC1 SEGINI,MCHELM=MCHEL1 ICHCO = MCHELM NSOUS= ICHAML(/1) SEGINI ITRA1 DO 60 ISOUS=1,NSOUS ITRA1(ISOUS,1)=IMACHE(ISOUS) MCHAM1=ICHAML(ISOUS) SEGINI,MCHAML=MCHAM1 ICHAML(ISOUS)=MCHAML ITRA1(ISOUS,2)=MCHAML 60 CONTINUE * * boucle sur le nombre de modes * IM = 0 40 CONTINUE IM = IM + 1 TYPRET = ' ' CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITBMOD) IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN TYPRET = ' ' CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IPHC1) C* IF (TYPRET.NE.'MCHAML ') THEN C* ERREUR ? C* ENDIF MCHEL1=IPHC1 SEGACT MCHEL1 DO 42 ISOUS=1,NSOUS IPMAIL=ITRA1(ISOUS,1) IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN SEGDES MCHEL1 CALL ERREUR(21) GOTO 9990 ENDIF MCHAM1=MCHEL1.ICHAML(ISOUS) SEGACT MCHAM1 MCHAML=ITRA1(ISOUS,2) NCOMP=IELVAL(/1) DO 30 ICOMP=1,NCOMP CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC, & NOMCHE(ICOMP) ) IF (IPLAC.EQ.0) THEN SEGDES MCHAM1 SEGDES MCHEL1 CALL ERREUR(21) GOTO 9990 ENDIF MELVA1=MCHAM1.IELVAL(IPLAC) SEGACT MELVA1 N1PTEL = MELVA1.VELCHE(/1) N1EL = MELVA1.VELCHE(/2) ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL) ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL ) SEGDES MELVA1 30 CONTINUE SEGDES MCHAM1 42 CONTINUE SEGDES MCHEL1 GOTO 40 ENDIF NBMODE = IM - 1 * DO 50 ISOUS=1,NSOUS MCHAML=ITRA1(ISOUS,2) N1PTEL = ITRA1(ISOUS,3) N1EL = ITRA1(ISOUS,4) N2PTEL = 0 N2EL = 0 NCOMP=IELVAL(/1) DO 51 ICOMP=1,NCOMP SEGINI MELVAL IELVAL(ICOMP) = MELVAL 51 CONTINUE 50 CONTINUE * * boucle sur les contraintes modales * DO 300 IM = 1,NBMODE CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0, & 'TABLE',I1,X1,' ',L1,ITBMOD) CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0, & 'POINT',I1,X1,' ',L1,IPTR) TYPRET = ' ' CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IPHC1) C* IF (TYPRET.NE.'MCHAML ') THEN C* ERREUR ? C* ENDIF IMODE = ICPR(IPTR) IF (IMODE.EQ.0) THEN * * on ne trouve pas la contrainte modale * MOTERR(1:8) = 'RCCON2' INTERR(1) = IM CALL ERREUR(169) CALL DTCHAM(ICHCO) GOTO 9990 ENDIF XVAL = TRAV(IMODE) MCHEL1 = IPHC1 SEGACT MCHEL1 NSOU1 = MCHEL1.ICHAML(/1) DO 320 ISOU1 = 1,NSOU1 MCHAML=ITRA1(ISOU1,2) MCHAM1=MCHEL1.ICHAML(ISOU1) SEGACT MCHAM1 NCOMP=IELVAL(/1) DO 342 ICOMP=1,NCOMP CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC, & NOMCHE(ICOMP) ) MELVA1=MCHAM1.IELVAL(IPLAC) SEGACT MELVA1 MELVAL=IELVAL(ICOMP) DO 344 IGAU=1,VELCHE(/1) IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) DO 344 IB=1,VELCHE(/2) IBMN=MIN(IB ,MELVA1.VELCHE(/2)) VELCHE(IGAU,IB)=VELCHE(IGAU,IB) & +XVAL*MELVA1.VELCHE(IGMN,IBMN) 344 CONTINUE SEGDES MELVA1 342 CONTINUE SEGDES MCHAM1 320 CONTINUE SEGDES MCHEL1 300 CONTINUE DO 61 ISOUS=1,NSOUS MCHAML=ITRA1(ISOUS,2) NCOMP=IELVAL(/1) DO 62 ICOMP=1,NCOMP MELVAL=IELVAL(ICOMP) SEGDES MELVAL 62 CONTINUE SEGDES MCHAML 61 CONTINUE SEGDES MCHELM * * Prise en compte des pseudo-modes * IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN TYPRET = ' ' CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITPS) IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA) ELSE CALL ERREUR(429) ENDIF ENDIF RETURN * 9990 CONTINUE DO 71 ISOUS=1,NSOUS MCHAML=ITRA1(ISOUS,2) SEGSUP MCHAML 71 CONTINUE SEGSUP ITRA1 C* SEGSUP MCHELM RETURN END