Télécharger green2.eso

Retour à la liste

Numérotation des lignes :

  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
  134. CALL ERREUR (411)
  135. RETURN
  136. END IF
  137. IF (RHO.LT.XPETIT) THEN
  138. CALL ERREUR (412)
  139. RETURN
  140. END IF
  141.  
  142. MCHAML=KCARAC
  143. SEGACT,MCHAML
  144. MELVAL=IELVAL(1)
  145. SEGACT,MELVAL
  146. TORS=VELCHE(1,1)
  147. SEGDES,MELVAL
  148. MELVAL=IELVAL(2)
  149. SEGACT,MELVAL
  150. AINRY=VELCHE(1,1)
  151. SEGDES,MELVAL
  152. MELVAL=IELVAL(3)
  153. SEGACT,MELVAL
  154. AINRZ=VELCHE(1,1)
  155. SEGDES,MELVAL
  156. MELVAL=IELVAL(4)
  157. SEGACT,MELVAL
  158. SECT=VELCHE(1,1)
  159. SEGDES,MELVAL
  160. SEGDES,MCHAML
  161. 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. *
  221. * 2) INSTANTS DE DEFINITION DES FONCTIONS DE GREEN ET DERIVEES.
  222. * ----------------------------------------------------------
  223. *
  224. NINS0 = NINT(TEMPS/PAS) + 1
  225. *
  226. * INSTANTS DE DEFINITION DES FONCTIONS DE GREEN
  227. JG=NINS0
  228. SEGINI MLREEL
  229. INSTAN(1) = MLREEL
  230. INSTAN(3) = MLREEL
  231. TEMP0 = 0.D0
  232. TEMP = TEMP0
  233. DO 100 NP=1,NINS0
  234. PROG(NP)=TEMP
  235. TEMP=TEMP+PAS
  236. 100 CONTINUE
  237. * END DO
  238. SEGDES MLREEL
  239. *
  240. * INSTANTS DE DEFINITION DES DERIVEES PREMIERES DES FONCTIONS DE
  241. * GREEN DE TRACTION ET TORSION.
  242. NINS1T = 2 * (NINS0 - 1)
  243. JG = NINS1T
  244. SEGINI MLREEL
  245. INSTAN(2) = MLREEL
  246. INSTAN(4) = MLREEL
  247. TEMP = TEMP0
  248. PAS1 = PAS * EPS
  249. DO 110 NP=1,NINS1T,2
  250. PROG(NP) = TEMP + PAS1
  251. TEMP = TEMP + PAS
  252. PROG(NP+1) = TEMP - PAS1
  253. 110 CONTINUE
  254. * END DO
  255. SEGDES MLREEL
  256. *
  257. * 3) VALEURS DES FONCTIONS DE GREEN ET DERIVEES.
  258. * -------------------------------------------
  259. *
  260. *+* AVEC LA FLEXION INTEGREE NUMERIQUEMENT, IL FAUDRA METTRE
  261. *+* CETTE BOUCLE 140 EN TETE.
  262. *
  263. DO 140 I=1,4
  264. *
  265. IF (I.EQ.3) K0 = K0+12
  266. K = K0 + I
  267. SEGINI KEVOLL
  268. IEVOLL(K)=KEVOLL
  269. *
  270. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  271. WRITE (ITEX(24:35),FMT='(1PE12.5)') CT
  272. WRITE (ITEX(43:54),FMT='(1PE12.5)') RT
  273. KEVTEX=ITEX // ' ' // INDICE
  274. TYPX='LISTREEL'
  275. TYPY='LISTREEL'
  276. NUMEVX = 4
  277. NUMEVY='REEL'
  278. IPROGX = INSTAN(I)
  279. IF ( (I/2)*2 .EQ. I) THEN
  280. JG = NINS1T
  281. ELSE
  282. JG = NINS0
  283. END IF
  284. SEGINI MLREEL
  285. IGREEN(I) = MLREEL
  286. IPROGY=MLREEL
  287. NOMEVX='TEMPS (S)'
  288. IF (I .LT. 3) THEN
  289. NOMEVY=NOMFCT(I)
  290. ELSE
  291. NOMEVY=NOMFCT(I+3)
  292. END IF
  293. *
  294. SEGDES KEVOLL
  295. * LE "LISTREEL" DE FONCTION DE GREEN EST LAISSE ACTIF.
  296. 140 CONTINUE
  297. * END DO
  298. *
  299. CSTE = 2.D0*XPI*RT/CT
  300. XK1 = CSTE * FB
  301. IF (FH .LT. XPETIT) THEN
  302. XK2 = 1.3D0 * CSTE / DELTAT
  303. ELSE
  304. XK2 = CSTE * FH
  305. END IF
  306. TETA0 = TEMP0 * CT/RT
  307. DTETA = PAS * CT/RT
  308. DTET2 = DTETA / 2.D0
  309. *
  310. * EXTREMITE X=0 :
  311. *
  312. G0 = IGREEN(1)
  313. TETA = TETA0
  314. DO 120 NP=1,NINS0
  315. IF (TETA .LT. -DTET2) THEN
  316. G0.PROG(NP)=0.D0
  317. ELSE
  318. IF (TETA .LT. XPETIT) THEN
  319. DELTK = XGRAND
  320. ELSE
  321. DELTK = XPI / (4.D0 * ABS(TETA) )
  322. END IF
  323. G0.PROG(NP)=
  324. & XINTGR(NIN,GRET,XK1,XK2,TETA,ZERO,DELTK)/XPI
  325. END IF
  326. TETA=TETA+DTETA
  327. 120 CONTINUE
  328. * END DO
  329. DG0 = IGREEN(2)
  330. * (LA DERIVEE EN KHI EST OPPOSEE A LA DERIVEE EN TETA)
  331. DO 122 NP=1,(NINS0-1)
  332. NP2 = NP * 2
  333. VALCST = -(G0.PROG(NP+1) - G0.PROG(NP)) / DTETA
  334. DG0.PROG(NP2-1) = VALCST
  335. DG0.PROG(NP2) = VALCST
  336. 122 CONTINUE
  337. * END DO
  338. *
  339. *+* LISSAGE ARTIFICIEL DE DG/DX:
  340. *
  341. CALL MAXIM3 (DG0,IPLACE,VALMAX)
  342. VALMAX = ABS(VALMAX) * 1.D-2
  343. SEGACT,DG0
  344. DO 130 IB=1,NINS1T
  345. IF (ABS(DG0.PROG(IB)) .LT. VALMAX) THEN
  346. DG0.PROG(IB) = 0.D0
  347. END IF
  348. 130 CONTINUE
  349. * END DO
  350. *
  351. * EXTREMITE X=L :
  352. *
  353. GL = IGREEN(3)
  354. DGL = IGREEN(4)
  355. DO 132 NP=1,NPAS
  356. GL.PROG(NP)=0.D0
  357. NP2 = NP * 2
  358. DGL.PROG(NP2-1) = 0.D0
  359. DGL.PROG(NP2) = 0.D0
  360. 132 CONTINUE
  361. * END DO
  362. DO 134 NP=(NPAS+1),(NINS0-1)
  363. NP1 = NP - NPAS
  364. GL.PROG(NP) = G0.PROG(NP1)
  365. NP2 = NP * 2
  366. NP3 = NP1 * 2
  367. DGL.PROG(NP2-1) = DG0.PROG(NP3-1)
  368. DGL.PROG(NP2) = DG0.PROG(NP3)
  369. 134 CONTINUE
  370. * END DO
  371. IF (NPAS .LT. NINS0) THEN
  372. GL.PROG(NINS0) = G0.PROG(NINS0-NPAS)
  373. END IF
  374. *
  375. SEGDES,G0,GL,DG0,DGL
  376. *
  377. 150 CONTINUE
  378. * END DO
  379. *
  380. *
  381. C--------------------------------------------------------------
  382. JG=NINT(TEMPS/DELTAT)
  383. SEGINI MLREE1
  384. TEMP=0.D0
  385. DO 10 NP=1,JG
  386. TEMP=TEMP+DELTAT
  387. MLREE1.PROG(NP)=TEMP
  388. 10 CONTINUE
  389. SEGDES MLREE1
  390. LAB=JG + 1
  391. SEGINI MAB
  392. C
  393. C 3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
  394. C
  395. CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,JG)
  396. K=4
  397. DO 80 I=1,10
  398. SEGINI KEVOLL
  399. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  400. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  401. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
  402. KEVTEX=ITEX // ' FLEXION XOY'
  403. NUMEVX=4
  404. NUMEVY='REEL'
  405. TYPX='LISTREEL'
  406. TYPY='LISTREEL'
  407. IPROGX=MLREE1
  408. SEGINI MLREEL
  409. IPROGY=MLREEL
  410. NOMEVX='TEMPS (S)'
  411. NOMEVY=NOMFCT(I)
  412. DO 70 NP=1,JG
  413. PROG(NP)=AB(I,NP)
  414. 70 CONTINUE
  415. K=K+1
  416. IF (I.EQ.6) K=19
  417. IEVOLL(K)=KEVOLL
  418. SEGDES KEVOLL,MLREEL
  419. 80 CONTINUE
  420. C
  421. C 4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
  422. C
  423. DIF=ABS(1.D0-RFY/RFZ)
  424. IF (DIF.GT.EPS) THEN
  425. CALL GFLEX1(AB,DLL,RFY,CTC,DELTAT,JG)
  426. END IF
  427. K=9
  428. DO 200 I=1,10
  429. SEGINI KEVOLL
  430. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  431. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  432. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
  433. KEVTEX=ITEX // ' FLEXION XOZ'
  434. NUMEVX=4
  435. TYPX='LISTREEL'
  436. TYPY='LISTREEL'
  437. NUMEVY='REEL'
  438. IPROGX=MLREE1
  439. NOMEVX='TEMPS (S)'
  440. NOMEVY=NOMFCT(I)
  441. SEGINI MLREEL
  442. IPROGY=MLREEL
  443. DO 90 NP=1,JG
  444. PROG(NP)=AB(I,NP)
  445. 90 CONTINUE
  446. K=K+1
  447. IF (I.EQ.6) K=24
  448. IEVOLL(K)=KEVOLL
  449. SEGDES KEVOLL,MLREEL
  450. 200 CONTINUE
  451. SEGSUP,MAB
  452. *
  453. SEGDES MEVOLL
  454. KGREEN = MEVOLL
  455. *
  456. RETURN
  457. END
  458.  
  459.  
  460.  

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