1 : C RECOBAL SOURCE BP208322 13/07/25 21:15:06 7804 2 : C RECOMB SOURCE GORC 95/08/03 21:15:14 1766 3 : SUBROUTINE RECOBAL (IPBASR, MCHPO1, MCHPO2, MCHPO4) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : * 7 : ***************************************************************************** 8 : * RECOMBINAISON MODALE DE LA REPONSE BALOURD (CHPOINT) A PARTIR * 9 : * DES DEFORMEES MODALES DE LA BASE REELLE * 10 : * _________________________________________________________________________ * 11 : * * 12 : * CREATION : le 14 Mars 1996 * 13 : * DERNIERE MODIF. : 19/11/96 * 14 : * AUTEUR : Jerome CHARPENTIER * 15 : * MODIF : BP 07/2013, on ne met pas à 0 lorsque la valeur est <1.E-10 !* 16 : * _________________________________________________________________________ * 17 : * * 18 : * MODULE(S) APPELANT(S) : VIBRAC * 19 : * * 20 : * MODULE(S) APPELE(S) : ACCTAB, CRTABL, ECCTAB, EXTRA9, EXTR11 * 21 : * _________________________________________________________________________ * 22 : * * 23 : * EN ENTREE : * 24 : * - IPBASR : BASE DES MODES REELS PHYSIQUES * 25 : * - MCHPO1 : CHPOINT DE LA REPONSE EN DEPLACEMENT MODAUX * 26 : * DIMENSION 2N -> LES N PREMIERES COMPOSANTES * 27 : * CORRESPONDENT AUX POINTS REPERES DE LA BASE * 28 : * PHYSIQUE (REELLE) * 29 : * _________________________________________________________________________ * 30 : * * 31 : * EN SORTIE : * 32 : * - MCHPO2 : CHPOINT DE LA REPONSE EN DEPLACEMENT DANS LA BASE * 33 : * PHYSIQUE (PARTIE REELLE) * 34 : * - MCHPO4 : CHPOINT DE LA REPONSE EN DEPLACEMENT DANS LA BASE * 35 : * PHYSIQUE (PARTIE IMAGINAIRE) * 36 : ***************************************************************************** 37 : * 38 : -INC CCOPTIO 39 : -INC SMCHPOI 40 : -INC SMCOORD 41 : -INC SMELEME 42 : -INC SMLMOTS 43 : -INC SMTABLE 44 : * 45 : 46 : REAL*8 XVAL1S, XVAL1C, XVAL3, VAL21, VAL41 47 : INTEGER I, J, K, NBNOEU, NBCOMP, NBMODR, PT1S, PT1C, PT3 48 : LOGICAL AFFICH 49 : CHARACTER*4 MOT1, MOT3 50 : REAL*8 XVALRE 51 : LOGICAL LOGRE 52 : CHARACTER*(8) CHARRE 53 : * 54 : POINTEUR IPBASR2.MTABLE, IPBASR3.MTABLE 55 : * 56 : *---- Affichage des messages pour verification 57 : AFFICH = .FALSE. 58 : * 59 : *---- Lecture de la base reelle IPBASR2 = TBasR.MODES 60 : IF (AFFICH) WRITE (*,*) 'Lecture des donnees ...' 60 : CALL ACCTAB(IPBASR,'MOT',0,0.0D0,'MODES',.TRUE.,0, 61 : & 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IPBASR2) 62 : * 63 : ******************************************* 64 : *---- Initialisation des donnees 65 : ******************************************* 66 : * 67 : * --- Nombre de modes reels = NBMODR 68 : SEGACT, IPBASR2 69 : NBMODR = IPBASR2.MLOTAB-2 70 : SEGDES, IPBASR2 71 : * 72 : * --- Nbre de SOUPO dans les deformee modale de la base reelle 72 : CALL ACCTAB(IPBASR2,'ENTIER',1,0.0D0,' ',.TRUE.,0, 73 : & 'TABLE ',IVALRE,XVALRE,CHARRE,LOGRE,IPBASR3) 73 : CALL ACCTAB(IPBASR3,'MOT',0,0.0D0,'DEFORMEE_MODALE',.TRUE., 74 : & 0,'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPO3) 75 : SEGACT, MCHPO3 76 : NSOUPO = MCHPO3.IPCHP(/1) 77 : SEGDES, MCHPO3 78 : IF (AFFICH) WRITE (*,*) 'NSOUPO=', NSOUPO 79 : * 80 : * --- Nbre de pts dans la reponse modale 81 : SEGACT, MCHPO1 82 : MSOUP1 = MCHPO1.IPCHP(1) 83 : SEGDES, MCHPO1 84 : SEGACT, MSOUP1 85 : IPT1 = MSOUP1.IGEOC 86 : SEGDES, MSOUP1 87 : * 88 : SEGACT, IPT1 89 : NBP1 = IPT1.NUM(/2) 90 : SEGDES, IPT1 91 : IF (AFFICH) WRITE (6,*) 'NBMODR=', NBMODR 92 : * 93 : IF ((2*NBMODR) .NE. NBP1) RETURN 94 : SEGINI, MCHPO2=MCHPO3 95 : SEGDES, MCHPO2 96 : SEGINI, MCHPO4=MCHPO3 97 : SEGDES, MCHPO4 98 : * 99 : ********************************************************* 100 : *---- Boucle sur les SOUPO des deformees de la BasR 101 : ********************************************************* 102 : DO 10, J=1, NSOUPO 103 : IF (AFFICH) WRITE (*,*) 'Boucle sur Soupos ...', J 104 : * 104 : CALL ACCTAB(IPBASR2,'ENTIER',1,0.0D0,' ',.TRUE.,0, 105 : & 'TABLE ',IVALRE,XVALRE,CHARRE,LOGRE,IPBASR3) 105 : CALL ACCTAB(IPBASR3,'MOT',0,0.0D0,'DEFORMEE_MODALE',.TRUE., 106 : & 0,'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPO3) 107 : * 108 : *-------- Creation des SOUPOs resultat pour les rep. reelle & imag. 109 : SEGACT, MCHPO3 110 : MSOUP3 = MCHPO3.IPCHP(J) 111 : SEGDES, MCHPO3 112 : SEGINI, MSOUP2=MSOUP3 113 : SEGDES, MSOUP2 114 : SEGINI, MSOUP4=MSOUP3 115 : SEGDES, MSOUP4 116 : * 117 : * --- Nbre de Noeuds et de composantes dans le SOUPO 118 : SEGACT, MSOUP3 119 : MPOVA3 = MSOUP3.IPOVAL 120 : IPT3 = MSOUP3.IGEOC 121 : SEGDES, MSOUP3 122 : SEGACT, MPOVA3 123 : NBNOEU = MPOVA3.VPOCHA(/1) 124 : NBCOMP = MPOVA3.VPOCHA(/2) 125 : SEGDES, MPOVA3 126 : IF (AFFICH) WRITE (*,*) 'NBNOEU=', NBNOEU 127 : IF (AFFICH) WRITE (*,*) 'NBCOMP=', NBCOMP 128 : * 129 : * --- Noms des composantes du SOUPO 130 : SEGACT, MSOUP3 131 : JGN=4 132 : JGM=NBCOMP 133 : SEGINI, MLMOT3 134 : DO 60, K=1, NBCOMP 135 : MLMOT3.MOTS(K)=MSOUP3.NOCOMP(K) 136 : 60 CONTINUE 137 : SEGDES, MLMOT3 138 : SEGDES, MSOUP3 139 : * 140 : * --- Initialisation des MPOVAs pour des reponses 141 : SEGACT, MPOVA3 142 : SEGINI, MPOVA2=MPOVA3 143 : SEGDES, MPOVA2 144 : SEGINI, MPOVA4=MPOVA3 145 : SEGDES, MPOVA4 146 : SEGDES, MPOVA3 147 : DO 50, ICOMP = 1, NBCOMP 148 : SEGACT, MLMOT3 149 : MOT3 = MLMOT3.MOTS(ICOMP) 150 : SEGDES, MLMOT3 151 : DO 50, INOEUD = 1, NBNOEU 152 : SEGACT, MPOVA2*MOD 153 : MPOVA2.VPOCHA(INOEUD,ICOMP)=0 154 : SEGDES, MPOVA2 155 : SEGACT, MPOVA4*MOD 156 : MPOVA4.VPOCHA(INOEUD,ICOMP)=0 157 : SEGDES, MPOVA4 158 : 50 CONTINUE 159 : * 160 : *---- Boucle sur les depl. modaux de la reponse Qi 161 : ********************************************************* 162 : * 163 : DO 20, I=1, NBMODR 164 : IF (AFFICH) WRITE (*,*) 'Boucle sur les Qi ...', I 165 : * 166 : * --- Recup. des valeurs de la reponse modale Qi 167 : SEGACT, IPT1 168 : PT1S = IPT1.NUM(1,I+NBMODR) 169 : PT1C = IPT1.NUM(1,I) 170 : SEGDES, IPT1 170 : CALL EXTR11(MCHPO1,MLMOT1) 171 : SEGACT, MLMOT1 172 : MOT1 = MLMOT1.MOTS(1) 173 : SEGDES, MLMOT1 173 : CALL EXTRA9(MCHPO1,PT1S,MOT1,KERRE,XVAL1S) 173 : CALL EXTRA9(MCHPO1,PT1C,MOT1,KERRE,XVAL1C) 174 : IF (AFFICH) WRITE (*,*) 'COMP=', MOT1 175 : IF (AFFICH) WRITE (*,*) 'PT1S=', PT1S, XVAL1S 176 : IF (AFFICH) WRITE (*,*) 'PT1C=', PT1C, XVAL1C 177 : * 178 : *-------- Recherche du mode reel correspondant a Qi 179 : L=1 179 : 30 CALL ACCTAB(IPBASR2,'ENTIER',L,0.0D0,' ',.TRUE., 180 : & 0,'TABLE ',IVALRE,XVALRE,CHARRE,LOGRE,IPBASR3) 180 : CALL ACCTAB(IPBASR3,'MOT',0,0.0D0,'POINT_REPERE',.TRUE., 181 : & 0,'POINT',IVALRE,XVALRE,CHARRE,LOGRE,PT3) 182 : IF ((PT1S .NE. PT3) .AND. (PT1C .NE. PT3)) THEN 183 : L=L+1 184 : IF (L .LE. NBMODR) GOTO 30 185 : ELSE 186 : * 187 : *-------- Calcul de la reponse reelle 188 : IF (AFFICH) WRITE (*,*) 'Prise en compte du MODE ...', L, PT3 188 : CALL ACCTAB(IPBASR3,'MOT',0,0.0D0,'DEFORMEE_MODALE', 189 : & .TRUE.,0,'CHPOINT',IVALRE,XVALRE,CHARRE,LOGRE,MCHPO3) 190 : * 191 : IF (AFFICH) WRITE (*,*) 'Deformee modale=', MCHPO3 192 : * 193 : DO 40, ICOMP = 1, NBCOMP 194 : SEGACT, MLMOT3 195 : MOT3 = MLMOT3.MOTS(ICOMP) 196 : SEGDES, MLMOT3 197 : IF (AFFICH) WRITE (*,*) 'COMP=', MOT3 198 : DO 40, INOEUD = 1, NBNOEU 199 : SEGACT, IPT3 200 : PT3 = IPT3.NUM(1,INOEUD) 201 : SEGDES, IPT3 202 : IF (AFFICH) WRITE (*,*) 'P3=', PT3 202 : CALL EXTRA9(MCHPO3,PT3,MOT3,KERRE,XVAL3) 203 : IF (AFFICH) WRITE (*,*) 'XVAL3=', XVAL3 204 : SEGACT, MPOVA2*MOD 205 : VAL21=MPOVA2.VPOCHA(INOEUD,ICOMP) 206 : IF (AFFICH) WRITE (*,*) 'VPOCH2=', VAL21 207 : MPOVA2.VPOCHA(INOEUD,ICOMP)= 208 : & MPOVA2.VPOCHA(INOEUD,ICOMP)+XVAL3*XVAL1S 209 : VAL21=MPOVA2.VPOCHA(INOEUD,ICOMP) 210 : IF (AFFICH) WRITE (*,*) 'VPOCH2=', VAL21 211 : SEGDES, MPOVA2 212 : SEGACT, MPOVA4*MOD 213 : MPOVA4.VPOCHA(INOEUD,ICOMP)= 214 : & MPOVA4.VPOCHA(INOEUD,ICOMP)+XVAL3*XVAL1C 215 : VAL41=MPOVA4.VPOCHA(INOEUD,ICOMP) 216 : IF (AFFICH) WRITE (*,*) 'VPOCH4=', VAL41 217 : SEGDES, MPOVA4 218 : 40 CONTINUE 219 : ENDIF 220 : * 221 : 20 CONTINUE 222 : ********************************************************* 223 : *---- Fin Boucle sur les depl. modaux de la reponse Qi 224 : * 225 : c bp 226 : GOTO 71 227 : * --- Mise a zero des valeurs inferieures a 1e-10 228 : DO 70, ICOMP = 1, NBCOMP 229 : SEGACT, MLMOT3 230 : MOT3 = MLMOT3.MOTS(ICOMP) 231 : SEGDES, MLMOT3 232 : DO 70, INOEUD = 1, NBNOEU 233 : SEGACT, IPT3 234 : PT3 = IPT3.NUM(1,INOEUD) 235 : SEGDES, IPT3 235 : CALL EXTRA9(MCHPO3,PT3,MOT3,KERRE,XVAL3) 236 : SEGACT, MPOVA2*MOD 237 : VAL21=ABS(MPOVA2.VPOCHA(INOEUD,ICOMP)) 238 : IF (VAL21 .LE. 1E-10) MPOVA2.VPOCHA(INOEUD,ICOMP)=0 239 : SEGDES, MPOVA2 240 : SEGACT, MPOVA4*MOD 241 : VAL41=ABS(MPOVA4.VPOCHA(INOEUD,ICOMP)) 242 : IF (VAL41 .LE. 1E-10) MPOVA4.VPOCHA(INOEUD,ICOMP)=0 243 : SEGDES, MPOVA4 244 : 70 CONTINUE 245 : 71 CONTINUE 246 : * 247 : *------ enregistrement du SOUPO 248 : SEGACT, MSOUP2*MOD 249 : MSOUP2.IPOVAL=MPOVA2 250 : SEGDES, MSOUP2 251 : SEGACT, MSOUP4*MOD 252 : MSOUP4.IPOVAL=MPOVA4 253 : SEGDES, MSOUP4 254 : SEGACT, MCHPO2*MOD 255 : MCHPO2.IPCHP(J)=MSOUP2 256 : SEGDES, MCHPO2 257 : SEGACT, MCHPO4*MOD 258 : MCHPO4.IPCHP(J)=MSOUP4 259 : SEGDES, MCHPO4 260 : * 261 : 10 CONTINUE 262 : *---- Fin Boucle sur les SOUPO des deformees de la BasR 263 : ********************************************************* 264 : * 265 : RETURN 266 : END 267 : * 268 : 269 : 270 : 271 : 272 : 273 : 274 : 275 :
© Cast3M 2003 - All rights reserved.
Disclaimer