1 : C PJBA SOURCE BP208322 13/10/10 21:15:06 7837 2 : SUBROUTINE PJBA 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C OPERATEUR PJBA : 7 : C PROJECTION D'UN CHPOINT, D'UN CHARGEMENT OU D'UNE RIGIDITE 8 : C SUR LES ELEMENTS D'UNE BASE MODALE B. 9 : C LE RESULTAT EST DU MEME TYPE. 10 : C 11 : C SYNTAXE : 12 : C * FN = PJBA B OBJET ; SI BASE ELEMENTAIRE 13 : C * FN = PJBA B STR1 (N) OBJET ; SI BASE COMPLEXE 14 : C 15 : C OBJET POUVANT ETRE UNE FORCE OU UN CHARGEMENT, 16 : C OU UNE RIGIDITE DANS LE PREMIER CAS. 17 : C 18 : C STR1 EST LA SOUS-STRUCTURE OU S'APPLIQUE L'OBJET. 19 : C N EST LE NUMERO DE LA SOUS-STRUCTURE SI CELLE-CI EST 20 : C FORMEE DE SOUS-STRUCTURES IDENTIQUES . 21 : C 22 : C 23 : C CAS PARTICULIER DES GRANDS DEPLACEMENTS SUR BASE TOURNANTE : 24 : C ---------------------------------------------------------- 25 : C 26 : C SI LA FORCE N'EST PAS LIEE A LA BASE ( EX : LA PESANTEUR ) 27 : C IL FAUT SPECIFIER LE MOT-CLEF ......... LIBR 28 : C ALORS FN EST UN OBJET LISTCHPO CONTENANT LES VECTEURS DE 29 : C DECOMPOSITION DE LA FORCE GENERALISEE F 30 : C 31 : C======================================================================= 32 : -INC SMBASEM 33 : -INC SMCHPOI 34 : -INC SMCHARG 35 : -INC SMLCHPO 36 : -INC SMSOLUT 37 : -INC SMSTRUC 38 : -INC CCOPTIO 39 : C 40 : LOGICAL L0,L1,CHAR,TABL 41 : CHARACTER*4 LIBR(1),CLE(1) 42 : CHARACTER*72 lemot 43 : DATA CLE(1)/'REEL'/ 44 : DATA LIBR(1) /'LIBR'/ 45 : NLIBR = 1 46 : TABL = .FALSE. 47 : C 47 : call lirobj('MMODEL ',IPMODE,0,iretou) 48 : if (iretou.ne.0) then 48 : call pjmode(ipmode) 49 : return 50 : endif 51 : 51 : CALL LIROBJ('RIGIDITE',MRIGID,0,IRETOU) 52 : IF (IERR.NE.0) RETURN 53 : 54 : C---- Cas d'une rigidite ----------------------------------------------- 55 : IF (IRETOU.NE.0) THEN 56 : 56 : CALL LIROBJ('TABLE ',MTAB1,1,IRETOU) 57 : IF (IERR.NE.0) RETURN 57 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0, 58 : & 'MOT',IP,RR,lemot,.TRUE.,IQ) 59 : if (lemot.eq.'BASE_MODALE') then 59 : CALL LIRMOT(CLE,1,ICLE,0) 59 : CALL PROJRG(MRIGID,MTAB1,ICLE,MRIG1,MRIG2) 60 : if (ierr.ne.0) return 60 : IF (MRIG2.NE.0) CALL ECROBJ('RIGIDITE',MRIG2) 61 : elseif (lemot.eq.'LIAISONS_STATIQUES') then 61 : call probas(MRIGID,MTAB1,MRIG1) 62 : if (ierr.ne.0) return 62 : call proba2(MTAB1,MRIG2) 63 : if (ierr.ne.0) return 64 : if (mrig2.gt.0.and.mrig1.gt.0) then 64 : call fusrig(mrig1,mrig2,mrig3) 65 : mrig1 = mrig3 66 : mrig2 = 0 67 : endif 68 : if (mrig2.gt.0) mrig1 = mrig2 69 : if (mrig1.eq.0) then 69 : call ECRLOG(.false.) 70 : return 71 : endif 72 : else 73 : write(ioimp,*) 'Donnez une table de soustype BASE_MODALE ou', 74 : & ' LIAISONS_STATIQUES' 74 : call erreur(482) 75 : endif 75 : CALL ECROBJ('RIGIDITE',MRIG1) 76 : 77 : C---- Autres cas ----------------------------------------------- 78 : ELSE 79 : 80 : c cas des liaisons statiques : on calcule les rigidites associees 80 : CALL LIRTAB('LIAISONS_STATIQUES',MTAB1,0,IRETOU) 81 : if (iretou.ne.0) then 81 : call proba2(MTAB1,MRIG1) 82 : if (ierr.ne.0) return 83 : if (mrig1.gt.0) then 83 : CALL ECROBJ('RIGIDITE',MRIG1) 84 : else 84 : call ECRLOG(.false.) 85 : endif 86 : endif 87 : 88 : c autres cas : chpoint ou chargement 88 : CALL LIROBJ('CHPOINT ',IP1,0,IRETOU) 89 : CHAR = IRETOU.EQ.0 90 : IF (CHAR) THEN 90 : CALL LIROBJ('CHARGEME',IPCHAR,1,IRETOU) 91 : IF (IERR.NE.0) RETURN 92 : ENDIF 93 : c lecture des modes sous forme de BASEMODA ou de table BASE_MODALE 93 : CALL LIROBJ('BASEMODA',IP2,0,IRETOU) 94 : IF (IRETOU.EQ.0) THEN 94 : CALL LIRTAB('BASE_MODALE',ITBAS,1,IRETOU) 95 : IF(IERR.NE.0) RETURN 95 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0, 96 : & 'TABLE',I1,X1,' ',L1,IP2) 97 : TABL = .TRUE. 98 : ELSE 99 : MBASEM=IP2 100 : SEGACT MBASEM 101 : NBAS=LISBAS(/1) 102 : IP4=1 103 : IF(NBAS.EQ.1) GOTO 5 104 : * BASE COMPLEXE 104 : CALL LIROBJ('STRUCTUR',IRET,1,IRETOU) 105 : IF(IERR.NE.0) GOTO 4000 106 : MSTRUC=IRET 107 : SEGACT MSTRUC 108 : NSTRU=LISTRU(/1) 109 : MSOSTU=LISTRU(1) 110 : IP3=1 111 : IF(NSTRU.EQ.1) GOTO 2 112 : * STRUCTURE COMPLEXE 112 : CALL LIRENT(IP3,1,IRETOU) 113 : IF(IERR.NE.0) GOTO 3000 114 : * ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES 115 : SEGACT MSOSTU 116 : ISRAI1=ISRAID 117 : SEGDES MSOSTU 118 : DO 1 NS=2,NSTRU 119 : MSOSTU=LISTRU(NS) 120 : SEGACT MSOSTU 121 : IF(ISRAI1.NE.ISRAID) GOTO 2000 122 : SEGDES MSOSTU 123 : 1 CONTINUE 124 : IF(IP3.EQ.0.OR.IP3.GT.NSTRU) GOTO 4000 125 : MSOSTU=LISTRU(IP3) 126 : 2 CONTINUE 127 : SEGDES MSTRUC 128 : * ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE 129 : DO 3 NB = 1,NBAS 130 : MSOBAS=LISBAS(NB) 131 : SEGACT MSOBAS 132 : IP4=NB 133 : IF(IBSTRM(1).EQ.MSOSTU) GOTO 4 134 : SEGDES MSOBAS 135 : 3 CONTINUE 136 : * INCOHERENCE ENTRE LA BASE ET LA STRUCTURE 137 : GOTO 4000 138 : 4 CONTINUE 139 : SEGDES MSOBAS 140 : ENDIF 141 : c lecture du mot clé LIBR 141 : 5 CALL LIRMOT(LIBR,NLIBR,ILIBRE,0) 142 : c cas d'un chargement 143 : IF (CHAR) THEN 144 : MCHAR1=IPCHAR 145 : SEGINI,MCHARG=MCHAR1 146 : NBCHG=KCHARG(/1) 147 : DO 10 NC=1,NBCHG 148 : ICHAR1=KCHARG(NC) 149 : SEGINI,ICHARG=ICHAR1 150 : KCHARG(NC)=ICHARG 151 : IP1=ICHPO1 152 : *+* POUR L'INSTANT, ON NE DUPLIQUE PAS LES LISTREELS 153 : IF (TABL) THEN 153 : CALL PROJTA(IP1,IP2,IRET) 154 : ELSE 154 : CALL PROJBA(IP1,IP2,IP4,IRET) 155 : ENDIF 156 : IF(IERR.NE.0) RETURN 157 : ICHPO1=IRET 158 : SEGDES,ICHARG 159 : 10 CONTINUE 160 : SEGDES,MCHARG 160 : CALL ECROBJ('CHARGEME',MCHARG) 161 : c cas d'un chpoint 162 : ELSE 163 : IF (ILIBRE .EQ. 1) THEN 164 : C CAS GRANDS DEPLACEMENTS ; CHARGEMENT LIBRE 164 : CALL PJLIBR( IP1,IP2,IP4,IRET ) 164 : CALL ECROBJ( 'LISTCHPO',IRET ) 165 : ELSE 166 : IF (TABL) THEN 166 : CALL PROJTA(IP1,IP2,IRET) 167 : ELSE 167 : CALL PROJBA( IP1,IP2,IP4,IRET ) 168 : ENDIF 169 : IF(IRET.EQ.0) GO TO 5000 169 : CALL ECROBJ( 'CHPOINT ',IRET ) 170 : ENDIF 171 : ENDIF 172 : GOTO 5000 173 : 2000 CONTINUE 174 : SEGDES MSOSTU 175 : 3000 CONTINUE 176 : SEGDES MSTRUC 176 : 4000 CALL ERREUR(216) 177 : SEGDES MBASEM 178 : 5000 CONTINUE 179 : * 180 : ENDIF 181 : * 182 : END 183 : 184 : 185 : 186 : 187 : 188 : 189 : 190 : 191 : 192 :
© Cast3M 2003 - All rights reserved.
Disclaimer