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