Télécharger green1.eso

Retour à la liste

Numérotation des lignes :

  1. C GREEN1 SOURCE BP208322 16/11/18 21:17:28 9177
  2. C
  3. SUBROUTINE GREEN1(KMATER,KCARAC,DLL,TEMPS,DELTAT,F1,F2,KGREEN)
  4. C
  5. C =====================================================================
  6. C APPELE PAR GREEN
  7. C
  8. C IL EST A NOTER QUE POUR LA FLEXION , DANS LE CAS NON FILTRE ,
  9. C L'AIGUILLAGE NE SE FAIT PLUS SUR GFLEX1 MAIS SUR GFLEX0.
  10. C TOUTEFOIS IL EST POSSIBLE DE FAIRE LE CALCUL AVEC GFLEX1 EN
  11. C CHANGEANT LA VALEUR DE ITEST
  12. C
  13. C
  14. C VERSION : 21/09/86
  15. C PROGRAMMEUR : GUILBAUD
  16. C MODIFICATIONS: LIONEL VIVAN 15/02/88
  17. C : PASCAL MANIGOT 02/03/88
  18. C : XAVIER VACELET 09/01/89
  19. C
  20. C =====================================================================
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. C
  25. -INC CCOPTIO
  26. -INC CCGEOME
  27. C
  28. -INC SMCHAML
  29. -INC SMLREEL
  30. -INC SMEVOLL
  31. C
  32. SEGMENT MAB
  33. REAL*8 AB(10,LAB)
  34. ENDSEGMENT
  35. CHARACTER*12 NOMFCT(10)
  36. CHARACTER*40 CHA1
  37. CHARACTER*40 CHA2
  38. CHARACTER*40 CHA3
  39. CHARACTER*57 ITEX
  40. CHARACTER *72 JTEX
  41. DATA NOMFCT/'G(X=0) ','DG/DX(X=0) ','D2G/DX2(X=0)',
  42. & 'D3G/DX3(X=0)','D4G/DX4(X=0)',
  43. & 'G(X=L) ','DG/DX(X=L) ','D2G/DX2(X=L)',
  44. & 'D3G/DX3(X=L)','D4G/DX4(X=L)'/
  45. C
  46. ITEX=' L = C = RF = '
  47. JTEX='FCTS DE GREEN FILTREES DE HZ A HZ'
  48. C
  49. IF (IIMPI.EQ.1) THEN
  50. WRITE(IOIMP,*) ' DEBUT DE GREEN1 '
  51. END IF
  52. C
  53. C RECUPERATION DES CARACTERISTIQUES DYNAMIQUES DE L'ELEMENT
  54. C
  55. MCHAML=KMATER
  56. SEGACT,MCHAML
  57. MELVAL=IELVAL(1)
  58. SEGACT,MELVAL
  59. E =VELCHE(1,1)
  60. SEGDES,MELVAL
  61. MELVAL=IELVAL(2)
  62. SEGACT,MELVAL
  63. ANU=VELCHE(1,1)
  64. SEGDES,MELVAL
  65. MELVAL=IELVAL(3)
  66. SEGACT,MELVAL
  67. RHO=VELCHE(1,1)
  68. SEGDES,MELVAL
  69. SEGDES,MCHAML
  70. C
  71. MCHAML=KCARAC
  72. SEGACT,MCHAML
  73. MELVAL=IELVAL(1)
  74. SEGACT,MELVAL
  75. TORS=VELCHE(1,1)
  76. SEGDES,MELVAL
  77. MELVAL=IELVAL(2)
  78. SEGACT,MELVAL
  79. AINRY=VELCHE(1,1)
  80. SEGDES,MELVAL
  81. MELVAL=IELVAL(3)
  82. SEGACT,MELVAL
  83. AINRZ=VELCHE(1,1)
  84. SEGDES,MELVAL
  85. MELVAL=IELVAL(4)
  86. SEGACT,MELVAL
  87. SECT=VELCHE(1,1)
  88. SEGDES,MELVAL
  89. SEGDES,MCHAML
  90. C
  91. ES=E*SECT
  92. AIP=AINRY+AINRZ
  93. AMU=E/(2.D0*(1.D0+ANU))
  94. CTC=SQRT(E/RHO)
  95. RTC=SQRT(AIP/SECT)
  96. CTO=SQRT(AMU/RHO)
  97. RTO=SQRT(TORS*2.D0*(1.D0+ANU)/SECT)
  98. RFY=SQRT(AINRY/SECT)
  99. RFZ=SQRT(AINRZ/SECT)
  100. C
  101. C CREATION DE L'OBJET EVOLUTION
  102. C
  103. EPS=1.D-3
  104. LANBN=NINT(TEMPS/DELTAT)
  105. JG=LANBN
  106. SEGINI MLREE1
  107. DO 10 NP=1,LANBN
  108. MLREE1.PROG(NP)=DELTAT*DBLE(NP)
  109. 10 CONTINUE
  110. SEGDES MLREE1
  111. N=28
  112. SEGINI MEVOLL
  113. FB=1.D0/TEMPS
  114. FH=0.1D0/DELTAT
  115. WRITE (JTEX(27:38),FMT='(1PE12.5)') FB
  116. WRITE (JTEX(45:56),FMT='(1PE12.5)') FH
  117. IEVTEX=JTEX
  118. ITYEVO='REEL'
  119. LAB=LANBN+1
  120. SEGINI MAB
  121. C
  122. C 1 - TRACTION COMPRESSION
  123. C
  124. CALL GTRAC1(AB,DLL,RTC,CTC,DELTAT,LANBN,F1,F2)
  125. K=0
  126. DO 40 I=1,4
  127. SEGINI KEVOLL
  128. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  129. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  130. WRITE (ITEX(43:54),FMT='(1PE12.5)') RTC
  131. KEVTEX=ITEX // ' TRACTION'
  132. NUMEVX=IDCOUL
  133. NUMEVY='REEL'
  134. TYPX='LISTREEL'
  135. TYPY='LISTREEL'
  136. IPROGX=MLREE1
  137. JG=LANBN
  138. SEGINI MLREEL
  139. IPROGY=MLREEL
  140. NOMEVX='TEMPS (S)'
  141. II=I
  142. IF (I.GE.3) II=I+3
  143. NOMEVY=NOMFCT(II)
  144. DO 30 NP=1,LANBN
  145. PROG(NP)=AB(I,NP)
  146. 30 CONTINUE
  147. K=K+1
  148. IF (I.EQ.3) K=15
  149. IEVOLL(K)=KEVOLL
  150. SEGDES KEVOLL,MLREEL
  151. 40 CONTINUE
  152. C
  153. C 2 - TORSION
  154. C
  155. CALL GTRAC1(AB,DLL,RTO,CTO,DELTAT,LANBN,F1,F2)
  156. K=2
  157. DO 60 I=1,4
  158. SEGINI KEVOLL
  159. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  160. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTO
  161. WRITE (ITEX(43:54),FMT='(1PE12.5)') RTO
  162. KEVTEX=ITEX // ' TORSION'
  163. NUMEVX=IDCOUL
  164. NUMEVY='REEL'
  165. TYPX='LISTREEL'
  166. TYPY='LISTREEL'
  167. IPROGX=MLREE1
  168. JG=LANBN
  169. SEGINI MLREEL
  170. IPROGY=MLREEL
  171. NOMEVX='TEMPS (S)'
  172. II=I
  173. IF (I.GE.3) II=I+3
  174. NOMEVY=NOMFCT(II)
  175. DO 50 NP=1,LANBN
  176. PROG(NP)=AB(I,NP)
  177. 50 CONTINUE
  178. K=K+1
  179. IF (I.EQ.3) K=17
  180. IEVOLL(K)=KEVOLL
  181. SEGDES KEVOLL,MLREEL
  182. 60 CONTINUE
  183. C
  184. C===============================
  185. C CAS DE LA FLEXION
  186. C===============================
  187. C 3 - FLEXION DANS LE PLAN X Y ( AUTOUR DE Z )
  188. C
  189. C AIGUILLAGE VERS LES DIFFERENTS PROGRAMMES :
  190. C GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
  191. C
  192. ITEST = 1
  193. CALL LIRCHA( CHA1,1,IRETOU )
  194. IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
  195. CALL LIRCHA( CHA2,1,IRETOU )
  196. IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
  197. IF(ITEST.EQ.1) THEN
  198. CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  199. ELSE
  200. CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  201. ENDIF
  202. ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
  203. CALL LIRREE(FREQ1,1,IRETOU)
  204. CALL LIRREE(FREQ2,1,IRETOU)
  205. CALL LIRCHA(CHA3,0,IRETOU)
  206. IF (IRETOU.NE.0) THEN
  207. CALL LIRREE(EPS,1,IRETOU)
  208. CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
  209. ELSE
  210. CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
  211. ENDIF
  212. ENDIF
  213. ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
  214. CALL LIRCHA( CHA2,1,IRETOU )
  215. IF (CHA2(1:6).EQ. 'FILTRE') THEN
  216. CALL LIRREE(BETA,1,IRETOU)
  217. CALL LIRREE(FREQ1,1,IRETOU)
  218. CALL LIRREE(FREQ2,1,IRETOU)
  219. CALL LIRCHA(CHA3,0,IRETOU)
  220. IF (IRETOU.NE.0) THEN
  221. CALL LIRREE(EPS,1,IRETOU)
  222. CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
  223. ELSE
  224. CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
  225. ENDIF
  226. ENDIF
  227. ENDIF
  228. C
  229. K=4
  230. DO 80 I=1,10
  231. SEGINI KEVOLL
  232. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  233. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  234. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFZ
  235. KEVTEX=ITEX // ' FLEXION XOY'
  236. TYPX='LISTREEL'
  237. TYPY='LISTREEL'
  238. NUMEVX=IDCOUL
  239. NUMEVY='REEL'
  240. IPROGX=MLREE1
  241. JG=LANBN
  242. SEGINI MLREEL
  243. IPROGY=MLREEL
  244. NOMEVX='TEMPS (S)'
  245. NOMEVY=NOMFCT(I)
  246. DO 70 NP=1,LANBN
  247. PROG(NP)=AB(I,NP)
  248. 70 CONTINUE
  249. K=K+1
  250. IF (I.EQ.6) K=19
  251. IEVOLL(K)=KEVOLL
  252. SEGDES KEVOLL,MLREEL
  253. 80 CONTINUE
  254. C
  255. C 4 - FLEXION DANS LE PLAN X Z ( AUTOUR DE Y )
  256. C
  257. DIF=ABS(1.D0-RFY/RFZ)
  258. IF (DIF.GT.EPS) THEN
  259. C
  260. C AIGUILLAGE ENTRE LES DIFFERENTS PROGRAMMES :
  261. C GFLEX1 , GFLEX2 , GFLEX3 , GFLEX4 , GFLEX5
  262. C
  263. IF (CHA1(1:16).EQ. 'BERNOUILLI_EULER') THEN
  264. IF (CHA2(1:10).EQ. 'NON_FILTRE') THEN
  265. IF (ITEST.EQ.1) THEN
  266. CALL GFLEX0(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  267. ELSE
  268. CALL GFLEX1(AB,DLL,RFZ,CTC,DELTAT,LANBN)
  269. ENDIF
  270. ELSEIF (CHA2(1:6).EQ. 'FILTRE') THEN
  271. IF (IRETOU.NE.0) THEN
  272. CALL GFLEX3(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,EPS)
  273. ELSE
  274. CALL GFLEX2(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2)
  275. ENDIF
  276. ENDIF
  277. ELSEIF (CHA1(1:10).EQ. 'TIMOSHENKO') THEN
  278. IF (CHA2(1:6).EQ. 'FILTRE') THEN
  279. IF (IRETOU.NE.0) THEN
  280. CALL GFLEX5(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA,EPS)
  281. ELSE
  282. CALL GFLEX4(AB,DLL,RFZ,CTC,DELTAT,LANBN,FREQ1,FREQ2,BETA)
  283. ENDIF
  284. ENDIF
  285. ENDIF
  286. ENDIF
  287. C
  288. K=9
  289. DO 100 I=1,10
  290. SEGINI KEVOLL
  291. WRITE (ITEX(6:17),FMT='(1PE12.5)') DLL
  292. WRITE (ITEX(24:35),FMT='(1PE12.5)') CTC
  293. WRITE (ITEX(43:54),FMT='(1PE12.5)') RFY
  294. KEVTEX=ITEX // ' FLEXION XOZ'
  295. TYPX='LISTREEL'
  296. TYPY='LISTREEL'
  297. NUMEVX=IDCOUL
  298. NUMEVY='REEL'
  299. IPROGX=MLREE1
  300. NOMEVX='TEMPS (S)'
  301. NOMEVY=NOMFCT(I)
  302. JG=LANBN
  303. SEGINI MLREEL
  304. IPROGY=MLREEL
  305. DO 90 NP=1,LANBN
  306. PROG(NP)=AB(I,NP)
  307. 90 CONTINUE
  308. K=K+1
  309. IF (I.EQ.6) K=24
  310. IEVOLL(K)=KEVOLL
  311. SEGDES KEVOLL,MLREEL
  312. 100 CONTINUE
  313. SEGDES MEVOLL
  314. KGREEN = MEVOLL
  315. IF (IIMPI.EQ.1) THEN
  316. WRITE (IOIMP,*) ' FIN DE GREEN1 '
  317. END IF
  318. RETURN
  319. END
  320.  
  321.  
  322.  
  323.  
  324.  

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