Télécharger lispr3.eso

Retour à la liste

Numérotation des lignes :

  1. C LISPR3 SOURCE CHAT 05/01/13 01:23:34 5004
  2. SUBROUTINE LISPR3(XE,EPA1,FISS1,V1,EPA2,FISS2,V2,D,XEL,BPSS,
  3. 1 REL,I70,I343,I157,I158)
  4. C=======================================================================
  5. C
  6. C EBERSOLT MARS 85
  7. C ENTREES
  8. C XE(3,4) = COORDONNEES DE LA POUTRE LINESPRING
  9. C EPA1 = EPAISSEUR NOEUDS 1 4
  10. C EPA2 = EPAISSEUR NOEUDS 2 3
  11. C FISS1 = PROFONDEUR DE LA FISSURE NOEUDS 1 4
  12. C FISS2 = PROFONDEUR DE LA FISSURE NOEUDS 2 3
  13. C V1(3) = VECTEUR ORIENTANT LES NOEUDS 1 4
  14. C V2(3) = VECTEUR ORIENTANT LES NOEUDS 2 3
  15. C D(2,2) = MATRICE DE HOOKE
  16. C TABLEAU DE TRAVAIL
  17. C XEL(3,3) = COORDONNEES LOCALES
  18. C BPSS(3,3) = MATRICE DE PASSAGE
  19. C SORTIES
  20. C REL(24,24) = MATRICE DE RIGIDITE AXES GLOBAUX
  21. C I70 = INDICERNABILITE DES 2 LEVRES
  22. C I343 = PROFONDEUR DE FISSURE NEGATIVE
  23. C I157 = LES 2 LEVRES SONT TROP ELOIGNEES
  24. C I158 = FISSURE TOTALEMENT TRAVERSANTE RIGIDITE NULLE
  25. C
  26. C=======================================================================
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. PARAMETER ( PENA = 1.D6,PENB = 1.D2 )
  30. PARAMETER ( EPS = 1.D-3,EPSINV = 1.D-3)
  31. PARAMETER ( XZER=0.D0,UNDEMI=.5D0,DEUX=2.D0,SIX=6.D0)
  32. PARAMETER ( QUATRE=4.D0,DOUZE=12.D0,TRSIX=36.D0)
  33. PARAMETER ( NPOINT=3,IZERO=0)
  34. PARAMETER ( X774=.774596669241483D0)
  35.  
  36. DIMENSION XE(3,*),D(2,*),REL(24,*),V1(*),V2(*),BPSS(3,*),XEL(3,*)
  37. DIMENSION S(3),POIDS(3)
  38. C
  39. C
  40. S(1)=-X774
  41. S(2)= XZER
  42. S(3)= X774
  43. POIDS(1)=5.D0/9.D0
  44. POIDS(2)=8.D0/9.D0
  45. POIDS(3)=5.D0/9.D0
  46. C
  47. C LES FISS1 ET FISS2 QUE L ON RECUPERE SONT AUX POINTS DE GAUSS
  48. C IL FAUT LES CALCULER AUX EXTREMITES
  49. C
  50. FIS10 = (FISS1*(UNDEMI +UNDEMI/X774))+(FISS2*(UNDEMI-UNDEMI/X774))
  51. FIS20 = (FISS1*(UNDEMI -UNDEMI/X774))+(FISS2*(UNDEMI+UNDEMI/X774))
  52. C
  53. C MISE A XZER DE LA RIGIDITE ET DES INDICATEURS D ERREUR
  54. C
  55. CALL ZERO(REL,24,24)
  56. I70 =0
  57. I343=0
  58. I157=0
  59. I158=0
  60. C
  61. IF(FIS10.LT.XZER) THEN
  62. I343=1
  63. FIS10=XZER
  64. ENDIF
  65. C
  66. IF(FIS20.LT.XZER) THEN
  67. I343=1
  68. FIS20=XZER
  69. ENDIF
  70. C
  71. C EXTRACTION DE LA MATRICE DE PASSAGE
  72. C
  73. DO 100 IA=1,3
  74. XEL(IA,1)=XE(IA,1)
  75. XEL(IA,2)=XE(IA,2)
  76. XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI
  77. 100 CONTINUE
  78. CALL VPAST(XEL,BPSS)
  79. DJA1=XZER
  80. DJA2=XZER
  81. DO 105 IA=1,3
  82. DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA)
  83. DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA)
  84. 105 CONTINUE
  85. DJAC=DJA1*DJA2
  86. IF(DJAC.LT.0.) I195=1
  87. C
  88. C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3
  89. C
  90. HAUT=XZER
  91. XLARG1=XZER
  92. XLARG2=XZER
  93. DO 110 IA=1,3
  94. HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT
  95. XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1
  96. XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2
  97. 110 CONTINUE
  98. HAUT =SQRT(HAUT)
  99. XLARG1=SQRT(XLARG1)
  100. XLARG2=SQRT(XLARG2)
  101. EPS1=XLARG1/HAUT
  102. EPS2=XLARG2/HAUT
  103. IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1
  104. DJA1=DJA1/HAUT
  105. DJA2=DJA2/HAUT
  106. IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1
  107. C
  108. C ASURW = A / W NOTATION CHEISSOUX
  109. C
  110. W=(EPA1+EPA2)*UNDEMI
  111. ASURW=(FIS10+FIS20)/W
  112. ASUR1=FIS10/W
  113. ASUR2=FIS20/W
  114. IF(ASUR1.GT..98.AND.ASUR2.GT..98) I158=1
  115. IF(I158.EQ.1) GOTO 666
  116. C
  117. C PENALISATION NORMALE
  118. C
  119. PEWM=D(1,1)*W*PENA*HAUT/SIX
  120. PEWF=PEWM*W*W/DOUZE
  121. PEWM2=DEUX*PEWM
  122. PEWF2=DEUX*PEWF
  123. C
  124. C PENALISATION SOUS INTEGRE
  125. C
  126. PEWM15=D(1,1)*W*PENB*HAUT/QUATRE
  127. PEWF15=PEWM15*W*W/DOUZE
  128. C
  129. C PENALISATION SI ELEMENT EXTREME
  130. C
  131. PEWMEX=D(1,1)*W*PENA*HAUT*UNDEMI
  132. PEWFEX=PEWMEX*W*W/DOUZE
  133. C
  134. C PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE
  135. C
  136. IF(ASURW.GT.EPSINV) GOTO 366
  137. REL(3 ,3 )=PEWM2
  138. REL(4 ,4 )=PEWF2
  139. REL(9 ,9 )=PEWM2
  140. REL(10,10)=PEWF2
  141. REL(3 ,9 )=PEWM
  142. REL(9 ,3 )=PEWM
  143. REL(4 ,10)=PEWF
  144. REL(10,4 )=PEWF
  145. GOTO 466
  146. 366 CONTINUE
  147. C
  148. C INTEGRATION NORMALE
  149. C
  150. X1=XZER
  151. X2=XZER
  152. X3=XZER
  153. X4=XZER
  154. X5=XZER
  155. X6=XZER
  156. X7=XZER
  157. X8=XZER
  158. X9=XZER
  159. DO 500 IA=1,NPOINT
  160. H1=UNDEMI-UNDEMI*S(IA)
  161. H2=UNDEMI+UNDEMI*S(IA)
  162. ASURW=H1*ASUR1+H2*ASUR2
  163. CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA)
  164. DELTA=POIDS(IA)*D(1,1)*HAUT*UNDEMI/DELTA
  165. C
  166. X1=X1+H1*H1*DELTA*ALFF
  167. X2=X2-H1*H1*DELTA*ALMF*W/SIX
  168. X3=X3+H1*H1*DELTA*ALMM*W*W/TRSIX
  169. C
  170. X4=X4+H1*H2*DELTA*ALFF
  171. X5=X5-H1*H2*DELTA*ALMF*W/SIX
  172. X6=X6+H1*H2*DELTA*ALMM*W*W/TRSIX
  173. C
  174. X7=X7+H2*H2*DELTA*ALFF
  175. X8=X8-H2*H2*DELTA*ALMF*W/SIX
  176. X9=X9+H2*H2*DELTA*ALMM*W*W/TRSIX
  177. 500 CONTINUE
  178. C
  179. C MISE EN PLACE DANS LA MATRICE DE RIGIDITE
  180. C
  181. REL(3 ,3 )=X1
  182. REL(3 ,4 )=X2
  183. REL(4 ,3 )=X2
  184. REL(4 ,4 )=X3
  185. C
  186. REL(9 ,3 )=X4
  187. REL(9 ,4 )=X5
  188. REL(10,3 )=X5
  189. REL(10,4 )=X6
  190. C
  191. REL(3 ,9 )=X4
  192. REL(3 ,10)=X5
  193. REL(4 ,9 )=X5
  194. REL(4 ,10)=X6
  195. C
  196. REL(9 ,9 )=X7
  197. REL(9 ,10)=X8
  198. REL(10,9 )=X8
  199. REL(10,10)=X9
  200. C
  201. C PENALISATION DES TERMES NE CONCERNANT PAS K I
  202. C
  203. 466 CONTINUE
  204. C
  205. REL(1 ,1 )=PEWM15
  206. REL(2 ,2 )=PEWM15
  207. REL(6 ,6 )=PEWF15
  208. C
  209. REL(7 ,7 )=PEWM15
  210. REL(8 ,8 )=PEWM15
  211. REL(12,12)=PEWF15
  212. C
  213. REL(1 ,7 )=PEWM15
  214. REL(7 ,1 )=PEWM15
  215. REL(2 ,8 )=PEWM15
  216. REL(8 ,2 )=PEWM15
  217. REL(6 ,12)=PEWF15
  218. REL(12,6 )=PEWF15
  219. C
  220. C DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24 24
  221. C
  222. DO 900 IA=1,6
  223. DO 900 IB=1,6
  224. C
  225. REL(IA+18,IB+18)= REL(IA ,IB )
  226. REL(IA ,IB+18)=-REL(IA ,IB )
  227. REL(IA+18,IB )=-REL(IA ,IB )
  228. C
  229. REL(IA+12,IB+12)= REL(IA+6,IB+6)
  230. REL(IA+6 ,IB+12)=-REL(IA+6,IB+6)
  231. REL(IA+12,IB+6 )=-REL(IA+6,IB+6)
  232. C
  233. REL(IA+12,IB+18)= REL(IA+6,IB )
  234. REL(IA+18,IB+12)= REL(IA+6,IB )
  235. C
  236. REL(IA ,IB+12)=-REL(IA+6,IB )
  237. REL(IA+12,IB )=-REL(IA+6,IB )
  238. C
  239. REL(IA+18,IB+6 )=-REL(IA+6,IB )
  240. REL(IA+6 ,IB+18)=-REL(IA+6,IB )
  241. C
  242. 900 CONTINUE
  243. C
  244. C CHANGEMENT DU REPERE EN FONCTION DE BPSS
  245. C
  246. CALL TRANSK(REL,BPSS,24,4,IZERO)
  247. C
  248. 666 CONTINUE
  249. RETURN
  250. END
  251.  
  252.  

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