1 : C VECTE2 SOURCE CHAT 11/03/16 21:33:26 6902 2 : SUBROUTINE VECTE2(MCHA1,MCHA2,MOD1,AMP,CMOT,LMOT1,MVECT0) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *---------------------------------------------------------------* 6 : * Creation d'un MVECTE a partir d'un MCHAML en vue * 7 : * d'un trace avec des petites fleches * 8 : * * 9 : * MCHA1 MCHAML de CONTRAINTES PRINCIPALES * 10 : * MCHA2 MCHAML de CARACTERISTIQUES (coques epaisses) * 11 : * MOD1 MMODEL * 12 : * AMP coefficient d'amplification (FLOTTANT) * 13 : * CMOT composante a visualiser (MOT) * 14 : * LMOT1 liste des couleurs affectees aux composantes * 15 : * MVECT0 pointeur sur MVECTE resultat * 16 : * * 17 : * D. R.-M. mai & juin 1994 * 18 : *---------------------------------------------------------------* 19 : -INC CCOPTIO 20 : -INC CCGEOME 21 : -INC SMCHPOI 22 : -INC SMCHAML 23 : -INC SMMODEL 24 : -INC SMVECTE 25 : -INC SMELEME 26 : -INC SMINTE 27 : -INC SMCOORD 28 : -INC SMLMOTS 29 : * 30 : SEGMENT NOTYPE 31 : CHARACTER*16 TYPE(NBTYPE) 32 : ENDSEGMENT 33 : SEGMENT MPTVAL 34 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 35 : CHARACTER*16 TYVAL(NCOSOU) 36 : ENDSEGMENT 37 : SEGMENT INFO 38 : INTEGER INFELL(JG) 39 : ENDSEGMENT 40 : SEGMENT IPPO(NPPO) 41 : SEGMENT MWRK1 42 : REAL*8 XEL(3,NBN1) 43 : ENDSEGMENT 44 : SEGMENT MWRK2 45 : REAL*8 TXR(3,3,NBN1),TH(NBN1) 46 : ENDSEGMENT 47 : * 48 : PARAMETER (NINF = 3) 49 : INTEGER INFOS(NINF) 50 : DIMENSION XIGAU(3),MOCOMP(3) 51 : CHARACTER*(NCONCH) CONM 52 : CHARACTER*8 CMATE 53 : CHARACTER*4 CMOT 54 : * 55 : MVECT0 = 0 56 : SMAX = 0.D0 57 : * 58 : MCHELM = MCHA1 59 : SEGACT MCHELM 60 : * 61 : * Verification du support : noeuds ou pdi ? 62 : * 63 : ISUP = INFCHE(1,6) 64 : NSC = INFCHE(/1) 65 : DO 50 ISC=2,NSC 66 : ISUP1 = INFCHE(ISC,6) 67 : IF (ISUP1.NE.ISUP) ISUP = 0 68 : 50 CONTINUE 69 : * si ISUP = 1 : MCHAML aux noeuds 70 : * si ISUP = 5 : MCHAML aux pdi 71 : IF (ISUP.NE.1.AND.ISUP.NE.5) THEN 71 : call erreur(609) 72 : SEGDES MCHELM 73 : RETURN 74 : ENDIF 75 : SEGDES MCHELM 76 : * 77 : NMO = 0 78 : IF (LMOT1.NE.0) THEN 79 : MLMOTS = LMOT1 80 : SEGACT MLMOTS 81 : NMO = MOTS(/2) 82 : ENDIF 83 : * 84 : MMODEL = MOD1 85 : SEGACT MMODEL 86 : NSOUS = KMODEL(/1) 87 : * 88 : * Boucle sur les zones du MCHAML 89 : * 90 : DO 100 ISOU = 1,NSOUS 91 : IVACOM = 0 92 : IVAEP = 0 93 : IMODEL = KMODEL(ISOU) 94 : SEGACT IMODEL 95 : IPMAIL = IMAMOD 96 : CONM = CONMOD 97 : MELE = NEFMOD 98 : MELEME = IMAMOD 99 : NFOR = FORMOD(/2) 100 : NMAT = MATMOD(/2) 101 : * 101 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 102 : * 103 : if(infmod(/1).lt.7) then 103 : CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 104 : IF (IERR.NE.0) THEN 105 : SEGDES IMODEL,MMODEL 106 : RETURN 107 : ENDIF 108 : INFO = IPINF 109 : NBGS = INFELL(4) 110 : MFR = INFELL(13) 111 : MINTE = INFELL(11) 112 : MINTE1 = INFELL(12) 113 : segsup info 114 : else 115 : NBGS = INFELE(4) 116 : MFR = INFELE(13) 117 : MINTE=INFMOD(7) 118 : MINTE1 = INFMOD(8) 119 : endif 120 : * 121 : IPMINT = MINTE 122 : IF (MFR.EQ.5.AND.MCHA2.EQ.0) THEN 123 : MOTERR(1:16) = 'CARACTERISTIQUES' 123 : CALL ERREUR(565) 124 : SEGDES IMODEL,MMODEL 125 : RETURN 126 : ENDIF 127 : IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGACT MINTE1 128 : * 128 : CALL IDENT(IPMAIL,CONM,MCHA1,0,INFOS,IRET) 129 : IF (IRET.EQ.0) GOTO 900 130 : * 131 : SEGACT MINTE 132 : NBPGAU = POIGAU(/1) 133 : SEGACT MELEME 134 : NBN1 = NUM(/1) 135 : NBELE1 = NUM(/2) 136 : IF (ISUP.EQ.1) NIPO = NBN1 137 : IF (ISUP.EQ.5) NIPO = NBPGAU 138 : SEGINI MWRK1 139 : NPPO = NIPO * NBELE1 140 : IF (ISUP.EQ.5) SEGINI IPPO 141 : IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGINI MWRK2 142 : * 143 : * Listes de composantes attendues 144 : * 144 : CALL IDVEC2(IMODEL,1,IDIM,0,CMOT,MOCOMP,NCOMP, 145 : & NLIST,IER1) 146 : IF (IER1.NE.0) THEN 146 : IF (IER1.EQ.1) call erreur(19) 147 : IF (IER1.EQ.2) THEN 148 : moterr(1:4) = CMOT 148 : call erreur(197) 149 : ENDIF 150 : SEGDES IMODEL,MMODEL 151 : RETURN 152 : ENDIF 153 : * 154 : IF (NMO.NE.0) THEN 155 : IF ((CMOT.EQ.' '.AND.LMOT1.NE.0.AND.NLIST.NE.NMO).OR. 156 : & (CMOT.NE.' '.AND.NMO.NE.1)) GOTO 900 157 : ENDIF 158 : * 159 : IF (CMOT.EQ.' ') THEN 160 : NVEC = NLIST * 2 161 : ELSE 162 : NVEC = 2 163 : ENDIF 164 : ID = 1 165 : SEGINI MVECTE 166 : * 167 : * Boucle sur les composantes 168 : * 169 : DO 150 IC = 1,NLIST 170 : NOMID = MOCOMP(IC) 171 : SEGACT NOMID 172 : IF (CMOT.NE.' '.AND.LESOBL(1).NE.CMOT) GOTO 151 173 : IC2 = IC 174 : IF (CMOT.EQ.LESOBL(1)) IC2 = 1 175 : NOCOVE(IC2,1) = LESOBL(1) 176 : IF (LMOT1.EQ.0) THEN 177 : NOCOUL(IC2) = IC2+1 178 : ELSE 179 : ICOUL=IDCOUL+1 179 : CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC2)) 180 : NOCOUL(IC2) = ICOUL-1 181 : ENDIF 182 : IGEOV(IC2) = 0 183 : * 184 : * Creation du MCHPOI puis du MSOUPO et du MPOVAL 185 : * 186 : NAT = 2 187 : NSOUPO = 1 188 : SEGINI MCHPOI 189 : ICHPO(IC2) = MCHPOI 190 : MTYPOI = 'VECTEUR ' 191 : MOCHDE = 'CONTRAINTES PRINCIPALES' 192 : IFOPOI = IFOUR 193 : JATTRI(1) = 2 194 : JATTRI(2) = 0 195 : NC = IDIM + 1 196 : SEGINI MSOUPO 197 : IPCHP(1) = MSOUPO 198 : NOCOMP(1) = 'SIPX' 199 : NOCOMP(2) = 'SIPY' 200 : IF (IDIM.EQ.3) NOCOMP(3) = 'SIPZ' 201 : NOCOMP(IDIM+1) = 'SIGN' 202 : * 203 : N = NIPO * NBELE1 204 : SEGINI MPOVAL 205 : IPOVAL = MPOVAL 206 : * 207 : NBNN = 1 208 : NBELEM = N 209 : NBSOUS = 0 210 : NBREF = 0 211 : SEGINI IPT1 212 : IGEOC = IPT1 213 : IPT1.ITYPEL = 1 214 : * 215 : NBTYPE = 1 216 : SEGINI NOTYPE 217 : MOTYPE = NOTYPE 218 : TYPE(1) = 'REAL*8' 218 : CALL KOMCHA(MCHA1,IPMAIL,CONM,MOCOMP(IC), 219 : & MOTYPE,1,INFOS,3,IVACOM) 220 : SEGSUP NOTYPE 221 : IF (IERR.NE.0) GOTO 900 222 : * 223 : * Cas des coques epaisses : epaisseur (excentrement) 224 : * 225 : IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN 226 : NBROBL = 1 227 : NBRFAC = 0 228 : SEGINI NOMID 229 : MOEP = NOMID 230 : LESOBL(1) = 'EPAI' 231 : NVEC = NBROBL + NBRFAC 232 : NBTYPE = 1 233 : SEGINI NOTYPE 234 : MOTYPE = NOTYPE 235 : TYPE(1) = 'REAL*8' 235 : CALL KOMCHA(MCHA2,IPMAIL,CONM,MOEP, 236 : & MOTYPE,1,INFOS,3,IVAEP) 237 : SEGSUP NOTYPE 238 : ENDIF 239 : * 240 : IPO = 0 241 : * 242 : * Boucle sur les elements 243 : * 244 : DO 200 IEL = 1,NBELE1 245 : * 245 : CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XEL) 246 : * 247 : IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN 248 : MPTVAL = IVAEP 249 : MELVAL=IVAL(1) 250 : DO 201 IP = 1,NBN1 251 : IPMN=MIN(IP ,VELCHE(/1)) 252 : IEMN=MIN(IEL,VELCHE(/2)) 253 : TH(IP)=VELCHE(IPMN,IEMN) 254 : 201 CONTINUE 254 : CALL CQ8LOC(XEL,NBN1,MINTE1.SHPTOT,TXR,IRR) 255 : ENDIF 256 : * 257 : * Boucle sur les points supports 258 : * 259 : DO 300 IPSU = 1,NIPO 260 : IPO = IPO + 1 261 : * 262 : MPTVAL = IVACOM 263 : MELVAL = IVAL(1) 264 : IPMN = MIN(IPSU,VELCHE(/1)) 265 : IEMN = MIN(IEL ,VELCHE(/2)) 266 : SMWW = VELCHE(IPMN,IEMN) 267 : IF (SMWW.GE.0.D0) VPOCHA(IPO,IDIM+1) = 0.D0 268 : IF (SMWW.LT.0.D0) VPOCHA(IPO,IDIM+1) = 1.D0 269 : IF (ABS(SMWW).GT.SMAX) SMAX = ABS(SMWW) 270 : * 271 : DO 350 I1 = 1,IDIM 272 : MELVAL = IVAL(1+I1) 273 : IPMN = MIN(IPSU,VELCHE(/1)) 274 : IEMN = MIN(IEL ,VELCHE(/2)) 275 : COS1 = VELCHE(IPMN,IEMN) 276 : VPOCHA(IPO,I1) = SMWW * COS1 277 : 350 CONTINUE 278 : * 279 : IF (ISUP.EQ.5) THEN 280 : IF (IC2.EQ.1) THEN 281 : IF (ISUP.EQ.5.AND.MFR.EQ.5) THEN 282 : Z = DZEGAU(IPSU) 283 : DO 400 I2 = 1,IDIM 284 : XIGAU(I2) = 0.D0 285 : DO 400 IL = 1,NBN1 286 : XIGAU(I2) = XIGAU(I2)+(SHPTOT(1,IL,IPSU)* 287 : & XEL(I2,IL)+0.5D0*Z*TXR(I2,3,IL)*TH(IL)) 288 : 400 CONTINUE 289 : ELSE 290 : DO 410 I2 = 1,IDIM 291 : XIGAU(I2) = 0.D0 292 : DO 410 IL = 1,NBN1 293 : XIGAU(I2) = XIGAU(I2) + 294 : & (SHPTOT(1,IL,IPSU)*XEL(I2,IL)) 295 : 410 CONTINUE 296 : ENDIF 297 : * 298 : * Le pdi est reference dans MCOORD (PROVISOIRE) 299 : * 300 : NBPTS = XCOOR(/1)/(IDIM+1)+1 301 : SEGADJ MCOORD 302 : XCOOR((NBPTS-1)*(IDIM+1)+1) = XIGAU(1) 303 : XCOOR((NBPTS-1)*(IDIM+1)+2) = XIGAU(2) 304 : IF (IDIM.EQ.3) XCOOR((NBPTS-1)*(IDIM+1)+3)=XIGAU(3) 305 : XCOOR(NBPTS*(IDIM+1)) = 0.D0 306 : IPT1.NUM(1,IPO) = NBPTS 307 : IPPO(IPO) = NBPTS 308 : ELSE 309 : IPT1.NUM(1,IPO) = IPPO(IPO) 310 : ENDIF 311 : ELSE 312 : IPT1.NUM(1,IPO) = NUM(IPSU,IEL) 313 : ENDIF 314 : 300 CONTINUE 315 : 200 CONTINUE 316 : SEGDES MPOVAL,MSOUPO,MCHPOI,IPT1 317 : 151 SEGDES NOMID 318 : 150 CONTINUE 319 : * 320 : IC1 = 0 321 : DO 500 IC2 = NLIST+1,NLIST*2 322 : IC1 = IC1 + 1 323 : NOMID = MOCOMP(IC1) 324 : SEGACT NOMID 325 : IF (CMOT.NE.' '.AND.CMOT.NE.LESOBL(1)) GOTO 501 326 : IF (CMOT.EQ.LESOBL(1)) THEN 327 : IC3 = 2 328 : IC1 = 1 329 : MCHPOI = ICHPO(1) 330 : ELSE 331 : IC3 = IC2 332 : MCHPOI = ICHPO(IC1) 333 : ENDIF 334 : NOCOVE(IC3,1) = LESOBL(1) 335 : IF (LMOT1.EQ.0) THEN 336 : NOCOUL(IC3) = IC1 + 1 337 : ELSE 338 : ICOUL=IDCOUL+1 338 : CALL PLACE(NCOUL,NBCOUL,ICOUL,MOTS(IC1)) 339 : NOCOUL(IC3) = ICOUL-1 340 : ENDIF 341 : IGEOV(IC3) = 0 341 : CALL MUCHPO(MCHPOI,-1.D0,ICHP2,1) 342 : ICHPO(IC3) = ICHP2 343 : 501 SEGDES NOMID 344 : 500 CONTINUE 345 : * 346 : * Desactivation des segments de la zone ISOU 347 : * 348 : SEGDES IMODEL,MINTE,MELEME 349 : IF (MFR.EQ.5) SEGDES MINTE1 350 : DO 105 I0 = 1,NCOMP 351 : IF (IVAL(I0).NE.0) THEN 352 : MELVAL = IVAL(I0) 353 : SEGDES,MELVAL 354 : ENDIF 355 : 105 CONTINUE 356 : SEGSUP MPTVAL,MWRK1 357 : IF (ISUP.EQ.5.AND.MFR.EQ.5) SEGSUP MWRK2 358 : IF (ISUP.EQ.5) SEGSUP IPPO 359 : NCX = NLIST * 2 360 : IF (CMOT.NE.' ') NCX = 2 361 : DO 101 IMX = 1,NCX 362 : AMPF(IMX) = AMP 363 : 101 CONTINUE 364 : SEGDES MVECTE 365 : * 366 : IF (MVECT0.EQ.0) THEN 367 : MVECT0 = MVECTE 368 : ELSE 368 : CALL FUSVEC(MVECT0,MVECTE,MVECT1) 369 : MVECT0 = MVECT1 370 : ENDIF 371 : * 372 : 100 CONTINUE 373 : SEGDES MMODEL 374 : IF (LMOT1.NE.0) SEGDES MLMOTS 375 : RETURN 376 : * 377 : 900 CONTINUE 378 : * 379 : RETURN 380 : END 381 : 382 : 383 : 384 : 385 : 386 : 387 : 388 : 389 : 390 : 391 : 392 : 393 : 394 : 395 :
© Cast3M 2003 - All rights reserved.
Disclaimer