C RECOMB SOURCE CB215821 20/11/25 13:38:47 10792 SUBROUTINE RECOMB IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *_______________________________________________________________________ * * OPERATEUR RECO : * RECOMBINAISON EN ANALYSE MODALE. * * ANCIENNE SYNTAXE: * ================ * ******** B EST UNE BASE ELEMENTAIRE * ---------------- * X1 = RECO XA B DEPL; * X2 = RECO XA B CONT; * * ******** B EST UNE BASE COMPLEXE: STR1 EST LA STRUCTURE * ------------- POUR LAQUELLE LA * RECOMBINAISON S'EFFECTUE, ET N LE NUMERO DE * LA SOUS-STRUCTURE SI CELLE CI EST FORMEE DE * SOUS-STRUCTURES IDENTIQUES. * * X1 = RECO XA B STR1 (N) DEPL ; * X2 = RECO XA B STR1 (N) CONT ; * * XA : OBJET CHPOINT CONTENANT LES CONTRIBUTIONS MODALES * DEPL : ON RECOMBINE DES DEPLACEMENTS. X1 EST UN CHPOINT * CONT : ON RECOMBINE DES CONTRAINTES . X2 EST UN CHELEM * * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 02/91 * EXTENSION AU CAS OU XA EST UN LISTCHPO LE 7/04/2016 * * *_______________________________________________________________________ * -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMBASEM -INC SMCHPOI -INC SMLCHPO -INC SMLREEL -INC SMSOLUT -INC SMSTRUC LOGICAL L0,L1,LOGIN,LOGRE PARAMETER ( LMOOPT = 5 , IUN = 1 ) CHARACTER*4 MOOPT(LMOOPT) CHARACTER*(8) ITYPE,CTYP,TYPOBJ,TYPRET CHARACTER*(16) TYPTAB CHARACTER*72 CHARRE DATA MOOPT/'DEPL','CONT','VITE','ACCE','REAC'/ CHARACTER*12 MOCLE2(LMOOPT),MODYN DATA MOCLE2/'DEPLACEMENT','DEPLACEMENT','VITESSE','ACCELERATION' & ,'DEPLACEMENT'/ C---- Lecture de l'objet resultat + Aiguillage c qui determine (en partie) dans quel cas on est ------------------- c-----CHPOINT ILECT=0 CALL LIROBJ('CHPOINT ',ICHP1,0,IRET3) c write(6,*) 'CHPOINT?',IRET3 IF(IRET3.EQ.1) GOTO 300 c-----LISTCHPO CALL LIROBJ('LISTCHPO',ILCHP1,0,IRET23) IF (IRET23.EQ.1) THEN CALL ACTOBJ('LISTCHPO',ILCHP1,1) * TABLE DE MODES CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET) IF (IERR.NE.0) RETURN * NOMBRE DE MODES CALL LIRENT(NMOD1,0,IRET) IF (IRET.EQ.0) NMOD1=0 CALL RECLCH(ILCHP1,ITBAS1,NMOD1,ILCHP2) IF (IERR.NE.0) RETURN CALL ACTOBJ('LISTCHPO',ILCHP2,1) CALL ECROBJ('LISTCHPO',ILCHP2) RETURN ENDIF c-----TABLE CALL LIROBJ('TABLE ',ITAB1,0,IRET12) c write(6,*) 'TABLE?',IRET12 IF(IRET12.EQ.0) GOTO 9 C---- Lecture du mot clé ----------------------------------------------- IMOO=0 CALL LIRMOT(MOOPT,LMOOPT,IMOO,0) c -table PASAPAS ? c CALL LIRTAB('PASAPAS',ITPASA,0,IRET2) TYPOBJ = ' ' TYPTAB ='PASAPAS' LE=7 IRET2=0 CALL ACCTAB(ITAB1,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN, $ IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) c write(6,*) 'TABLE PASAPAS?',TYPOBJ,IVALRE,CHARRE(1:LE) IF(TYPOBJ.NE.'MOT ') GOTO 2 IF(IVALRE.NE.LE) GOTO 2 IF(CHARRE(1:LE).NE.TYPTAB) GOTO 2 ITPASA=ITAB1 IRET2=1 c si table PASAPAS on recupere le chpoint qui va bien ITRES=ITPASA IF(IMOO.EQ.0) THEN WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle' CALL ERREUR(21) RETURN ENDIF CALL REPEC2(ITRES,IMOO,ICHP1) ILECT=1 GOTO 300 2 CONTINUE c -table RESULTAT_DYNE ? c CALL LIRTAB('RESULTAT_DYNE',ITDYNE,0,IRET1) TYPOBJ = ' ' TYPTAB ='RESULTAT_DYNE' LE=13 IRET1=0 CALL ACCTAB(ITAB1,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN, $ IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) c write(6,*) 'TABLE PASAPAS?',TYPOBJ,IVALRE,CHARRE(1:LE) IF(TYPOBJ.NE.'MOT ') GOTO 9 IF(IVALRE.NE.LE) GOTO 9 IF(CHARRE(1:LE).NE.TYPTAB) GOTO 9 ITDYNE=ITAB1 IRET1=1 GOTO 100 C-----ERREUR argument entree 9 CONTINUE WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un objet de type :' WRITE(IOIMP,*) '- TABLE de sous-type RESULTAT_DYNE,' WRITE(IOIMP,*) '- TABLE de sous-type PASAPAS,' WRITE(IOIMP,*) '- ou CHPOINT ou LISTCHPO' CALL ERREUR(21) RETURN C---- Cas d'un CHPOINT ------------------------------------------------- 300 CONTINUE CALL ACTOBJ('CHPOINT ',ICHP1,1) c A partir de quelle objet recombine t'on ? c (modele, table ou basemoda) C---- Cas d'un CHPOINT + MODELE modal ---------------------------------- CALL LIROBJ('MMODEL ',IPMODL,0,IRET) IF (IRET.NE.0) THEN CALL ACTOBJ('MMODEL ',IPMODL,1) CALL LIROBJ('MCHAML ',IPIN,1,IRET1) CALL ACTOBJ('MCHAML ',IPIN,1) if (IERR.NE.0) RETURN CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER) IF(IR .NE. 1) CALL ERREUR(KER) IF(IERR .NE. 0) RETURN CALL RECOF2(ipmodl,ipcha1,ichp1,ipout) if (IERR.NE.0) RETURN CALL ACTOBJ('CHPOINT ',ipout,1) CALL ECROBJ('CHPOINT ',ipout) RETURN ENDIF C---- Cas d'un CHPOINT + TABLES (LIAISONS_STATIQUES + BASE_MODALE) ----- CALL LIRTAB('LIAISONS_STATIQUES',itst,0,iretst) CALL LIRTAB('BASE_MODALE',itbm,0,iretbm) if (ierr.ne.0) return c -si on n'a pas lu de table on va vers l'ancienne syntaxe (BASEMODA) if (iretst.eq.0.and.iretbm.eq.0) GOTO 900 c -syntaxe avec une ou des tables CALL RECOF1(itst,itbm,ichp1,ipout) if (ierr.ne.0) return CALL ACTOBJ('CHPOINT ',ipout,1) CALL ECROBJ('CHPOINT ',ipout) RETURN C---- Cas d'une TABLE de RESULTAT_DYNE --------------------------------- 100 CONTINUE ITRES = ITDYNE c qq initialisations KPSMO = 0 KCHAR = 0 KCHLIA = 0 ITLIA = 0 XTEMP = 0.D0 c Lecture obligatoire mot clé (DEPL,...) IF(IMOO.EQ.0) THEN WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle' CALL ERREUR(21) RETURN ENDIF c + temps pour lequel il faut restituer CALL LIRREE(XTEMP,1,IRET) IF (IERR.NE.0) RETURN XMPE = -XPETIT IF (XTEMP.LT.XMPE) THEN CALL ERREUR(431) RETURN ENDIF C + table BASE_MODALE ou ENSEMBLE_DE_BASES CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET) IF (IRET.EQ.0) THEN CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,1,IRET) ENDIF IF (IERR.NE.0) RETURN c + facultative chargement et liaison CALL LIROBJ('CHARGEME',KCHAR,0,IRET) IF (IRET .EQ. 1) CALL ACTOBJ('CHARGEME',KCHAR,1) CALL LIRTAB('LIAISON',ITLIA,0,IRET) c l'instant XTEMP correspond au pas de temps IPOS CALL ACCTAB(ITRES,'MOT',I0,X0,'TEMPS_DE_SORTIE',L0,IP0, & 'LISTREEL',I1,X1,' ',L1,LBO) IF (IERR.NE.0) RETURN MLREEL = LBO SEGACT MLREEL LTE = PROG(/1) PRECI = (PROG(LTE) - PROG(1)) / (LTE * 100) c rem bp : heureusement que DYNE fonctionne a pas de temps constant ! c sinon il faudrait revoir la def de PRECI !!! CALL PLACE3(PROG,IUN,LTE,XTEMP,IR,AR) IF (AR.LE.PRECI) THEN IPOS = IR ELSE ARR = ABS(1. - AR) IF (ARR.LE.PRECI) THEN IPOS = IR + 1 ELSE MOTERR(1:8) = 'TABLE ' MOTERR(9:16) ='LISTREEL' CALL ERREUR(135) SEGDES MLREEL RETURN ENDIF ENDIF SEGDES MLREEL cbp QUEL TYPE DE SORTIE DE LA TABLE DYNE (CHPOINT OU LISTREEEL)? c existe-t-il le LISTREEL dans la table . 'DEPLACEMENT' ? MODYN=MOCLE2(IMOO) TYPRET=' ' CALL ACCTAB (ITRES ,'MOT',I0,X0,MODYN,L0,IRET0, & TYPRET,I1,X1,' ',L1,IDYN1) IF(TYPRET.EQ.'TABLE'.AND.IDYN1.NE.0) THEN ICHPT=-1*IDYN1 IF (MOOPT(IMOO).EQ.'DEPL') THEN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,0) ELSE IF (MOOPT(IMOO).EQ.'VITE') THEN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,1) ELSE IF (MOOPT(IMOO).EQ.'ACCE') THEN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,-1) ELSE IF (MOOPT(IMOO).EQ.'REAC') THEN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,2) ELSE CALL RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA) ENDIF RETURN ENDIF c Recuperation du CHPOINT a l'instant XTEMP c + Recombinaison via RCDEPL et RCCONT c (Ecriture du CHPOIN/MCHAML dans RCDEPL/RCCONT) CALL ACCTAB(ITRES,'ENTIER',IPOS,X0,' ',L0,IP0, & 'TABLE',I1,X1,' ',L1,ITDEP) IF (IERR.NE.0) RETURN IF (MOOPT(IMOO).EQ.'DEPL') THEN CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHPT) IF (IERR.NE.0) RETURN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,0) ELSE IF (MOOPT(IMOO).EQ.'VITE') THEN CALL ACCTAB(ITDEP,'MOT',I0,X0,'VITESSE',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHPT) IF (IERR.NE.0) RETURN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,1) ELSE IF (MOOPT(IMOO).EQ.'ACCE') THEN CALL ACCTAB(ITDEP,'MOT',I0,X0,'ACCELERATION',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHPT) IF (IERR.NE.0) RETURN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,-1) ELSE IF (MOOPT(IMOO).EQ.'REAC') THEN CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHPT) IF (IERR.NE.0) RETURN CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,2) ELSE CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHPT) IF (IERR.NE.0) RETURN CALL RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA) ENDIF RETURN C---- fin du cas avec une TABLE de RESULTAT_DYNE ----------------------- *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+* * version appelee a disparaitre *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+* 900 CONTINUE C---- Cas d'un CHPOINT + BASEMODA -------------------------------------- C Lecture obligatoire de la BASEMODA + un mot clé (DEPL,...) CALL LIROBJ ('BASEMODA',IP2,0,IRETOU) if (IRETOU.eq.0.or.IERR.NE.0) THEN WRITE(IOIMP,*) 'OPERATEUR RECO : Apres un CHPOINT,' , & ' on attend un objet de type :' WRITE(IOIMP,*) '- TABLE de sous-type BASE_MODALE,' WRITE(IOIMP,*) '- TABLE de sous-type LIAISONS_STATIQUES,' WRITE(IOIMP,*) '- ou BASEMODA' CALL ERREUR(21) RETURN ENDIF IF (IRET3.EQ.1) THEN IMOO=0 CALL LIRMOT(MOOPT,LMOOPT,IMOO,0) ENDIF IF(IMOO.EQ.0) THEN WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle' CALL ERREUR(21) RETURN ENDIF c qq initialisations + recup du chpoint KPSMO = 0 KCHAR = 0 KCHLIA = 0 ITLIA = 0 XTEMP = 0.D0 ICH1=ICHP1 c lecture du temps si PSEUDO MODE (+chargement + chpoint de liaison) IF(IERR.NE.0) RETURN CALL LIRREE(XTEMP,0,IRETOU) IF (IRETOU.EQ.1) THEN KPSMO = 1 CALL LIROBJ('CHPOINT ',KCHLIA,0,IRETOU) IF(IRETOU .EQ. 1) CALL ACTOBJ('CHPOINT ',KCHLIA,1) CALL LIROBJ('CHARGEME',KCHAR,0,IRETOU) IF(IRETOU .EQ. 1) CALL ACTOBJ('CHARGEME',KCHAR,1) ENDIF IF(IERR.NE.0) RETURN C C **** ON VERIFIE QUE LE CHPOINT CONTIENT LES CONTRIBUTIONS MODALES C MCHPOI = ICH1 SEGACT MCHPOI NSOUPO = IPCHP(/1) DO 1 ISOU = 1,NSOUPO MSOUPO = IPCHP(ISOU) SEGACT MSOUPO IF (NOCOMP(/2).NE.1) THEN C ON CHERCHE UN CHPOINT QUI CONTIENT DES CONTIBUTIONS MODALES CALL ERREUR(188) RETURN ENDIF IF (NOCOMP(1).NE.'ALFA') THEN C ON CHERCHE ........ CALL ERREUR(188) SEGDES MSOUPO RETURN ENDIF SEGDES MSOUPO 1 CONTINUE SEGDES MCHPOI * TRAVAIL SUR LA BASE MODALE MBASEM = IP2 SEGACT MBASEM NBAS = LISBAS(/1) IP4 = 1 IF (NBAS.NE.1) THEN C BASE COMPLEXE CALL LIROBJ('STRUCTUR',IRET,1,IRETOU) IF( IERR.NE.0 ) RETURN MSTRUC = IRET SEGACT MSTRUC NSTRU = LISTRU(/1) MSOSTU = LISTRU(1) IP3 = 1 IF (NSTRU.NE.1) THEN C STRUCTURE COMPLEXE CALL LIRENT(IP3,1,IRETOU) IF (IERR.NE.0) RETURN C ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES SEGACT MSOSTU ISRAI1 = ISRAID SEGDES MSOSTU DO 14 NS = 2,NSTRU MSOSTU = LISTRU(NS) SEGACT MSOSTU IF (ISRAI1.NE.ISRAID) RETURN SEGDES MSOSTU 14 CONTINUE IF (IP3.EQ.0 .OR. IP3.GT.NSTRU) THEN CALL ERREUR(216) RETURN ENDIF MSOSTU = LISTRU(IP3) ENDIF SEGDES MSTRUC C ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE DO 16 NB = 1,NBAS MSOBAS = LISBAS(NB) SEGACT MSOBAS IP4 = NB IF (IBSTRM(1).EQ.MSOSTU) GOTO 17 SEGDES MSOBAS 16 CONTINUE C *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE CALL ERREUR(216) RETURN 17 CONTINUE ENDIF MSOBAS = LISBAS(IP4) SEGDES MBASEM SEGACT MSOBAS IBMODE = IBSTRM(2) IBSOLS = IBSTRM(3) IBPSMO = IBSTRM(5) IRET = 0 IRET1 = 0 IRET2 = 0 * IF (IMOO.EQ.2) THEN * * RECOMBINAISON DE CONTRAINTES * READ (MOOPT(2),FMT='(A4)') MOCON IF (IBMODE.NE.0) THEN MSOLUT = IBMODE SEGACT MSOLUT KMEL1 = MSOLIS(3) KCON = MSOLIS(6) SEGDES MSOLUT IF (KCON.EQ.0) THEN MOTERR(1:8) = ITYSOL CALL ERREUR(61) RETURN ENDIF CALL RCOSIG(ICH1,KCON,KMEL1,IRET1) IF( IERR.NE.0 ) RETURN IF (IBSOLS.EQ.0) IRET = IRET1 ENDIF IF (IBSOLS.NE.0) THEN MSOLUT = IBSOLS SEGACT MSOLUT KMEL1 = MSOLIS(3) KCON = MSOLIS(6) SEGDES MSOLUT IF (KCON.EQ.0) THEN MOTERR(1:8) = ITYSOL CALL ERREUR(61) RETURN ENDIF CALL RCOSIG(ICH1,KCON,KMEL1,IRET2) IF( IERR.NE.0 ) RETURN IF (IRET1.NE.0) THEN ICONV=0 CALL ADCHEL(IRET1,IRET2,IRET,IUN) ELSE IRET = IRET2 ENDIF ENDIF IF (IRET.EQ.0) RETURN ITYPE = 'CHAMELEM' ELSE * * RECOMBINAISON DE DEPLACEMENTS * READ (MOOPT(1),FMT='(A4)') MODEPL IF (IBMODE.NE.0) THEN MSOLUT = IBMODE SEGACT MSOLUT KDEPL = MSOLIS(5) KMEL1 = MSOLIS(3) SEGDES MSOLUT IF (KDEPL.EQ.0) THEN MOTERR(1:8) = ITYSOL CALL ERREUR(61) RETURN ENDIF CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1) IF (IERR.NE.0) RETURN IF (IBSOLS.EQ.0) IRET = IRET1 ENDIF IF (IBSOLS.NE.0) THEN MSOLUT = IBSOLS SEGACT MSOLUT KDEPL = MSOLIS(5) KMEL1 = MSOLIS(3) SEGDES MSOLUT IF (KDEPL.EQ.0) THEN MOTERR(1:8) = ITYSOL CALL ERREUR(61) RETURN ENDIF CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2) IF (IERR.NE.0) RETURN IF (IRET1.NE.0) THEN CALL ADCHPO(IRET1,IRET2,IRET,1D0,1D0) IF( IERR.NE.0 ) RETURN ELSE IRET = IRET2 ENDIF ENDIF IF (IRET.EQ.0) RETURN ITYPE = 'CHPOINT ' ENDIF * * PRIS EN COMPTE DES PSEUDO-MODES * IF (KPSMO.NE.0) THEN CALL PSRECO(IBMODE,IBPSMO,MOOPT(IMOO),KCHAR,KCHLIA,XTEMP,IRET) ENDIF * SEGDES MSOBAS CALL ACTOBJ (ITYPE,IRET,1) CALL ECROBJ (ITYPE,IRET) END