1 : C GREEN2 SOURCE FANDEUR 10/12/14 21:16:53 6812 2 : SUBROUTINE GREEN2 (KMATER,KCARAC,DLL,TEMP1,DELTAT,FB,FH,NIN 3 : & ,KGREEN) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * G R E E N 2 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * 14 : * CALCULE LES FONCTIONS DE GREEN ADIMENSIONNELLES 15 : * 16 : * G(X+DX) - G(X) 17 : * LES DERIVEES SONT CALCULEES PAR -------------- 18 : * DX 19 : * 20 : * MODULES UTILISES: 21 : * ----------------- 22 : * 23 : -INC CCOPTIO 24 : -INC CCREEL 25 : -INC SMCHAML 26 : -INC SMLREEL 27 : -INC SMEVOLL 28 : * 29 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 30 : * ----------- 31 : * 32 : * KMATER (E) POINTEUR SUR LE CHAMP "MATERIAU" 33 : * KCARAC (E) POINTEUR SUR LE CHAMP "CARACTERISTIQUE" 34 : * DLL (E) LONGUEUR DE L'ELEMENT 35 : * TEMP1 (E) TEMPS DE CALCUL 36 : * DELTAT (E) PAS DE TEMPS 37 : * FB, FH (E) FREQUENCES DE FILTRAGE, BORNES DE L'INTERVALLE 38 : * D'INTEGRATION. 39 : * NIN (E) METHODE D'INTEGRATION: 40 : * 1 FCT ESCALIER "INFERIEUR" 41 : * 2 FCT ESCALIER "MEDIAN" 42 : * 3 FCT ESCALIER "SUPERIEUR" 43 : * 4 TRAPEZES 44 : * KGREEN (S) POINTEUR DE L'OBJET "EVOLUTION" CONTENANT LES 45 : * FONCTIONS DE GREEN. 46 : * IL MANQUE LE FACTEUR C/ES (OU ANALOGUE) POUR AVOIR 47 : * LES VRAIES FONCTIONS DE GREEN EN TRACTION (OU 48 : * TORSION). 49 : * 50 : * FONCTIONS : 51 : * ----------- 52 : * 53 : REAL*8 GRET 54 : EXTERNAL GRET 55 : * 56 : * CONSTANTES: 57 : * ----------- 58 : * 59 : PARAMETER (ZERO = 0.D0) 60 : PARAMETER (EPS = 1.D-3) 61 : PARAMETER (EPS9 = 1.D0 - EPS) 62 : * 63 : * VARIABLES: 64 : * ---------- 65 : * 66 : * ....TC = RELATIF A TRACTION. 67 : * ....TO = RELATIF A TORSION. 68 : * PAS... = PAS DE TEMPS SPECIFIQUE POUR LA TRACTION OU LA TORSION 69 : * OU LA FLEXION. 70 : * NPAS.. = NOMBRE DE PAS POUR LA PROPAGATION D'UNE IMPULSION DE X=0 71 : * A X=L, SELON QUE TRACTION OU TORSION. 72 : * TPRO.. = TEMPS DE PROPAGATION D'UNE IMPULSION DE X=0 A X=L, 73 : * SELON QUE TRACTION OU TORSION. 74 : * INSTAN = POINTEURS DES INSTANTS DE DEFINITION DES FONCTIONS DE 75 : * GREEN ET DERIVEES (LISTREEL). 76 : * IGREEN = POINTEURS DES FONCTIONS DE GREEN ET DERIVEES (LISTREEL). 77 : * NINS.. = NOMBRE D'INSTANTS. 78 : * TEMP0 = TEMPS INITIAL POUR LEQUEL LES FONCTIONS DE GREEN SONT 79 : * DEFINIES. 80 : * 81 : INTEGER INSTAN(4),IGREEN(4) 82 : *+* SEGMENT A VIRER QUAND LA FLEXION SERA INTEGREE NUMERIQUEMENT. 83 : SEGMENT MAB 84 : REAL*8 AB(10,LAB) 85 : ENDSEGMENT 86 : *+* 87 : CHARACTER*12 NOMFCT(10) 88 : CHARACTER*12 INDICE 89 : CHARACTER*57 ITEX 90 : CHARACTER*72 JTEX 91 : POINTEUR G0.MLREEL,GL.MLREEL,DG0.MLREEL,DGL.MLREEL 92 : * 93 : * AUTEUR, DATE DE CREATION: 94 : * ------------------------- 95 : * 96 : * LIONEL VIVAN 11 FEVRIER 1988 97 : * REPRISE P. MANIGOT 04/03/88 98 : * 99 : * LANGAGE: 100 : * -------- 101 : * 102 : * ESOPE + FORTRAN77 103 : * 104 : ************************************************************************ 105 : * 106 : DATA NOMFCT/'G(X=0) ','DG/DX(X=0) ','D2G/DX2(X=0)', 107 : & 'D3G/DX3(X=0)','D4G/DX4(X=0)', 108 : & 'G(X=L) ','DG/DX(X=L) ','D2G/DX2(X=L)', 109 : & 'D3G/DX3(X=L)','D4G/DX4(X=L)'/ 110 : * 111 : ITEX=' L = C = RF = ' 112 : JTEX='FCTS DE GREEN FILTREES DE HZ A HZ' 113 : & //' VERSION2' 114 : * 115 : * 1) RECUPERATION DES CARACTERISTIQUES 116 : * --------------------------------- 117 : * 118 : MCHAML=KMATER 119 : SEGACT,MCHAML 120 : MELVAL=IELVAL(1) 121 : SEGACT,MELVAL 122 : E =VELCHE(1,1) 123 : SEGDES,MELVAL 124 : MELVAL=IELVAL(2) 125 : SEGACT,MELVAL 126 : ANU=VELCHE(1,1) 127 : SEGDES,MELVAL 128 : MELVAL=IELVAL(3) 129 : SEGACT,MELVAL 130 : RHO=VELCHE(1,1) 131 : SEGDES,MELVAL 132 : SEGDES,MCHAML 133 : IF (E.LT.XPETIT) THEN 133 : CALL ERREUR (411) 134 : RETURN 135 : END IF 136 : IF (RHO.LT.XPETIT) THEN 136 : CALL ERREUR (412) 137 : RETURN 138 : END IF 139 : 140 : MCHAML=KCARAC 141 : SEGACT,MCHAML 142 : MELVAL=IELVAL(1) 143 : SEGACT,MELVAL 144 : TORS=VELCHE(1,1) 145 : SEGDES,MELVAL 146 : MELVAL=IELVAL(2) 147 : SEGACT,MELVAL 148 : AINRY=VELCHE(1,1) 149 : SEGDES,MELVAL 150 : MELVAL=IELVAL(3) 151 : SEGACT,MELVAL 152 : AINRZ=VELCHE(1,1) 153 : SEGDES,MELVAL 154 : MELVAL=IELVAL(4) 155 : SEGACT,MELVAL 156 : SECT=VELCHE(1,1) 157 : SEGDES,MELVAL 158 : SEGDES,MCHAML 159 : IF (SECT.LT.XPETIT) THEN 159 : CALL ERREUR (415) 160 : RETURN 161 : END IF 162 : * 163 : ES=E*SECT 164 : AIP=AINRY+AINRZ 165 : AMU=E/(2.D0*(1.D0+ANU)) 166 : CTC=SQRT(E/RHO) 167 : CTO=SQRT(AMU/RHO) 168 : RTC=SQRT(AIP/SECT) 169 : RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT) 170 : RFY=SQRT(AINRY/SECT) 171 : RFZ=SQRT(AINRZ/SECT) 172 : * 173 : TPROTC = DLL / CTC 174 : NPASTC = INT(TPROTC*EPS9/DELTAT) + 1 175 : PASTC = TPROTC / DBLE(NPASTC) 176 : TPROTO = DLL / CTO 177 : NPASTO = INT(TPROTO*EPS9/DELTAT) + 1 178 : PASTO = TPROTC / DBLE(NPASTO) 179 : IF (IIMPI .EQ. 1806) THEN 180 : WRITE (IOIMP,*) 181 : WRITE (IOIMP,*) 'DELTAT = ',DELTAT 182 : WRITE (IOIMP,*) 'TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO' 183 : WRITE (IOIMP,*) TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO 184 : WRITE (IOIMP,*) 185 : END IF 186 : * 187 : TEMPS = MAX(TEMP1,TPROTC,TPROTO) 188 : * 189 : N=28 190 : SEGINI MEVOLL 191 : WRITE (JTEX(27:38),FMT='(1PE12.5)') FB 192 : WRITE (JTEX(45:56),FMT='(1PE12.5)') FH 193 : IEVTEX=JTEX 194 : ITYEVO='REEL' 195 : * 196 : * 1 - TRACTION COMPRESSION 197 : * 2 - TORSION 198 : * 199 : DO 150 ITRACT=1,2 200 : * 201 : IF (ITRACT.EQ.1) THEN 202 : K0=0 203 : CT=CTC 204 : RT=RTC 205 : PAS = PASTC 206 : NPAS = NPASTC 207 : INDICE='TRACTION' 208 : ELSE 209 : K0=2 210 : CT=CTO 211 : RT=RTO 212 : PAS = PASTO 213 : NPAS = NPASTO 214 : INDICE='TORSION ' 215 : END IF 216 : * 217 : * 218 : * 2) INSTANTS DE DEFINITION DES FONCTIONS DE GREEN ET DERIVEES. 219 : * ---------------------------------------------------------- 220 : * 221 : NINS0 = NINT(TEMPS/PAS) + 1 222 : * 223 : * INSTANTS DE DEFINITION DES FONCTIONS DE GREEN 224 : JG=NINS0 225 : SEGINI MLREEL 226 : INSTAN(1) = MLREEL 227 : INSTAN(3) = MLREEL 228 : TEMP0 = 0.D0 229 : TEMP = TEMP0 230 : DO 100 NP=1,NINS0 231 : PROG(NP)=TEMP 232 : TEMP=TEMP+PAS 233 : 100 CONTINUE 234 : * END DO 235 : SEGDES MLREEL 236 : * 237 : * INSTANTS DE DEFINITION DES DERIVEES PREMIERES DES FONCTIONS DE 238 : * GREEN DE TRACTION ET TORSION. 239 : NINS1T = 2 * (NINS0 - 1) 240 : JG = NINS1T 241 : SEGINI MLREEL 242 : INSTAN(2) = MLREEL 243 : INSTAN(4) = MLREEL 244 : TEMP = TEMP0 245 : PAS1 = PAS * EPS 246 : DO 110 NP=1,NINS1T,2 247 : PROG(NP) = TEMP + PAS1 248 : TEMP = TEMP + PAS 249 : PROG(NP+1) = TEMP - PAS1 250 : 110 CONTINUE 251 : * END DO 252 : SEGDES MLREEL 253 : * 254 : * 3) VALEURS DES FONCTIONS DE GREEN ET DERIVEES. 255 : * ------------------------------------------- 256 : * 257 : *+* AVEC LA FLEXION INTEGREE NUMERIQUEMENT, IL FAUDRA METTRE 258 : *+* CETTE BOUCLE 140 EN TETE. 259 : * 260 : DO 140 I=1,4 261 : * 262 : IF (I.EQ.3) K0 = K0+12 263 : K = K0 + I 264 : SEGINI KEVOLL 265 : IEVOLL(K)=KEVOLL 266 : * 267 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 268 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CT 269 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RT 270 : KEVTEX=ITEX // ' ' // INDICE 271 : TYPX='LISTREEL' 272 : TYPY='LISTREEL' 273 : NUMEVX = 4 274 : NUMEVY='REEL' 275 : IPROGX = INSTAN(I) 276 : IF ( (I/2)*2 .EQ. I) THEN 277 : JG = NINS1T 278 : ELSE 279 : JG = NINS0 280 : END IF 281 : SEGINI MLREEL 282 : IGREEN(I) = MLREEL 283 : IPROGY=MLREEL 284 : NOMEVX='TEMPS (S)' 285 : IF (I .LT. 3) THEN 286 : NOMEVY=NOMFCT(I) 287 : ELSE 288 : NOMEVY=NOMFCT(I+3) 289 : END IF 290 : * 291 : SEGDES KEVOLL 292 : * LE "LISTREEL" DE FONCTION DE GREEN EST LAISSE ACTIF. 293 : 140 CONTINUE 294 : * END DO 295 : * 296 : CSTE = 2.D0*XPI*RT/CT 297 : XK1 = CSTE * FB 298 : IF (FH .LT. XPETIT) THEN 299 : XK2 = 1.3D0 * CSTE / DELTAT 300 : ELSE 301 : XK2 = CSTE * FH 302 : END IF 303 : TETA0 = TEMP0 * CT/RT 304 : DTETA = PAS * CT/RT 305 : DTET2 = DTETA / 2.D0 306 : * 307 : * EXTREMITE X=0 : 308 : * 309 : G0 = IGREEN(1) 310 : TETA = TETA0 311 : DO 120 NP=1,NINS0 312 : IF (TETA .LT. -DTET2) THEN 313 : G0.PROG(NP)=0.D0 314 : ELSE 315 : IF (TETA .LT. XPETIT) THEN 316 : DELTK = XGRAND 317 : ELSE 318 : DELTK = XPI / (4.D0 * ABS(TETA) ) 319 : END IF 320 : G0.PROG(NP)= 321 : & XINTGR(NIN,GRET,XK1,XK2,TETA,ZERO,DELTK)/XPI 322 : END IF 323 : TETA=TETA+DTETA 324 : 120 CONTINUE 325 : * END DO 326 : DG0 = IGREEN(2) 327 : * (LA DERIVEE EN KHI EST OPPOSEE A LA DERIVEE EN TETA) 328 : DO 122 NP=1,(NINS0-1) 329 : NP2 = NP * 2 330 : VALCST = -(G0.PROG(NP+1) - G0.PROG(NP)) / DTETA 331 : DG0.PROG(NP2-1) = VALCST 332 : DG0.PROG(NP2) = VALCST 333 : 122 CONTINUE 334 : * END DO 335 : * 336 : *+* LISSAGE ARTIFICIEL DE DG/DX: 337 : * 337 : CALL MAXIM3 (DG0,IPLACE,VALMAX) 338 : VALMAX = ABS(VALMAX) * 1.D-2 339 : SEGACT,DG0 340 : DO 130 IB=1,NINS1T 341 : IF (ABS(DG0.PROG(IB)) .LT. VALMAX) THEN 342 : DG0.PROG(IB) = 0.D0 343 : END IF 344 : 130 CONTINUE 345 : * END DO 346 : * 347 : * EXTREMITE X=L : 348 : * 349 : GL = IGREEN(3) 350 : DGL = IGREEN(4) 351 : DO 132 NP=1,NPAS 352 : GL.PROG(NP)=0.D0 353 : NP2 = NP * 2 354 : DGL.PROG(NP2-1) = 0.D0 355 : DGL.PROG(NP2) = 0.D0 356 : 132 CONTINUE 357 : * END DO 358 : DO 134 NP=(NPAS+1),(NINS0-1) 359 : NP1 = NP - NPAS 360 : GL.PROG(NP) = G0.PROG(NP1) 361 : NP2 = NP * 2 362 : NP3 = NP1 * 2 363 : DGL.PROG(NP2-1) = DG0.PROG(NP3-1) 364 : DGL.PROG(NP2) = DG0.PROG(NP3) 365 : 134 CONTINUE 366 : * END DO 367 : IF (NPAS .LT. NINS0) THEN 368 : GL.PROG(NINS0) = G0.PROG(NINS0-NPAS) 369 : END IF 370 : * 371 : SEGDES,G0,GL,DG0,DGL 372 : * 373 : 150 CONTINUE 374 : * END DO 375 : * 376 : * 377 : C-------------------------------------------------------------- 378 : JG=NINT(TEMPS/DELTAT) 379 : SEGINI MLREE1 380 : TEMP=0.D0 381 : DO 10 NP=1,JG 382 : TEMP=TEMP+DELTAT 383 : MLREE1.PROG(NP)=TEMP 384 : 10 CONTINUE 385 : SEGDES MLREE1 386 : LAB=JG + 1 387 : SEGINI MAB 388 : C 389 : C 3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z ) 390 : C 390 : CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,JG) 391 : K=4 392 : DO 80 I=1,10 393 : SEGINI KEVOLL 394 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 395 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC 396 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ 397 : KEVTEX=ITEX // ' FLEXION XOY' 398 : NUMEVX=4 399 : NUMEVY='REEL' 400 : TYPX='LISTREEL' 401 : TYPY='LISTREEL' 402 : IPROGX=MLREE1 403 : SEGINI MLREEL 404 : IPROGY=MLREEL 405 : NOMEVX='TEMPS (S)' 406 : NOMEVY=NOMFCT(I) 407 : DO 70 NP=1,JG 408 : PROG(NP)=AB(I,NP) 409 : 70 CONTINUE 410 : K=K+1 411 : IF (I.EQ.6) K=19 412 : IEVOLL(K)=KEVOLL 413 : SEGDES KEVOLL,MLREEL 414 : 80 CONTINUE 415 : C 416 : C 4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y ) 417 : C 418 : DIF=ABS(1.D0-RFY/RFZ) 419 : IF (DIF.GT.EPS) THEN 419 : CALL GFLEX1(AB,DLL,RFY,CTC,DELTAT,JG) 420 : END IF 421 : K=9 422 : DO 200 I=1,10 423 : SEGINI KEVOLL 424 : WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL 425 : WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC 426 : WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY 427 : KEVTEX=ITEX // ' FLEXION XOZ' 428 : NUMEVX=4 429 : TYPX='LISTREEL' 430 : TYPY='LISTREEL' 431 : NUMEVY='REEL' 432 : IPROGX=MLREE1 433 : NOMEVX='TEMPS (S)' 434 : NOMEVY=NOMFCT(I) 435 : SEGINI MLREEL 436 : IPROGY=MLREEL 437 : DO 90 NP=1,JG 438 : PROG(NP)=AB(I,NP) 439 : 90 CONTINUE 440 : K=K+1 441 : IF (I.EQ.6) K=24 442 : IEVOLL(K)=KEVOLL 443 : SEGDES KEVOLL,MLREEL 444 : 200 CONTINUE 445 : SEGSUP,MAB 446 : * 447 : SEGDES MEVOLL 448 : KGREEN = MEVOLL 449 : * 450 : RETURN 451 : END 452 : 453 :
© Cast3M 2003 - All rights reserved.
Disclaimer