Télécharger lispk2.eso

Retour à la liste

Numérotation des lignes :

  1. C LISPK2 SOURCE CHAT 05/01/13 01:22:52 5004
  2. SUBROUTINE LISPK2(XE,EPAI,V1,XMAT,XSTRS,XCAR,VAR,NSTRS,
  3. 1 NPOINT,MELE,XPREC,XEL,BPSS,REL,I70,I343,I157,I158,ILO11,KERRE)
  4. C=======================================================================
  5. C
  6. C EBERSOLT MARS 85
  7. C ENTREES
  8. C XE(3,4) = COORDONNEES DE LA POUTRE LINESPRING
  9. C EPAI = EPAISSEUR NOEUDS 1 2 3 4
  10. C V1(3) = VECTEUR ORIENTANT LES NOEUDS 1 2 3 4
  11. C XMAT(15) = MATERIAU
  12. C XSTRS(NBGS*NSTRS) = CONTRAINTES DANS LE LINESPRING
  13. C XCAR(15) = CARACTERISTIQUES
  14. C VAR(NBGS*NSTRS) = CONTRAINTES DANS LE LINESPRING
  15. C NSTRS = NOMBRE DE CONTRAINTES
  16. C NPOINT = NOMBRE DE POINTS D INTEGRATION
  17. C MELE = 30 OU 50 NUMERO DE L ELEMENT
  18. C XPREC = PRECISION
  19. C TABLEAU DE TRAVAIL
  20. C XEL(3,3) = COORDONNEES LOCALES
  21. C BPSS(3,3) = MATRICE DE PASSAGE
  22. C SORTIES
  23. C REL(24,24) = MATRICE DE RIGIDITE AXES GLOBAUX
  24. C I70 = INDICERNABILITE DES 2 LEVRES
  25. C I343 = LA FISSURE DE PROFONDEUR NEGATIVE
  26. C I157 = LES 2 LEVRES SONT TROP ELOIGNEES
  27. C I158 = FISSURE TOTALEMENT TRAVERSANTE RIGIDITE NULLE
  28. C ILO11=-1 = EN DEHORS DE LA SURFACE DE CHARGE
  29. C 1 C EST O.K.
  30. C KERRE = 0 O.K.
  31. C 30 CONTRAINTE ULTIME NULLE
  32. C=======================================================================
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35. PARAMETER(X774=.774596669241483D0)
  36. PARAMETER(IZERO=0)
  37. PARAMETER(EPS=1.D-3,PENA=1.D6,PENB=1.D2,EPSINV=1.D-3)
  38. PARAMETER(XZER=0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,SIX=6.D0)
  39. PARAMETER(DOUZE=12.D0,TRSIX=36.D0,QUATRE=4.D0)
  40. C
  41. DIMENSION XE(3,*),REL(24,*),V1(*),BPSS(3,*),XEL(3,*)
  42. DIMENSION XSTRS(*),XMAT(*),XCAR(*),VAR(*)
  43. DIMENSION S(3),POIDS(3)
  44. C
  45. XPRECM = - XPREC * UNDEMI
  46. XPRECP = XPREC * UNDEMI
  47. ILO11=1
  48. KERRE=0
  49. C
  50. S(1)=-X774
  51. S(2)= XZER
  52. S(3)= X774
  53. POIDS(1)=5.D0/9.D0
  54. POIDS(2)=8.D0/9.D0
  55. POIDS(3)=5.D0/9.D0
  56. C
  57. C MISE A XZER DE LA RIGIDITE ET DES INDICATEURS D ERREUR
  58. C
  59. CALL ZERO(REL,24,24)
  60. I70 =0
  61. I343=0
  62. I157=0
  63. I158=0
  64. C
  65. IF(XCAR(2).LT.XZER) THEN
  66. I343=1
  67. FIS10=XZER
  68. ELSE
  69. FIS10=XCAR(2)
  70. ENDIF
  71. C
  72. IF(XCAR(12).LT.XZER) THEN
  73. I343=1
  74. FIS30=XZER
  75. ELSE
  76. FIS30=XCAR(12)
  77. ENDIF
  78. C
  79. C EXTRACTION DE LA MATRICE DE PASSAGE
  80. C
  81. DO 100 IA=1,3
  82. XEL(IA,1)=XE(IA,1)
  83. XEL(IA,2)=XE(IA,2)
  84. XEL(IA,3)=XE(IA,1)+V1(IA)
  85. 100 CONTINUE
  86. CALL VPAST(XEL,BPSS)
  87. DJA1=XZER
  88. DJA2=XZER
  89. DO 105 IA=1,3
  90. DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA)
  91. DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA)
  92. 105 CONTINUE
  93. DJAC=DJA1*DJA2
  94. IF(DJAC.LT.0.) I195=1
  95. C
  96. C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3
  97. C
  98. HAUT=XZER
  99. XLARG1=XZER
  100. XLARG2=XZER
  101. DO 110 IA=1,3
  102. HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT
  103. XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1
  104. XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2
  105. 110 CONTINUE
  106. HAUT =SQRT(HAUT)
  107. XLARG1=SQRT(XLARG1)
  108. XLARG2=SQRT(XLARG2)
  109. EPS1=XLARG1/HAUT
  110. EPS2=XLARG2/HAUT
  111. IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1
  112. DJA1=DJA1/HAUT
  113. DJA2=DJA2/HAUT
  114. IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1
  115. ASUR1=FIS10/EPAI
  116. ASUR3=FIS30/EPAI
  117. ASUR0=(FIS10 + FIS30 ) / EPAI
  118. IF(ASUR1.GT..98.AND.ASUR3.GT..98) I158=1
  119. IF(I158.EQ.1) GOTO 666
  120. C
  121. C ON RECUPERE LES VALEURS DU MODULE D YOUNG
  122. C
  123. YOU = XMAT(1)
  124. XNU = XMAT(2)
  125. SIGY= XMAT(5)
  126. C
  127. C PENALISATION NORMALE
  128. C
  129. DDD = YOU * UNDEMI / ( UN - XNU * XNU )
  130. PEWM=DDD *EPAI*PENA*HAUT/SIX
  131. PEWF=PEWM*EPAI*EPAI/DOUZE
  132. PEWM2=DEUX*PEWM
  133. PEWF2=DEUX*PEWF
  134. C
  135. C PENALISATION SOUS INTEGRE
  136. C
  137. PEWM15=DDD*EPAI*PENB*HAUT/QUATRE
  138. PEWF15=PEWM15*EPAI*EPAI/DOUZE
  139. C
  140. C PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE
  141. C
  142. IF(ASUR0.GT.EPSINV) GOTO 366
  143. REL(3 ,3 )=PEWM2
  144. REL(4 ,4 )=PEWF2
  145. REL(9 ,9 )=PEWM2
  146. REL(10,10)=PEWF2
  147. REL(3 ,9 )=PEWM
  148. REL(9 ,3 )=PEWM
  149. REL(10,4 )=PEWF
  150. REL(4 ,10)=PEWF
  151. GOTO 466
  152. 366 CONTINUE
  153. C
  154. C INTEGRATION NORMALE
  155. C
  156. X1=XZER
  157. X2=XZER
  158. X3=XZER
  159. X4=XZER
  160. X5=XZER
  161. X6=XZER
  162. X7=XZER
  163. X8=XZER
  164. X9=XZER
  165. DO 500 IA=1,NPOINT
  166. H1=UNDEMI-UNDEMI*S(IA)
  167. H2=UNDEMI+UNDEMI*S(IA)
  168. NCC = ( IA - 1 ) * 5
  169. NSS = ( IA - 1 ) * NSTRS
  170. NVV = ( IA - 1 ) * 2
  171. NMM = ( IA - 1 ) * 5
  172. C
  173. ASURW=XCAR(NCC+2)/EPAI
  174. YOU = XMAT(NMM+1)
  175. XNU = XMAT(NMM+2)
  176. SIGY= XMAT(NMM+5)
  177. IF(SIGY.LE.XZER) KERRE=30
  178. DDD = YOU * UNDEMI / ( UN - XNU * XNU )
  179. CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA)
  180. DELTA=POIDS(IA)*DDD*HAUT*UNDEMI/DELTA
  181. C
  182. D11 = DELTA * ALFF
  183. D12 = DELTA * ALMF * EPAI / SIX
  184. D21 = DELTA * ALMF * EPAI / SIX
  185. D22 = DELTA * ALMM * EPAI * EPAI / TRSIX
  186. C
  187. C CALCUL DES DERIVEES
  188. C
  189. IF(SIGY.EQ.XZER) GOTO 111
  190. CALL LISPPA(ASURW,EPAI,SIGY,GA,GB,A,B,C,D,E,F)
  191. XN = XSTRS(NSS+1)
  192. XM = XSTRS(NSS+4)
  193. C
  194. C VERIFICATION A L INTERIEUR DE LA SURFACE DE CHARGE OU PAS
  195. C
  196. CALL LISPQ(XN,XM,EPAI,SIGY,GA,GB,ASURW,Q)
  197. IF(VAR(NVV+1).EQ.XZER.AND.Q.LE.XZER) THEN
  198. ILOPL=0
  199. ELSE IF(VAR(NVV+1).EQ.XZER.AND.Q.GT.XZER) THEN
  200. ILOPL=-1
  201. ILO11=-1
  202. ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.LT.XPRECM) THEN
  203. ILOPL=0
  204. ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GE.XPRECM.AND.Q.LE.XPRECP) THEN
  205. ILOPL=1
  206. ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GT.XPRECP) THEN
  207. ILOPL=-1
  208. ILO11=-1
  209. ENDIF
  210. C
  211. C MATRICE DE RAIDEUR OU MATRICE TANGENTE
  212. C
  213. IF(ILOPL.EQ.1) THEN
  214. DFIDN = A * XN + B * XM + E
  215. DFIDM = B * XN + D * XM + F
  216. U = D11 * DFIDN + D12 * DFIDM
  217. V = D21 * DFIDN + D22 * DFIDM
  218. C
  219. DENOM = U * DFIDN + V * DFIDM
  220. D11 = D11 - U * U / DENOM
  221. D12 = D12 - U * V / DENOM
  222. D21 = D21 - V * U / DENOM
  223. D22 = D22 - V * V / DENOM
  224. ENDIF
  225. 111 CONTINUE
  226. C
  227. X1=X1+H1*H1*D11
  228. X2=X2-H1*H1*D12
  229. X3=X3+H1*H1*D22
  230. C
  231. X4=X4+H1*H2*D11
  232. X5=X5-H1*H2*D12
  233. X6=X6+H1*H2*D22
  234. C
  235. X7=X7+H2*H2*D11
  236. X8=X8-H2*H2*D12
  237. X9=X9+H2*H2*D22
  238. 500 CONTINUE
  239. C
  240. C MISE EN PLACE DANS LA MATRICE DE RIGIDITE
  241. C
  242. REL(3 ,3 )=X1
  243. REL(3 ,4 )=X2
  244. REL(4 ,3 )=X2
  245. REL(4 ,4 )=X3
  246. C
  247. REL(9 ,3 )=X4
  248. REL(9 ,4 )=X5
  249. REL(10,3 )=X5
  250. REL(10,4 )=X6
  251. C
  252. REL(3 ,9 )=X4
  253. REL(3 ,10)=X5
  254. REL(4 ,9 )=X5
  255. REL(4 ,10)=X6
  256. C
  257. REL(9 ,9 )=X7
  258. REL(9 ,10)=X8
  259. REL(10,9 )=X8
  260. REL(10,10)=X9
  261. C
  262. C PENALISATION DES TERMES NE CONCERNANT PAS K I
  263. C
  264. 466 CONTINUE
  265. C
  266. IF(MELE.EQ.30) THEN
  267. REL(1 ,1 )=PEWM2
  268. REL(2 ,2 )=PEWM2
  269. REL(6 ,6 )=PEWF2
  270. C
  271. REL(7 ,7 )=PEWM2
  272. REL(8 ,8 )=PEWM2
  273. REL(12,12)=PEWF2
  274. C
  275. REL(1 ,7 )=PEWM
  276. REL(7 ,1 )=PEWM
  277. REL(2 ,8 )=PEWM
  278. REL(8 ,2 )=PEWM
  279. REL(6 ,12)=PEWF
  280. REL(12,6 )=PEWF
  281. C
  282. ELSE IF(MELE.EQ.50) THEN
  283. REL(1 ,1 )=PEWM15
  284. REL(2 ,2 )=PEWM15
  285. REL(6 ,6 )=PEWF15
  286. C
  287. REL(7 ,7 )=PEWM15
  288. REL(8 ,8 )=PEWM15
  289. REL(12,12)=PEWF15
  290. C
  291. REL(1 ,7 )=PEWM15
  292. REL(7 ,1 )=PEWM15
  293. REL(2 ,8 )=PEWM15
  294. REL(8 ,2 )=PEWM15
  295. REL(6 ,12)=PEWF15
  296. REL(12,6 )=PEWF15
  297. ENDIF
  298. C
  299. C DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24 24
  300. C
  301. DO 900 IA=1,6
  302. DO 900 IB=1,6
  303. C
  304. REL(IA+18,IB+18)= REL(IA ,IB )
  305. REL(IA ,IB+18)=-REL(IA ,IB )
  306. REL(IA+18,IB )=-REL(IA ,IB )
  307. C
  308. REL(IA+12,IB+12)= REL(IA+6,IB+6)
  309. REL(IA+6 ,IB+12)=-REL(IA+6,IB+6)
  310. REL(IA+12,IB+6 )=-REL(IA+6,IB+6)
  311. C
  312. REL(IA+12,IB+18)= REL(IA+6,IB )
  313. REL(IA+18,IB+12)= REL(IA+6,IB )
  314. C
  315. REL(IA ,IB+12)=-REL(IA+6,IB )
  316. REL(IA+12,IB )=-REL(IA+6,IB )
  317. C
  318. REL(IA+18,IB+6 )=-REL(IA+6,IB )
  319. REL(IA+6 ,IB+18)=-REL(IA+6,IB )
  320. C
  321. 900 CONTINUE
  322. C
  323. C CHANGEMENT DU REPERE EN FONCTION DE BPSS
  324. C
  325. CALL TRANSK(REL,BPSS,24,4,IZERO)
  326. C
  327. 666 CONTINUE
  328. RETURN
  329. END
  330.  
  331.  

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