Télécharger lisps3.eso

Retour à la liste

Numérotation des lignes :

  1. C LISPS3 SOURCE CHAT 05/01/13 01:23:47 5004
  2. SUBROUTINE LISPS3(XE,EPA1,FISS1,V1,EPA2,FISS2,V2,D,XDDL,XEL,BPSS,
  3. 1 XDDLOC,NPOINT,XSTRS,I69,I70,I195,I157)
  4. C=======================================================================
  5. C
  6. C EBERSOLT AVRIL 87 ELEMENT LISM
  7. C UHLMANN OCTOBRE 94
  8. C
  9. C ENTREES C ENTREES
  10. C XE(3,4) = COORDONNEES DE LA POUTRE LINESPRING
  11. C EPA1 = EPAISSEUR NOEUDS 1 4
  12. C EPA2 = EPAISSEUR NOEUDS 2 3
  13. C FISS1 = PROFONDEUR DE LA FISSURE NOEUDS 1 4
  14. C FISS2 = PROFONDEUR DE LA FISSURE NOEUDS 2 3
  15. C V1(3) = VECTEUR ORIENTANT LES NOEUDS 1 4
  16. C V2(3) = VECTEUR ORIENTANT LES NOEUDS 2 3
  17. C D(2,2) = MATRICE DE HOOKE
  18. C XDDL(24) = D.D.L. DU LINESPRING
  19. C NPOINT = NOMBRE DE POINTS DE CONTRAINTES
  20. C TABLEAU DE TRAVAIL
  21. C XEL(3,3) = COORDONNEES LOCALES
  22. C BPSS(3,3) = MATRICE DE PASSAGE
  23. C XDDLOC(24) = D.D.L. LOCAUX
  24. C SORTIES
  25. C XSTRS(NPOINT*6)= CONTRAINTES LINESPRING
  26. C I69 = FISSURE TOTALEMENT TRAVERSANTE CONTRAINTES MISES A 0
  27. C I70 = INDICERNABILITE DES 2 LEVRES
  28. C I343 = PROFONDEUR DE FISSURE NULLE
  29. C I157 = LES 2 LEVRES SONT TROP ELOIGNEES
  30. C
  31. C=======================================================================
  32. C
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35. C Include contenant quelques constantes dont XPI :
  36. -INC CCREEL
  37. PARAMETER(UNDEMI=.5D0,SIX=6.D0)
  38. PARAMETER(DOUZE=12.D0,TRSIX=36.D0)
  39. PARAMETER(EPS=2.D-3,PENA=1.D6,EPSINV=1.D-3,PENB=1.D2)
  40. PARAMETER(X774=.774596669241483D0)
  41. C
  42. DIMENSION XE(3,*),D(2,*),XSTRS(*),V1(*),V2(*),BPSS(3,*),XEL(3,*)
  43. DIMENSION S(3),XDDL(*),XDDLOC(*)
  44. C
  45. IF(NPOINT.EQ.1) THEN
  46. S(1)= XZERO
  47. ELSE IF(NPOINT.EQ.3) THEN
  48. S(1)=-X774
  49. S(2)= XZERO
  50. S(3)= X774
  51. ENDIF
  52. C
  53. C ON RECUPERE LES FISS AUX POINTS DE GAUSS IL FAUT LES CALCULER
  54. C AUX EXTREMITES
  55. C
  56. FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+(FISS2*(UNDEMI-UNDEMI/X774))
  57. FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+(FISS2*(UNDEMI+UNDEMI/X774))
  58. C
  59. NPOIN6=6*NPOINT
  60. C
  61. C MISE A ZERO DES CONTRAINTES DES INDICATEURS D ERREURS ET DES D.D.
  62. C
  63. DO 90 IA=1,NPOIN6
  64. XSTRS(IA)=XZERO
  65. 90 CONTINUE
  66. I69 =0
  67. I70 =0
  68. C I343=0
  69. I157=0
  70. I195=0
  71. C
  72. IF(FISS1.LT.XZERO) THEN
  73. C I343=1
  74. FISS1=XZERO
  75. ENDIF
  76. C
  77. IF(FISS2.LT.XZERO) THEN
  78. C I343=1
  79. FISS2=XZERO
  80. ENDIF
  81. C
  82. C EXTRACTION DE LA MATRICE DE PASSAGE
  83. C
  84. DO 100 IA=1,3
  85. XEL(IA,1)=XE(IA,1)
  86. XEL(IA,2)=XE(IA,2)
  87. XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI
  88. 100 CONTINUE
  89. C
  90. C-----------------------------------------------
  91. CALL VPAST(XEL,BPSS)
  92. CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  93. C-----------------------------------------------
  94. C système local: x,y et z
  95. C Noeud 1 (_NO1):
  96. C XNO1=(XE(1,1)*BPSS(1,1))+(XE(2,1)*BPSS(1,2))+(XE(3,1)*BPSS(1,3))
  97. C YNO1=(XE(1,1)*BPSS(2,1))+(XE(2,1)*BPSS(2,2))+(XE(3,1)*BPSS(2,3))
  98. C ZNO1=(XE(1,1)*BPSS(3,1))+(XE(2,1)*BPSS(3,2))+(XE(3,1)*BPSS(3,3))
  99. C Noeud2 (_NO2):
  100. C XNO2=(XE(1,2)*BPSS(1,1))+(XE(2,2)*BPSS(1,2))+(XE(3,2)*BPSS(1,3))
  101. C YNO2=(XE(1,2)*BPSS(2,1))+(XE(2,2)*BPSS(2,2))+(XE(3,2)*BPSS(2,3))
  102. ZNO2=(XE(1,2)*BPSS(3,1))+(XE(2,2)*BPSS(3,2))+(XE(3,2)*BPSS(3,3))
  103. C Noeud 3 (_NO3):
  104. C XNO3=(XE(1,3)*BPSS(1,1))+(XE(2,3)*BPSS(1,2))+(XE(3,3)*BPSS(1,3))
  105. C YNO3=(XE(1,3)*BPSS(2,1))+(XE(2,3)*BPSS(2,2))+(XE(3,3)*BPSS(2,3))
  106. ZNO3=(XE(1,3)*BPSS(3,1))+(XE(2,3)*BPSS(3,2))+(XE(3,3)*BPSS(3,3))
  107. C
  108. C Direction z: Différence entre noeud 2 et noeud 3:
  109. DZ23 = ZNO2 - ZNO3
  110. C ________________________________________________________________
  111. C
  112. DJA1=XZERO
  113. DJA2=XZERO
  114. DO 105 IA=1,3
  115. DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA)
  116. DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA)
  117. 105 CONTINUE
  118. DJAC=DJA1*DJA2
  119. IF(DJAC.LT.-1.D-20) I195=1
  120. C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 C HAUT
  121. C = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3
  122. HAUT=XZERO
  123. XLARG1=XZERO
  124. XLARG2=XZERO
  125. DO 110 IA=1,3
  126. HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT
  127. XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1
  128. XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2
  129. 110 CONTINUE
  130. HAUT =SQRT(HAUT)
  131. XLARG1=SQRT(XLARG1)
  132. XLARG2=SQRT(XLARG2)
  133. EPS1=XLARG1/HAUT
  134. EPS2=XLARG2/HAUT
  135. IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1
  136. DJA1=DJA1/HAUT
  137. DJA2=DJA2/HAUT
  138. IF(DJA1.LT.1.D-6.AND.DJA2.LT.1.D-6) I70=1
  139. C
  140. C ASURW = A / W NOTATION CHEISSOUX
  141. C
  142. W=(EPA1+EPA2)*UNDEMI
  143. ASURW=(FISS1+FISS2)/W
  144. ASUR1=FISS1/W
  145. ASUR2=FISS2/W
  146. IF(ASUR1.GT..98D0.AND.ASUR2.GT..98D0) I69=1
  147. IF(I69.EQ.1) GOTO 666
  148. C
  149. C TRANSFORMATION DE D
  150. D(1,1)=D(1,1)*W
  151. D(2,2)=D(2,2)*W*W*W/DOUZE
  152. C
  153. PEWM=D(1,1)*PENA
  154. PEWF=D(2,2)*PENA
  155. PEWMB=D(1,1)*PENB
  156. PEWFB=D(2,2)*PENA
  157. IF (ASURW.GT.EPSINV) THEN
  158. C
  159. C BOUCLE SUR LES POINTS DE CONTRAINTES
  160. C
  161. DO 200 IA=1,NPOINT
  162. H1=UNDEMI-UNDEMI*S(IA)
  163. H2=UNDEMI+UNDEMI*S(IA)
  164. ASURW=(H1*FISS1+H2*FISS2)/W
  165. A = H1*FISS1+H2*FISS2
  166. C
  167. C ON RECUPERE LES COEFFICIENTS ALPHAS ET F I
  168. C--------------------------------------------------
  169. CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA)
  170. CALL LISPFI(ASURW,FM,FF)
  171. C CALL INTER2D
  172. C--------------------------------------------------
  173. DELTA=D(1,1)/DELTA
  174. C
  175. C CALCUL DES COEFFICIENTS R1 R2 R3 R4
  176. C
  177. R1= DELTA*ALFF/W
  178. R2=-DELTA*ALMF/SIX
  179. R3=-DELTA*ALMF/SIX
  180. R4= DELTA*ALMM*W/TRSIX
  181. C
  182. C REMPLISSAGE DES CONTRAINTES
  183. C
  184. IF (DZ23.GE.0) THEN
  185. EPXZ=(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))
  186. $ *H2
  187. EPYZ=(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))
  188. $ *H2
  189. DD =(XDDLOC(3 )-XDDLOC(21))*H1+(XDDLOC(9 )-XDDLOC(15))
  190. $ *H2
  191. RT =(XDDLOC(4 )-XDDLOC(22))*H1+(XDDLOC(10)-XDDLOC(16))
  192. $ *H2
  193. RTZZ=(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))
  194. $ *H2
  195. ELSE
  196. EPXZ=(XDDLOC(19)-XDDLOC(1 ))*H1+(XDDLOC(13)-XDDLOC(7 ))
  197. $ *H2
  198. EPYZ=(XDDLOC(20)-XDDLOC(2 ))*H1+(XDDLOC(14)-XDDLOC(8 ))
  199. $ *H2
  200. DD =(XDDLOC(21)-XDDLOC(3 ))*H1+(XDDLOC(15)-XDDLOC(9 ))
  201. $ *H2
  202. RT =(XDDLOC(22)-XDDLOC(4 ))*H1+(XDDLOC(16)-XDDLOC(10))
  203. $ *H2
  204. RTZZ=(XDDLOC(24)-XDDLOC(6 ))*H1+(XDDLOC(18)-XDDLOC(12))
  205. $ *H2
  206. ENDIF
  207. C ___________________________________________________________
  208. C
  209. IX=6*(IA-1)
  210. C
  211. XSTRS(IX+1)=DD*R1+RT*R2
  212. XSTRS(IX+2)=PEWMB*EPXZ
  213. XSTRS(IX+3)=PEWMB*EPYZ
  214. XSTRS(IX+4)=DD*R3+RT*R4
  215. XSTRS(IX+5)=PEWFB*RTZZ
  216. C
  217. X1=XSTRS(IX+1)/W
  218. X4=XSTRS(IX+4)*SIX/(W*W)
  219. C ________________________________________
  220. C
  221. C CALCUL DE K I ET DE J
  222. C
  223. XXX=XPI*A
  224. XXX=SQRT(XXX)
  225. XKIE =(X1*FM+X4*FF)*XXX
  226. XSTRS(IX+6)= XKIE
  227. C
  228. 200 CONTINUE
  229. C
  230. C SI FISSURE INEXISTANTE
  231. C
  232. C ON FAIT UN C.S.T. POUR L ELEMENT DU BOUT
  233. C
  234. ELSE IF(ASURW.LE.EPSINV) THEN
  235. C
  236. DO 150 IA=1,NPOINT
  237. H1=UNDEMI-UNDEMI*S(IA)
  238. H2=UNDEMI+UNDEMI*S(IA)
  239. EPXZ =(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))*H2
  240. EPYZ =(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))*H2
  241. C
  242. DD1 = XDDLOC(3 )-XDDLOC(21)
  243. DD2 = XDDLOC(9 )-XDDLOC(15)
  244. DD = DD1*H1 + DD2*H2
  245. C
  246. RT1 = XDDLOC(4 )-XDDLOC(22)
  247. RT2 = XDDLOC(10)-XDDLOC(16)
  248. RT = RT1*H1 + RT2*H2
  249. C
  250. RTZZ =(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))*H2
  251. IX=6*(IA-1)
  252. XSTRS(IX+1)=PEWM*DD
  253. XSTRS(IX+2)=PEWMB*EPXZ
  254. XSTRS(IX+3)=PEWMB*EPYZ
  255. XSTRS(IX+4)=PEWF*RT
  256. XSTRS(IX+5)=PEWFB*RTZZ
  257. XSTRS(IX+6)=XZERO
  258. 150 CONTINUE
  259. ENDIF
  260. 666 CONTINUE
  261. RETURN
  262. END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  

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