1 : C VARIN2 SOURCE AM 11/08/22 21:15:02 7106 2 : SUBROUTINE VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,MELE, 3 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE) 4 : *____________________________________________________________________ 5 : * 6 : * OBJET : Variation d'un champ/élément ayant une ou des composante(s) 7 : * °°°°°°° de type EVOLUTION en fonction d'un champ/point ou 8 : * d'un champ/élément.Ce champ peut avoir plusieurs composantes 9 : * si necessaire. Dans ce cas il est possible d'instancier 10 : * un champ/element dont les composantes dependent de 11 : * parametres differents en chaque point. 12 : * Routine appelee par varinu.eso 13 : * 14 : * 15 : * SORTIE : 16 : * °°°°°°°° 17 : * 18 : * MELVAL Pointeur sur le MCHAML resultat 19 : * KERRE Diagnostic d'erreur 20 : * 21 : *_____________________________________________________________________ 22 : * 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : * 26 : -INC SMCHAML 27 : -INC CCOPTIO 28 : -INC SMEVOLL 29 : -INC SMLREEL 30 : -INC SMELEME 31 : -INC SMINTE 32 : -INC SMCOORD 33 : C 34 : CHARACTER*8 NOMCO,NOM2,NOM3,NOM4,NOMTT 35 : LOGICAL COQ 36 : C 37 : C Creation des segments 38 : SEGMENT SWORK 39 : REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBNN) 40 : REAL*8 SHP(6,NBNN) ,XE(3,NBNN) 41 : ENDSEGMENT 42 : SEGMENT IAMOI 43 : REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE) 44 : ENDSEGMENT 45 : C 46 : DATA NOMTT/'T '/ 47 : C 48 : KERRE=0 49 : ICHAN=0 50 : C 51 : MCHAM2=ICHAM2 52 : SEGACT MCHAM2 53 : NBNN =NUM(/1) 54 : NEL0=NUM(/2) 55 : NBPGAU=SHPTOT(/3) 56 : N1PTE3=MELVA1.IELCHE(/1) 57 : N1EL3 =MELVA1.IELCHE(/2) 58 : NCO1 = MCHAM2.IELVAL(/1) 59 : IEVOL = MELVA1.IELCHE(1,1) 60 : MEVOLL = IEVOL 61 : SEGACT MEVOLL 62 : KEVOLL = IEVOLL(1) 63 : SEGACT KEVOLL 64 : NOM3 = NOMEVY(1:8) 65 : NOM4 = NOMEVX(1:8) 66 : SEGDES KEVOLL 67 : SEGDES MEVOLL 68 : C 69 : C Cas des coques dont les caracteristiques dependent de T 70 : C 71 : IF (COQ.AND.NOM4.EQ.NOMTT) THEN 72 : INO2 = 0 73 : INO1 = 0 74 : INO3 = 0 75 : DO 10 INO = 1,NCO1 76 : NOM2 = MCHAM2.NOMCHE(INO) 77 : IF (NOM2.EQ.NOMTT ) INO2=INO 78 : IF (NOM2.EQ.'TINF ') INO1=INO 79 : IF (NOM2.EQ.'TSUP ') INO3=INO 80 : 10 CONTINUE 81 : IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN 82 : C 83 : MELVA3=MCHAM2.IELVAL(INO1) 84 : MELVA4=MCHAM2.IELVAL(INO3) 85 : SEGACT MELVA3,MELVA4 86 : C 87 : NBP2=MELVA4.VELCHE(/1) 88 : NBP1=MELVA3.VELCHE(/1) 89 : NEL1=MELVA3.VELCHE(/2) 90 : NEL2=MELVA4.VELCHE(/2) 91 : N1PTEL=MAX(NBP1,NBP2) 92 : N1EL =MAX(NEL1,NEL2) 93 : N2PTEL=0 94 : N2EL =0 95 : SEGINI MELVA5 96 : DO 20 IGAU=1,N1PTEL 97 : IGMN1=MIN(IGAU,MELVA3.VELCHE(/1)) 98 : IGMN2=MIN(IGAU,MELVA4.VELCHE(/1)) 99 : DO 30 IB=1,N1EL 100 : IBMN1=MIN(IB,MELVA3.VELCHE(/2)) 101 : IBMN2=MIN(IB,MELVA4.VELCHE(/2)) 102 : MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+ 103 : & MELVA4.VELCHE(IGMN2,IBMN2) 104 : 30 CONTINUE 105 : 20 CONTINUE 106 : C 107 : SEGDES MELVA3,MELVA4 108 : MELVA3=MCHAM2.IELVAL(INO2) 109 : SEGACT MELVA3 110 : C 111 : N1PTEL = MELVA3.VELCHE(/1) 112 : N1EL = MELVA3.VELCHE(/2) 113 : N2PTEL = 0 114 : N2EL = 0 115 : SEGINI MELVA4 116 : DO 40 II = 1,N1PTEL 117 : DO 50 III = 1,N1EL 118 : MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III) 119 : 50 CONTINUE 120 : 40 CONTINUE 121 : SEGDES MELVA3 122 : C 123 : NBP2=MELVA4.VELCHE(/1) 124 : NBP1=MELVA5.VELCHE(/1) 125 : NEL1=MELVA5.VELCHE(/2) 126 : NEL2=MELVA4.VELCHE(/2) 127 : N1PTEL=MAX(NBP1,NBP2) 128 : N1EL =MAX(NEL1,NEL2) 129 : N2PTEL=0 130 : N2EL =0 131 : SEGINI MELVA6 132 : DO 60 IGAU=1,N1PTEL 133 : IGMN1=MIN(IGAU,MELVA5.VELCHE(/1)) 134 : IGMN2=MIN(IGAU,MELVA4.VELCHE(/1)) 135 : DO 70 IB=1,N1EL 136 : IBMN1=MIN(IB,MELVA5.VELCHE(/2)) 137 : IBMN2=MIN(IB,MELVA4.VELCHE(/2)) 138 : MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+ 139 : & MELVA4.VELCHE(IGMN2,IBMN2) 140 : 70 CONTINUE 141 : 60 CONTINUE 142 : SEGSUP MELVA4,MELVA5 143 : C 144 : N1PTEL = MELVA6.VELCHE(/1) 145 : N1EL = MELVA6.VELCHE(/2) 146 : N2PTEL = 0 147 : N2EL = 0 148 : SEGINI MELVA2 149 : DO 80 II = 1,N1PTEL 150 : DO 90 III = 1,N1EL 151 : MELVA2.VELCHE(II,III) = 1.D0/6.D0*MELVA6.VELCHE(II,III) 152 : 90 CONTINUE 153 : 80 CONTINUE 154 : SEGSUP MELVA6 155 : C 156 : GOTO 100 157 : ELSEIF (INO2.NE.0) THEN 158 : MELVA2=MCHAM2.IELVAL(INO2) 159 : SEGACT MELVA2 160 : GOTO 100 161 : ENDIF 162 : ELSE 163 : DO 110 INO = 1,NCO1 164 : NOM2 = MCHAM2.NOMCHE(INO) 165 : IF (NOM3.EQ.NOMCO.or.(nomco.eq.'MOCO'.and.NOM3.eq.'RAID').or. 166 : &(nomco.eq.'MOCO'.and.NOM3.eq.'AMOR')) 167 : & THEN 168 : IF (NOM4.EQ.NOM2.OR.(NOM2.EQ.'TEMP'.AND.NOM4.EQ.'FREQ')) 169 : & THEN 170 : MELVA2=MCHAM2.IELVAL(INO) 171 : SEGACT MELVA2 172 : GOTO 100 173 : ENDIF 174 : ENDIF 175 : 110 CONTINUE 176 : ENDIF 177 : C 178 : SEGDES MCHAM2 179 : KERRE=665 180 : RETURN 181 : C 182 : 100 CONTINUE 183 : C 184 : C On teste la taille de MCHAML_FLOTTANT 185 : N1PTE2=MELVA2.VELCHE(/1) 186 : N1EL2 =MELVA2.VELCHE(/2) 187 : IF (N1EL2.NE.NEL0.AND.N1EL2.NE.1.AND.NEL0.NE.1) THEN 188 : SEGDES MCHAM2,MELVA2 189 : KERRE=146 190 : RETURN 191 : ENDIF 192 : IF (N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN 193 : SEGDES MCHAM2,MELVA2 194 : KERRE=146 195 : RETURN 196 : ENDIF 197 : C On teste la taille entre MCHAML_EVOLUTION et MCHAML_FLOTTANT 198 : IF (N1EL2.NE.N1EL3.AND.N1EL2.NE.1.AND.N1EL3.NE.1) THEN 199 : SEGDES MCHAM2,MELVA2 200 : KERRE=146 201 : RETURN 202 : ENDIF 203 : C Si MCHAML_FLOTTANT ou la loi de variation n'est pas constant 204 : C et de plus leur support geometrique est different, alors on 205 : C change le support de MCHAML_FLOTTANT (MINTE) vers le support 206 : C de MCHAML_EVOLUTION (MINTE1). Quand l'interpolation est finie, 207 : C on change le support geometrique de MCHAML_FLOTTANT resultat 208 : C vers le support demandé (MINTE). 209 : C Tableau VEL1 contient les valeurs au support MINTE1 210 : C Tableau VEL2 contient les valeurs interpolées selon 211 : C la loi de variation et appuyées au support MINTE1 212 : MXNBE=MAX(N1EL2,N1EL3) 213 : IF (N1PTE3.NE.1.AND.MINTE.NE.MINTE1) THEN 214 : ICHAN=1 215 : IF (N1PTE2.EQ.1) THEN 216 : MG1=1 217 : ELSE 218 : MG1=N1PTE3 219 : ENDIF 220 : MG2=N1PTE3 221 : SEGINI IAMOI 221 : CALL ZERO(VEL1,MG1,N1EL2) 221 : CALL ZERO(VEL2,MG2,MXNBE) 222 : C Pour les COQ4, le nb de pt de GAUSS vaux 5, mais 223 : C on ne prend que les 4 premiers 224 : N1PAUX=N1PTE2 225 : IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4 226 : DO 120 IEL=1,N1EL2 227 : IF (N1PTE2.EQ.1) THEN 228 : VEL1(1,IEL)=MELVA2.VELCHE(1,IEL) 229 : ELSE 230 : DO 130 IGAU=1,N1PTE2 231 : VAL1(IGAU)=MELVA2.VELCHE(IGAU,IEL) 232 : 130 CONTINUE 233 : IF (MINTE1.NE.0) THEN 233 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 233 : CALL QUEDIM(MELGEO,KERRE) 233 : CALL CH1CH2(MELE,MINTE1,MINTE,N1PTE3,N1PAUX,NBNN,SWORK, 234 : & KERRE) 235 : IF (KERRE.NE.0) THEN 236 : SEGDES MCHAM2,MELVA2 237 : SEGSUP IAMOI 238 : RETURN 239 : ENDIF 240 : DO 140 IGAU=1,N1PTE3 241 : VEL1(IGAU,IEL)=VAL2(IGAU) 242 : 140 CONTINUE 243 : ELSE 244 : DO 150 IGAU=1,N1PTE3 245 : VALG=0.D0 246 : DO 160 INO=1,NBNN 247 : VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO) 248 : 160 CONTINUE 249 : VEL1(IGAU,IEL)=VALG 250 : 150 CONTINUE 251 : ENDIF 252 : ENDIF 253 : 120 CONTINUE 254 : ELSE 255 : MG2=NBPGAU 256 : IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) MG2=1 257 : ENDIF 258 : C Recherche de la taille du nouveau chamelem 259 : N2PTEL=0 260 : N2EL =0 261 : N1PTEL=NBPGAU 262 : N1EL =MXNBE 263 : IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) N1PTEL=1 264 : SEGINI MELVAL 265 : C Boucle sur les points de gauss et les éléments 266 : DO 170 IEL=1,MXNBE 267 : DO 180 IGAU=1,MG2 268 : IG=IGAU 269 : IF (N1PTE3.EQ.1) IG=1 270 : IE=IEL 271 : IF (N1EL3.EQ.1) IE=1 272 : C On active l'objet EVOLUTION 273 : IEVOL=MELVA1.IELCHE(IG,IE) 274 : MEVOLL=IEVOL 275 : SEGACT MEVOLL 276 : KEVOLL=IEVOLL(1) 277 : SEGACT KEVOLL 278 : MLREEL=IPROGX 279 : MLREE1=IPROGY 280 : SEGDES MEVOLL,KEVOLL 281 : SEGACT MLREEL,MLREE1 282 : C 283 : C 284 : INEW=0 285 : LON=PROG(/1) 286 : C 287 : C test pour renverser les suites si ls premiere est decroissante 288 : C 289 : IF (PROG(LON) .LT. PROG(1)) THEN 290 : JG=LON 291 : JFIN=LON+1 292 : SEGINI MLREE2,MLREE3 293 : INEW=1 294 : DO 190 IO=1,LON 295 : MLREE2.PROG(IO)=PROG(JFIN-IO) 296 : MLREE3.PROG(IO)=MLREE1.PROG(JFIN-IO) 297 : 190 CONTINUE 298 : SEGDES MLREEL,MLREE1 299 : MLREEL=MLREE2 300 : MLREE1=MLREE3 301 : ENDIF 302 : C 303 : C 304 : C On cherche la valeur à interpoler 305 : IF (ICHAN.EQ.1) THEN 306 : IG=IGAU 307 : IF (VEL1(/1).EQ.1) IG=1 308 : IE=IEL 309 : IF (VEL1(/2).EQ.1) IE=1 310 : VA1=VEL1(IG,IE) 311 : ELSE 312 : IG=IGAU 313 : IF (N1PTE2.EQ.1) IG=1 314 : IE=IEL 315 : IF (N1EL2.EQ.1) IE=1 316 : VA1=MELVA2.VELCHE(IG,IE) 317 : ENDIF 318 : C 319 : C Interpolation linéaire 320 : DO 200 IP=2,PROG(/1) 321 : I1=IP 322 : IF (PROG(IP).GT.VA1) GOTO 210 323 : 200 CONTINUE 324 : 210 CONTINUE 325 : I2=I1-1 326 : IF(PROG(I1)-PROG(I2).EQ.0.) THEN 327 : KERRE = 835 328 : IF (INEW.EQ.1) THEN 329 : SEGSUP MLREEL,MLREE1 330 : ELSE 331 : SEGDES MLREEL,MLREE1 332 : ENDIF 333 : SEGDES MCHAM2,MELVA2 334 : RETURN 335 : ENDIF 336 : PENTE=(MLREE1.PROG(I1)-MLREE1.PROG(I2))/ 337 : & (PROG(I1)-PROG(I2)) 338 : VAINT=MLREE1.PROG(I2)+PENTE*(VA1-PROG(I2)) 339 : * kich : valeur hors segment 340 : ** AM : ON MET UN MESSAGE D'ERREUR 341 : if (va1.lt.prog(1)) vaint=MLREE1.PROG(1) 342 : if (va1.gt.prog(prog(/1))) vaint=MLREE1.PROG(PROG(/1)) 343 : ** IF (va1.lt.prog(1).OR. 344 : ** & va1.gt.prog(prog(/1))) THEN 345 : ** KERRE = 497 346 : ** IF (INEW.EQ.1) THEN 347 : ** SEGSUP MLREEL,MLREE1 348 : ** ELSE 349 : ** SEGDES MLREEL,MLREE1 350 : ** ENDIF 351 : ** SEGDES MCHAM2,MELVA2 352 : ** RETURN 353 : ** ENDIF 354 : * 355 : IF (ICHAN.EQ.1) THEN 356 : VEL2(IGAU,IEL)=VAINT 357 : ELSE 358 : VELCHE(IGAU,IEL)=VAINT 359 : ENDIF 360 : * write(6,fmt='(1X,''IGAU,IEL,VA1,VEL2'',2I6,2E13.5)') 361 : * IGAU,IEL,VA1,VAINT 362 : C 363 : IF (INEW.EQ.1) THEN 364 : SEGSUP MLREEL,MLREE1 365 : ELSE 366 : SEGDES MLREEL,MLREE1 367 : ENDIF 368 : 180 CONTINUE 369 : 170 CONTINUE 370 : C On change les valeurs interpolées au support demandé 371 : IF (ICHAN.EQ.1) THEN 372 : N1PAUX=N1PTE3 373 : IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4 374 : DO 220 IEL=1,MXNBE 375 : DO 230 IGAU=1,N1PTE3 376 : VAL1(IGAU)=VEL2(IGAU,IEL) 377 : 230 CONTINUE 378 : IF (MINTE1.NE.0) THEN 378 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE) 378 : CALL QUEDIM(MELGEO,KERRE) 378 : CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBNN,SWORK, 379 : & KERRE) 380 : IF (KERRE.NE.0) THEN 381 : SEGDES MCHAM2,MELVA2 382 : SEGSUP IAMOI 383 : RETURN 384 : ENDIF 385 : DO 240 IGAU=1,N1PTEL 386 : VELCHE(IGAU,IEL)=VAL2(IGAU) 387 : 240 CONTINUE 388 : ELSE 389 : DO 250 IGAU=1,N1PTEL 390 : VALG=0.D0 391 : DO 260 INO=1,NBNN 392 : VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO) 393 : 260 CONTINUE 394 : VELCHE(IGAU,IEL)=VALG 395 : 250 CONTINUE 396 : ENDIF 397 : 220 CONTINUE 398 : ENDIF 399 : SEGDES MELVA2,MELVAL 400 : SEGDES MCHAM2 401 : C 402 : RETURN 403 : END 404 : 405 : 406 : 407 : 408 : 409 : 410 : 411 : 412 : 413 : 414 : 415 : 416 : 417 : 418 : 419 : 420 :
© Cast3M 2003 - All rights reserved.
Disclaimer