Télécharger lispr2.eso

Retour à la liste

Numérotation des lignes :

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

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