1 : C RECOMB SOURCE FANDEUR 10/12/14 21:19:14 6812 2 : SUBROUTINE RECOMB 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *_______________________________________________________________________ 6 : * 7 : * OPERATEUR RECO : 8 : * RECOMBINAISON EN ANALYSE MODALE. 9 : * SYNTAXE: 10 : * ======= 11 : * ******** B EST UNE BASE ELEMENTAIRE 12 : * ---------------- 13 : * X1 = RECO XA B DEPL; 14 : * X2 = RECO XA B CONT; 15 : * 16 : * ******** B EST UNE BASE COMPLEXE: STR1 EST LA STRUCTURE 17 : * ------------- POUR LAQUELLE LA 18 : * RECOMBINAISON S'EFFECTUE, ET N LE NUMERO DE 19 : * LA SOUS-STRUCTURE SI CELLE CI EST FORMEE DE 20 : * SOUS-STRUCTURES IDENTIQUES. 21 : * X1 = RECO XA B STR1 (N) DEPL ; 22 : * X2 = RECO XA B STR1 (N) CONT ; 23 : * 24 : * XA : OBJET CHPOINT CONTENANT LES CONTRIBUTIONS MODALES 25 : * DEPL : ON RECOMBINE DES DEPLACEMENTS. X1 EST UN CHPOINT 26 : * CONT : ON RECOMBINE DES CONTRAINTES . X2 EST UN CHELEM 27 : * 28 : * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 02/91 29 : * 30 : *_______________________________________________________________________ 31 : * 32 : -INC CCOPTIO 33 : -INC CCREEL 34 : -INC SMBASEM 35 : -INC SMCHPOI 36 : -INC SMLCHPO 37 : -INC SMLREEL 38 : -INC SMSOLUT 39 : -INC SMSTRUC 40 : LOGICAL L0,L1 41 : PARAMETER ( LMOOPT = 5 , IUN = 1 ) 42 : CHARACTER*4 MOOPT(LMOOPT) 43 : CHARACTER*(8) ITYPE,CTYP 44 : DATA MOOPT/'DEPL','CONT','VITE','ACCE','REAC'/ 45 : * 45 : CALL LIRTAB('LIAISONS_STATIQUES',itst,0,iretst) 46 : if (iretst.ne.0) then 46 : CALL LIRTAB('BASE_MODALE',itbm,0,iretbm) 47 : if (ierr.ne.0) return 48 : if (iretst.ne.0.or.iretbm.ne.0) then 48 : call lirobj('CHPOINT ',ichp1,0,iret) 49 : if (iret.ne.0) then 49 : call recof1(itst,itbm,ichp1,ipout) 50 : if (ierr.ne.0) return 50 : call ecrobj('CHPOINT ',ipout) 51 : return 52 : endif 53 : endif 54 : endif 55 : 55 : CALL LIROBJ('MMODEL',IPMODL,0,IRET) 56 : IF (IRET.NE.0) THEN 56 : CALL LIROBJ('MCHAML',IPCHA1,1,IRET1) 57 : if (ierr.ne.0) return 58 : if (iret1.ne.0) then 58 : call lirobj('CHPOINT ',ichp1,0,iret) 59 : if (ierr.ne.0) return 60 : if (ichp1.eq.0) then 60 : CALL LIRTAB('PASAPAS',ITRES,1,IRET) 61 : if (ierr.ne.0) return 61 : CALL LIRMOT(MOOPT,LMOOPT,IMOO,1) 62 : IF(IERR.NE.0) RETURN 62 : call repec2(itres,imoo,ichp1) 63 : if (ierr.ne.0) return 64 : endif 64 : call recof2(ipmodl,ipcha1,ichp1,ipout) 65 : if (ierr.ne.0) return 65 : call ecrobj('CHPOINT ',ipout) 66 : return 67 : endif 68 : ENDIF 69 : 69 : CALL LIRMOT(MOOPT,LMOOPT,IMOO,1) 70 : IF(IERR.NE.0) RETURN 71 : KPSMO = 0 72 : KCHAR = 0 73 : KCHLIA = 0 74 : ITLIA = 0 75 : XTEMP = 0.D0 76 : * 76 : CALL QUETYP(CTYP,1,IRETOU) 77 : * 78 : IF (CTYP(1:8).EQ.'TABLE ') THEN 78 : CALL LIRTAB('RESULTAT_DYNE',ITRES,1,IRET) 79 : IF (IERR.NE.0) RETURN 79 : CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET) 80 : IF (IRET.EQ.0) THEN 80 : CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,1,IRET) 81 : ENDIF 82 : IF (IERR.NE.0) RETURN 82 : CALL LIRREE(XTEMP,1,IRET) 83 : IF (IERR.NE.0) RETURN 84 : XMPE = -XPETIT 85 : IF (XTEMP.LT.XMPE) THEN 85 : CALL ERREUR(431) 86 : RETURN 87 : ENDIF 87 : CALL LIROBJ('CHARGEME',KCHAR,0,IRET) 87 : CALL LIRTAB('LIAISON',ITLIA,0,IRET) 88 : * 89 : * R{cup{ration du CHPOINT @ l'instant XTEMP 90 : * 90 : CALL ACCTAB(ITRES,'MOT',I0,X0,'TEMPS_DE_SORTIE',L0,IP0, 91 : & 'LISTREEL',I1,X1,' ',L1,LBO) 92 : MLREEL = LBO 93 : SEGACT MLREEL 94 : LTE = PROG(/1) 95 : PRECI = (PROG(LTE) - PROG(1)) / (LTE * 100) 95 : CALL PLACE3(PROG,IUN,LTE,XTEMP,IR,AR) 96 : IF (AR.LE.PRECI) THEN 97 : IPOS = IR 98 : ELSE 99 : ARR = ABS(1. - AR) 100 : IF (ARR.LE.PRECI) THEN 101 : IPOS = IR + 1 102 : ELSE 103 : MOTERR(1:8) = 'TABLE ' 104 : MOTERR(9:16) ='LISTREEL' 104 : CALL ERREUR(135) 105 : SEGDES MLREEL 106 : RETURN 107 : ENDIF 108 : ENDIF 109 : SEGDES MLREEL 110 : * 110 : CALL ACCTAB(ITRES,'ENTIER',IPOS,X0,' ',L0,IP0, 111 : & 'TABLE',I1,X1,' ',L1,ITDEP) 112 : IF (MOOPT(IMOO).EQ.'DEPL') THEN 112 : CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, 113 : & 'CHPOINT',I1,X1,' ',L1,ICHPT) 113 : CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,0) 114 : ELSE IF (MOOPT(IMOO).EQ.'VITE') THEN 114 : CALL ACCTAB(ITDEP,'MOT',I0,X0,'VITESSE',L0,IP0, 115 : & 'CHPOINT',I1,X1,' ',L1,ICHPT) 115 : CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,1) 116 : ELSE IF (MOOPT(IMOO).EQ.'ACCE') THEN 116 : CALL ACCTAB(ITDEP,'MOT',I0,X0,'ACCELERATION',L0,IP0, 117 : & 'CHPOINT',I1,X1,' ',L1,ICHPT) 117 : CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,-1) 118 : ELSE IF (MOOPT(IMOO).EQ.'REAC') THEN 118 : CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, 119 : & 'CHPOINT',I1,X1,' ',L1,ICHPT) 119 : CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,2) 120 : ELSE 120 : CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0, 121 : & 'CHPOINT',I1,X1,' ',L1,ICHPT) 121 : CALL RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA) 122 : ENDIF 123 : RETURN 124 : ENDIF 125 : *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+* 126 : * version appel{e @ disparaitre 127 : *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+* 127 : CALL LIROBJ('CHPOINT ',ICH1,1,IRETOU) 128 : IF(IERR.NE.0) RETURN 128 : CALL LIRREE(XTEMP,0,IRETOU) 129 : IF (IRETOU.EQ.1) THEN 130 : KPSMO = 1 130 : CALL LIROBJ('CHPOINT ',KCHLIA,0,IRETOU) 130 : CALL LIROBJ('CHARGEME',KCHAR,0,IRETOU) 131 : ENDIF 131 : CALL LIROBJ ('BASEMODA',IP2,1,IRETOU) 132 : IF(IERR.NE.0) RETURN 133 : C 134 : C **** ON VERIFIE QUE LE CHPOINT CONTIENT LES CONTRIBUTIONS MODALES 135 : C 136 : MCHPOI = ICH1 137 : SEGACT MCHPOI 138 : NSOUPO = IPCHP(/1) 139 : DO 1 ISOU = 1,NSOUPO 140 : MSOUPO = IPCHP(ISOU) 141 : SEGACT MSOUPO 142 : IF (NOCOMP(/2).NE.1) THEN 143 : C ON CHERCHE UN CHPOINT QUI CONTIENT DES CONTIBUTIONS MODALES 143 : CALL ERREUR(188) 144 : RETURN 145 : ENDIF 146 : IF (NOCOMP(1).NE.'ALFA') THEN 147 : C ON CHERCHE ........ 147 : CALL ERREUR(188) 148 : SEGDES MSOUPO 149 : RETURN 150 : ENDIF 151 : SEGDES MSOUPO 152 : 1 CONTINUE 153 : SEGDES MCHPOI 154 : * 155 : MBASEM = IP2 156 : SEGACT MBASEM 157 : NBAS = LISBAS(/1) 158 : IP4 = 1 159 : IF (NBAS.NE.1) THEN 160 : C BASE COMPLEXE 160 : CALL LIROBJ('STRUCTUR',IRET,1,IRETOU) 161 : IF( IERR.NE.0 ) RETURN 162 : MSTRUC = IRET 163 : SEGACT MSTRUC 164 : NSTRU = LISTRU(/1) 165 : MSOSTU = LISTRU(1) 166 : IP3 = 1 167 : IF (NSTRU.NE.1) THEN 168 : C STRUCTURE COMPLEXE 168 : CALL LIRENT(IP3,1,IRETOU) 169 : IF (IERR.NE.0) RETURN 170 : C ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES 171 : SEGACT MSOSTU 172 : ISRAI1 = ISRAID 173 : SEGDES MSOSTU 174 : DO 14 NS = 2,NSTRU 175 : MSOSTU = LISTRU(NS) 176 : SEGACT MSOSTU 177 : IF (ISRAI1.NE.ISRAID) RETURN 178 : SEGDES MSOSTU 179 : 14 CONTINUE 180 : IF (IP3.EQ.0 .OR. IP3.GT.NSTRU) THEN 180 : CALL ERREUR(216) 181 : RETURN 182 : ENDIF 183 : MSOSTU = LISTRU(IP3) 184 : ENDIF 185 : SEGDES MSTRUC 186 : C ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE 187 : DO 16 NB = 1,NBAS 188 : MSOBAS = LISBAS(NB) 189 : SEGACT MSOBAS 190 : IP4 = NB 191 : IF (IBSTRM(1).EQ.MSOSTU) GOTO 17 192 : SEGDES MSOBAS 193 : 16 CONTINUE 194 : C *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE 194 : CALL ERREUR(216) 195 : RETURN 196 : 17 CONTINUE 197 : ENDIF 198 : MSOBAS = LISBAS(IP4) 199 : SEGDES MBASEM 200 : SEGACT MSOBAS 201 : IBMODE = IBSTRM(2) 202 : IBSOLS = IBSTRM(3) 203 : IBPSMO = IBSTRM(5) 204 : IRET = 0 205 : IRET1 = 0 206 : IRET2 = 0 207 : * 208 : IF (IMOO.EQ.2) THEN 209 : * 210 : * RECOMBINAISON DE CONTRAINTES 211 : * 212 : READ (MOOPT(2),FMT='(A4)') MOCON 213 : IF (IBMODE.NE.0) THEN 214 : MSOLUT = IBMODE 215 : SEGACT MSOLUT 216 : KMEL1 = MSOLIS(3) 217 : KCON = MSOLIS(6) 218 : SEGDES MSOLUT 219 : IF (KCON.EQ.0) THEN 220 : MOTERR(1:8) = ITYSOL 220 : CALL ERREUR(61) 221 : RETURN 222 : ENDIF 222 : CALL RCOSIG(ICH1,KCON,KMEL1,IRET1) 223 : IF( IERR.NE.0 ) RETURN 224 : IF (IBSOLS.EQ.0) IRET = IRET1 225 : ENDIF 226 : IF (IBSOLS.NE.0) THEN 227 : MSOLUT = IBSOLS 228 : SEGACT MSOLUT 229 : KMEL1 = MSOLIS(3) 230 : KCON = MSOLIS(6) 231 : SEGDES MSOLUT 232 : IF (KCON.EQ.0) THEN 233 : MOTERR(1:8) = ITYSOL 233 : CALL ERREUR(61) 234 : RETURN 235 : ENDIF 235 : CALL RCOSIG(ICH1,KCON,KMEL1,IRET2) 236 : IF( IERR.NE.0 ) RETURN 237 : IF (IRET1.NE.0) THEN 238 : ICONV=0 238 : CALL ADCHEL(IRET1,IRET2,IRET,IUN) 239 : ELSE 240 : IRET = IRET2 241 : ENDIF 242 : ENDIF 243 : IF (IRET.EQ.0) RETURN 244 : ITYPE = 'CHAMELEM' 245 : ELSE 246 : * 247 : * RECOMBINAISON DE DEPLACEMENTS 248 : * 249 : READ (MOOPT(1),FMT='(A4)') MODEPL 250 : IF (IBMODE.NE.0) THEN 251 : MSOLUT = IBMODE 252 : SEGACT MSOLUT 253 : KDEPL = MSOLIS(5) 254 : KMEL1 = MSOLIS(3) 255 : SEGDES MSOLUT 256 : IF (KDEPL.EQ.0) THEN 257 : MOTERR(1:8) = ITYSOL 257 : CALL ERREUR(61) 258 : RETURN 259 : ENDIF 259 : CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1) 260 : IF (IERR.NE.0) RETURN 261 : IF (IBSOLS.EQ.0) IRET = IRET1 262 : ENDIF 263 : IF (IBSOLS.NE.0) THEN 264 : MSOLUT = IBSOLS 265 : SEGACT MSOLUT 266 : KDEPL = MSOLIS(5) 267 : KMEL1 = MSOLIS(3) 268 : SEGDES MSOLUT 269 : IF (KDEPL.EQ.0) THEN 270 : MOTERR(1:8) = ITYSOL 270 : CALL ERREUR(61) 271 : RETURN 272 : ENDIF 272 : CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2) 273 : IF (IERR.NE.0) RETURN 274 : IF (IRET1.NE.0) THEN 274 : CALL ADCHPO(IRET1,IRET2,IRET,1D0,1D0) 275 : IF( IERR.NE.0 ) RETURN 276 : ELSE 277 : IRET = IRET2 278 : ENDIF 279 : ENDIF 280 : IF (IRET.EQ.0) RETURN 281 : ITYPE = 'CHPOINT ' 282 : ENDIF 283 : * 284 : * PRIS EN COMPTE DES PSEUDO-MODES 285 : * 286 : IF (KPSMO.NE.0) THEN 286 : CALL PSRECO(IBMODE,IBPSMO,MOOPT(IMOO),KCHAR,KCHLIA,XTEMP,IRET) 287 : ENDIF 288 : * 289 : SEGDES MSOBAS 290 : 290 : CALL ECROBJ (ITYPE,IRET) 291 : * 292 : RETURN 293 : END 294 : 295 :
© Cast3M 2003 - All rights reserved.
Disclaimer