C PJBA SOURCE CB215821 20/11/25 13:35:48 10792 SUBROUTINE PJBA IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C======================================================================= C OPERATEUR PJBA : C PROJECTION D'UN CHPOINT, D'UN CHARGEMENT OU D'UNE RIGIDITE C SUR LES ELEMENTS D'UNE BASE MODALE B. C LE RESULTAT EST DU MEME TYPE. C C SYNTAXE : C * FN = PJBA B OBJET ; SI BASE ELEMENTAIRE C * FN = PJBA B STR1 (N) OBJET ; SI BASE COMPLEXE C C OBJET POUVANT ETRE UNE FORCE OU UN CHARGEMENT, C OU UNE RIGIDITE DANS LE PREMIER CAS. C C STR1 EST LA SOUS-STRUCTURE OU S'APPLIQUE L'OBJET. C N EST LE NUMERO DE LA SOUS-STRUCTURE SI CELLE-CI EST C FORMEE DE SOUS-STRUCTURES IDENTIQUES . C C C CAS PARTICULIER DES GRANDS DEPLACEMENTS SUR BASE TOURNANTE : C ---------------------------------------------------------- C C SI LA FORCE N'EST PAS LIEE A LA BASE ( EX : LA PESANTEUR ) C IL FAUT SPECIFIER LE MOT-CLEF ......... LIBR C ALORS FN EST UN OBJET LISTCHPO CONTENANT LES VECTEURS DE C DECOMPOSITION DE LA FORCE GENERALISEE F C C======================================================================= -INC SMBASEM -INC SMCHPOI -INC SMCHARG -INC SMLCHPO -INC SMSOLUT -INC SMSTRUC -INC PPARAM -INC CCOPTIO C LOGICAL L0,L1,CHAR,TABL CHARACTER*4 LIBR(1),CLE(1) CHARACTER*32 CH32 CHARACTER*72 motyp1,motyp2 DATA CLE(1)/'REEL'/ DATA LIBR(1) /'LIBR'/ NLIBR = 1 TABL = .FALSE. C---- Cas d'un LISTCHPO ou d'une TABLE de resultats -------------------- CALL LIRTAB('PASAPAS',MTAB1,0,IRETOU) IF (IRETOU.EQ.0) CALL LIRTAB('DYNAMIC',MTAB1 ,0,IRETOU) IF (IRETOU.EQ.0) CALL LIRTAB('EXEC' ,MTAB1 ,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL LIROBJ('LISTCHPO',ILCHP1,0,IRETOU) IF(IRETOU .EQ. 1) CALL ACTOBJ('LISTCHPO',ILCHP1,1) ENDIF IF (IRETOU.EQ.0) GOTO 100 * SIGNAL D'ENTREE ITYP=0 CALL REFUS CALL LIRRES(ILCHP1,1,ITYP,CH32,NCH,0,ILREE1) IF (IERR.NE.0) RETURN * 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 * MATRICE POUR LE PRODUIT SCALAIRE CALL LIROBJ('RIGIDITE',IRIG1,0,IRET) IF (IRET.EQ.0) IRIG1=0 CALL PJBLCH(ILCHP1,ITBAS1,NMOD1,IRIG1,ILCHP2) IF (IERR.NE.0) RETURN CALL ACTOBJ('LISTCHPO',ILCHP2,1) CALL ECROBJ('LISTCHPO',ILCHP2) RETURN C---- Cas d'un MODELE -------------------------------------------------- 100 CONTINUE call LIROBJ('MMODEL ',IPMODE,0,iretou) IF (iretou.EQ.0) GOTO 200 CALL ACTOBJ('MMODEL ',IPMODE,1) call pjmode(ipmode) return C---- Cas d'une RIGIDITE ----------------------------------------------- 200 CONTINUE CALL LIROBJ('RIGIDITE',MRIGID,0,IRETOU) IF (IRETOU.EQ.0) GOTO 300 C --- Cas d'une RIGIDITE suivie d'1 (ou 2) TABLE(S) --- CALL LIROBJ('TABLE ',MTAB1,1,IRETOU) IF (IERR.NE.0) RETURN CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0, & 'MOT',IP,RR,motyp1,.TRUE.,IQ) c lecture facultative d une 2eme table CALL LIROBJ('TABLE ',MTAB2,0,IRETO2) IF(IRETO2.NE.0) THEN CALL ACCTAB(MTAB2,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0, & 'MOT',IP,RR,motyp2,.TRUE.,IQ) IF (IERR.NE.0) RETURN c a t'on inversé les 2 tables ? if (motyp1.eq.'LIAISONS_STATIQUES'.and. & motyp2.eq.'BASE_MODALE') then motyp1='BASE_MODALE' motyp2='LIAISONS_STATIQUES' MTEMP = MTAB1 MTAB1 = MTAB2 MTAB2 = MTEMP endif if (motyp1.ne.'BASE_MODALE'.or. & motyp2.ne.'LIAISONS_STATIQUES') then write(ioimp,*) 'Donnez une (des) table(s) de soustype', & ' BASE_MODALE ou LIAISONS_STATIQUES' call erreur(482) return endif ELSE MTAB2=0 ENDIF c -calcul de Phi^T * K * Phi (ou Phi = base modale) if (motyp1.eq.'BASE_MODALE') then CALL LIRMOT(CLE,1,ICLE,0) CALL PROJRG(MRIGID,MTAB1,MTAB2,ICLE,MRIG1,MRIG2) if (ierr.ne.0) return IF (MRIG2.NE.0) CALL ECROBJ('RIGIDITE',MRIG2) c -calcul de Psi^T * RELA * Psi (ou Psi = base deformees statiques) elseif (motyp1.eq.'LIAISONS_STATIQUES') then call probas(MRIGID,MTAB1,MRIG1) if (ierr.ne.0) return call proba2(MTAB1,MRIG2) if (ierr.ne.0) return if (mrig2.gt.0.and.mrig1.gt.0) then call fusrig(mrig1,mrig2,mrig3) mrig1 = mrig3 mrig2 = 0 endif if (mrig2.gt.0) mrig1 = mrig2 if (mrig1.eq.0) then call ECRLOG(.false.) return endif else write(ioimp,*) 'Donnez une table de soustype BASE_MODALE ou', & ' LIAISONS_STATIQUES' call erreur(482) return endif CALL ECROBJ('RIGIDITE',MRIG1) RETURN c---- cas d'un CHPOINT ou d'un CHARGEMENT ------------------------------ 300 CONTINUE CALL LIROBJ('CHPOINT ',IP1,0,IRETOU) IF(IRETOU.EQ.1)CALL ACTOBJ('CHPOINT ',IP1,1) CHAR = IRETOU.EQ.0 IF (CHAR) THEN CALL LIROBJ('CHARGEME',IPCHAR,0,IRETOU) IF(IRETOU .EQ. 1) CALL ACTOBJ('CHARGEME',IPCHAR,1) IF (IERR.NE.0) RETURN ENDIF IF (IRETOU.EQ.0) GOTO 400 c -lecture des modes sous forme de BASEMODA ou de table BASE_MODALE IPSTA=0 CALL LIROBJ('BASEMODA',IP2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL LIRTAB('BASE_MODALE',ITBAS,1,IRETOU) IF(IERR.NE.0) RETURN CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IP2) TABL = .TRUE. c lecture facultative d une 2eme table de liaisons statiques CALL LIRTAB('LIAISONS_STATIQUES',IPSTA,0,IRETOU) ELSE MBASEM=IP2 SEGACT MBASEM NBAS=LISBAS(/1) IP4=1 IF(NBAS.EQ.1) GOTO 5 * BASE COMPLEXE CALL LIROBJ('STRUCTUR',IRET,1,IRETOU) IF(IERR.NE.0) GOTO 4000 MSTRUC=IRET SEGACT MSTRUC NSTRU=LISTRU(/1) MSOSTU=LISTRU(1) IP3=1 IF(NSTRU.EQ.1) GOTO 2 * STRUCTURE COMPLEXE CALL LIRENT(IP3,1,IRETOU) IF(IERR.NE.0) GOTO 3000 * ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES SEGACT MSOSTU ISRAI1=ISRAID SEGDES MSOSTU DO 1 NS=2,NSTRU MSOSTU=LISTRU(NS) SEGACT MSOSTU IF(ISRAI1.NE.ISRAID) GOTO 2000 SEGDES MSOSTU 1 CONTINUE IF(IP3.EQ.0.OR.IP3.GT.NSTRU) GOTO 4000 MSOSTU=LISTRU(IP3) 2 CONTINUE SEGDES MSTRUC * ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE DO 3 NB = 1,NBAS MSOBAS=LISBAS(NB) SEGACT MSOBAS IP4=NB IF(IBSTRM(1).EQ.MSOSTU) GOTO 4 SEGDES MSOBAS 3 CONTINUE * INCOHERENCE ENTRE LA BASE ET LA STRUCTURE GOTO 4000 4 CONTINUE SEGDES MSOBAS ENDIF c -fin du cas on a une base modale c -lecture du mot clé LIBR 5 CALL LIRMOT(LIBR,NLIBR,ILIBRE,0) c -cas d'un chargement IF (CHAR) THEN MCHAR1=IPCHAR SEGINI,MCHARG=MCHAR1 NBCHG=KCHARG(/1) DO 10 NC=1,NBCHG ICHAR1=KCHARG(NC) SEGINI,ICHARG=ICHAR1 KCHARG(NC)=ICHARG IP1=ICHPO1 *+* POUR L'INSTANT, ON NE DUPLIQUE PAS LES LISTREELS IF (TABL) THEN CALL ACTOBJ('CHPOINT ',IP1,1) CALL PROJTA(IP1,IP2,IPSTA,IRET) ELSE CALL PROJBA(IP1,IP2,IP4,IRET) ENDIF IF(IERR.NE.0) RETURN ICHPO1=IRET SEGDES,ICHARG 10 CONTINUE SEGDES,MCHARG CALL ECROBJ('CHARGEME',MCHARG) c -cas d'un chpoint ELSE IF (ILIBRE .EQ. 1) THEN C CAS GRANDS DEPLACEMENTS ; CHARGEMENT LIBRE CALL PJLIBR( IP1,IP2,IP4,IRET ) CALL ACTOBJ('LISTCHPO',IRET,1) CALL ECROBJ('LISTCHPO',IRET) ELSE IF (TABL) THEN CALL PROJTA(IP1,IP2,IPSTA,IRET) ELSE CALL PROJBA( IP1,IP2,IP4,IRET ) ENDIF IF(IRET.EQ.0) GO TO 5000 CALL ACTOBJ('CHPOINT ',IRET,1) CALL ECROBJ('CHPOINT ',IRET) ENDIF ENDIF GOTO 5000 2000 CONTINUE SEGDES MSOSTU 3000 CONTINUE SEGDES MSTRUC 4000 CALL ERREUR(216) SEGDES MBASEM 5000 CONTINUE RETURN c---- cas TABLE LIAISONS STATIQUES SEULE ------------------------------- 400 CONTINUE CALL LIRTAB('LIAISONS_STATIQUES',MTAB1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 9999 c on calcule les rigidites associees call proba2(MTAB1,MRIG1) if (ierr.ne.0) return if (mrig1.gt.0) then CALL ECROBJ('RIGIDITE',MRIG1) else call ECRLOG(.false.) endif RETURN c petit message d'erreur si on n'a pas lu un objet a projeter 9999 CONTINUE MOTERR(1:8)='RIGIDITE' MOTERR(9:16)='CHPOINT' MOTERR(17:24)='CHARGEME' MOTERR(25:32)='TABLE' MOTERR(33:40)='LISTCHPO' call erreur(471) END