Télécharger green3.eso

Retour à la liste

Numérotation des lignes :

  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
  137. CALL ERREUR (411)
  138. RETURN
  139. END IF
  140. IF (RHO.LT.XPETIT) THEN
  141. CALL ERREUR (412)
  142. RETURN
  143. END IF
  144. *
  145. MCHAML=KCARAC
  146. SEGACT,MCHAML
  147. MELVAL=IELVAL(1)
  148. SEGACT,MELVAL
  149. TORS=VELCHE(1,1)
  150. SEGDES,MELVAL
  151. MELVAL=IELVAL(2)
  152. SEGACT,MELVAL
  153. AINRY=VELCHE(1,1)
  154. SEGDES,MELVAL
  155. MELVAL=IELVAL(3)
  156. SEGACT,MELVAL
  157. AINRZ=VELCHE(1,1)
  158. SEGDES,MELVAL
  159. MELVAL=IELVAL(4)
  160. SEGACT,MELVAL
  161. SECT=VELCHE(1,1)
  162. SEGDES,MELVAL
  163. SEGDES,MCHAML
  164. IF (SECT.LT.XPETIT) THEN
  165. CALL ERREUR (415)
  166. RETURN
  167. END IF
  168. *
  169. ES=E*SECT
  170. AIP=AINRY+AINRZ
  171. AMU=E/(2.D0*(1.D0+ANU))
  172. CTC=SQRT(E/RHO)
  173. CTO=SQRT(AMU/RHO)
  174. RTC=SQRT(AIP/SECT)
  175. RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT)
  176. RFY=SQRT(AINRY/SECT)
  177. RFZ=SQRT(AINRZ/SECT)
  178. *
  179. TPROTC = DLL / CTC
  180. NPASTC = INT(TPROTC*EPS9/DELTAT) + 1
  181. PASTC = TPROTC / DBLE(NPASTC)
  182. TPROTO = DLL / CTO
  183. NPASTO = INT(TPROTO*EPS9/DELTAT) + 1
  184. PASTO = TPROTC / DBLE(NPASTO)
  185. IF (IIMPI .EQ. 1806) THEN
  186. WRITE (IOIMP,*)
  187. WRITE (IOIMP,*) 'DELTAT = ',DELTAT
  188. WRITE (IOIMP,*) 'TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO'
  189. WRITE (IOIMP,*) TPROTC,PASTC,NPASTC,TPROTO,PASTO,NPASTO
  190. WRITE (IOIMP,*)
  191. END IF
  192. *
  193. TEMPS = MAX(TEMP1,TPROTC,TPROTO)
  194. *
  195. N=28
  196. SEGINI MEVOLL
  197. WRITE (JTEX(27:38),FMT='(1PE12.5)') FB
  198. WRITE (JTEX(45:56),FMT='(1PE12.5)') FH
  199. IEVTEX=JTEX
  200. ITYEVO='REEL'
  201. *
  202. * 1 - TRACTION COMPRESSION
  203. * 2 - TORSION
  204. *
  205. DO 150 ITRACT=1,2
  206. *
  207. IF (ITRACT.EQ.1) THEN
  208. K0=0
  209. CT=CTC
  210. RT=RTC
  211. PAS = PASTC
  212. NPAS = NPASTC
  213. INDICE='TRACTION'
  214. ELSE
  215. K0=2
  216. CT=CTO
  217. RT=RTO
  218. PAS = PASTO
  219. NPAS = NPASTO
  220. INDICE='TORSION '
  221. END IF
  222. *
  223. * 2) INSTANTS DE DEFINITION DES FONCTIONS DE GREEN ET DERIVEES.
  224. * ----------------------------------------------------------
  225. *
  226. * ON COMMENCE A L'INSTANT "-PAS" POUR BIEN METTRE EN EVIDENCE
  227. * QUE LES FONCTIONS SONT INITIALEMENT NULLES.
  228. *
  229. NBTEMP=NINT(TEMPS/PAS) + 1
  230. JG=NBTEMP
  231. SEGINI MLREEL
  232. INSTAN = MLREEL
  233. TEMP0 = 0.D0
  234. TEMP = TEMP0
  235. DO 100 NP=1,NBTEMP
  236. PROG(NP)=TEMP
  237. TEMP=TEMP+PAS
  238. 100 CONTINUE
  239. * END DO
  240. SEGDES MLREEL
  241. *
  242. * 3) VALEURS DES FONCTIONS DE GREEN ET DERIVEES.
  243. * -------------------------------------------
  244. *
  245. *+* AVEC LA FLEXION INTEGREE NUMERIQUEMENT, IL FAUDRA METTRE CETTE
  246. *+* BOUCLE 140 EN TETE.
  247. *
  248. DO 140 I=1,4
  249. *
  250. IF (I.EQ.3) K0 = K0+12
  251. K = K0 + I
  252. SEGINI KEVOLL
  253. IEVOLL(K)=KEVOLL
  254. *
  255. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  256. WRITE (ITEX(24:35),FMT='(1PE12.5)') CT
  257. WRITE (ITEX(43:54),FMT='(1PE12.5)') RT
  258. KEVTEX=ITEX // ' ' // INDICE
  259. TYPX='LISTREEL'
  260. TYPY='LISTREEL'
  261. NUMEVX = 4
  262. NUMEVY='REEL'
  263. IPROGX = INSTAN
  264. JG = NBTEMP
  265. SEGINI MLREEL
  266. IGREEN(I) = MLREEL
  267. IPROGY=MLREEL
  268. NOMEVX='TEMPS (S)'
  269. IF (I .LT. 3) THEN
  270. NOMEVY=NOMFCT(I)
  271. ELSE
  272. NOMEVY=NOMFCT(I+3)
  273. END IF
  274. *
  275. SEGDES KEVOLL
  276. * LE "LISTREEL" DE FONCTION DE GREEN EST LAISSE ACTIF.
  277. 140 CONTINUE
  278. * END DO
  279. *
  280. CSTE = 2.D0*XPI*RT/CT
  281. XK1 = CSTE * FB
  282. IF (FH .LT. XPETIT) THEN
  283. XK2 = CSTE / (2.D0 * PAS)
  284. ELSE
  285. XK2 = CSTE * FH
  286. END IF
  287. TETA0 = TEMP0 * CT/RT
  288. DTETA = PAS * CT/RT
  289. DTET2 = DTETA / 2.D0
  290. *
  291. * EXTREMITE X=0 :
  292. *
  293. G0 = IGREEN(1)
  294. DG0 = IGREEN(2)
  295. TETA = TETA0
  296. GNULLE = .TRUE.
  297. DO 120 NP=1,NBTEMP
  298. IF (TETA .LT. -DTET2) THEN
  299. G0.PROG(NP)=0.D0
  300. DG0.PROG(NP)=0.D0
  301. ELSE
  302. IF (TETA .LT. XPETIT) THEN
  303. DELTK = XGRAND
  304. ELSE
  305. DELTK = XPI / (4.D0 * ABS(TETA) )
  306. END IF
  307. G0.PROG(NP)=
  308. & XINTGR(NIN,GRET,XK1,XK2,TETA,ZERO,DELTK)/XPI
  309. DG0.PROG(NP)=
  310. & XINTGR(NIN,DGRET,XK1,XK2,TETA,ZERO,DELTK)/XPI
  311. IF (GNULLE) THEN
  312. GNULLE = .FALSE.
  313. DG0.PROG(NP) = DG0.PROG(NP) * 0.5D0
  314. END IF
  315. END IF
  316. TETA=TETA+DTETA
  317. 120 CONTINUE
  318. * END DO
  319. *
  320. *+* APPLICATION ARTIFICIELLE D'UN RETARD A DG/DX :
  321. *
  322. DO 130 IB=NBTEMP,2,-1
  323. DG0.PROG(IB) = DG0.PROG(IB-1)
  324. 130 CONTINUE
  325. * END DO
  326. DG0.PROG(1) = 0.D0
  327. *
  328. * EXTREMITE X=L :
  329. *
  330. GL = IGREEN(3)
  331. DGL = IGREEN(4)
  332. DO 122 NP=1,NPAS
  333. GL.PROG(NP)=0.D0
  334. DGL.PROG(NP)=0.D0
  335. 122 CONTINUE
  336. * END DO
  337. DO 124 NP=(NPAS+1),NBTEMP
  338. GL.PROG(NP)=G0.PROG(NP-NPAS)
  339. DGL.PROG(NP)=DG0.PROG(NP-NPAS)
  340. 124 CONTINUE
  341. * END DO
  342. *
  343. SEGDES,G0,GL,DG0,DGL
  344. *
  345. 150 CONTINUE
  346. * END DO
  347. *
  348. *
  349. C--------------------------------------------------------------
  350. JG = NINT(TEMPS/DELTAT)
  351. SEGINI MLREE1
  352. TEMP=0.D0
  353. DO 10 NP=1,JG
  354. TEMP=TEMP+DELTAT
  355. MLREE1.PROG(NP)=TEMP
  356. 10 CONTINUE
  357. SEGDES MLREE1
  358. LAB=NBTEMP+1
  359. SEGINI MAB
  360. C
  361. C 3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
  362. C
  363. CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,JG)
  364. K=4
  365. DO 80 I=1,10
  366. SEGINI KEVOLL
  367. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  368. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  369. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
  370. KEVTEX=ITEX // ' FLEXION XOY'
  371. TYPX='LISTREEL'
  372. TYPY='LISTREEL'
  373. NUMEVX=4
  374. NUMEVY='REEL'
  375. IPROGX=MLREE1
  376. SEGINI MLREEL
  377. IPROGY=MLREEL
  378. NOMEVX='TEMPS (S)'
  379. NOMEVY=NOMFCT(I)
  380. DO 70 NP=1,JG
  381. PROG(NP)=AB(I,NP)
  382. 70 CONTINUE
  383. K=K+1
  384. IF (I.EQ.6) K=19
  385. IEVOLL(K)=KEVOLL
  386. SEGDES KEVOLL,MLREEL
  387. 80 CONTINUE
  388. C
  389. C 4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
  390. C
  391. DIF=ABS(1.D0-RFY/RFZ)
  392. IF (DIF.GT.EPS) THEN
  393. CALL GFLEX1(AB,DLL,RFY,CTC,DELTAT,JG)
  394. END IF
  395. K=9
  396. DO 200 I=1,10
  397. SEGINI KEVOLL
  398. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  399. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  400. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
  401. KEVTEX=ITEX // ' FLEXION XOZ'
  402. TYPX='LISTREEL'
  403. TYPY='LISTREEL'
  404. NUMEVX=4
  405. NUMEVY='REEL'
  406. IPROGX=MLREE1
  407. NOMEVX='TEMPS (S)'
  408. NOMEVY=NOMFCT(I)
  409. SEGINI MLREEL
  410. IPROGY=MLREEL
  411. DO 90 NP=1,JG
  412. PROG(NP)=AB(I,NP)
  413. 90 CONTINUE
  414. K=K+1
  415. IF (I.EQ.6) K=24
  416. IEVOLL(K)=KEVOLL
  417. SEGDES KEVOLL,MLREEL
  418. 200 CONTINUE
  419. SEGSUP,MAB
  420. *
  421. SEGDES MEVOLL
  422. KGREEN = MEVOLL
  423. *
  424. END
  425.  
  426.  
  427.  
  428.  
  429.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales