Télécharger lispp0.eso

Retour à la liste

Numérotation des lignes :

  1. C LISPP0 SOURCE BP208322 17/03/01 21:17:49 9325
  2. SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,
  3. 1 KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
  4. 2 MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. C======================================================================
  8. C PLASTICITE LINESPRING
  9. C
  10. C ENTREES
  11. C SIG0(NSTRS) = CONTRAINTES INITIALES
  12. C NSTRS = NOMBRE DE CONTRAINTES
  13. C DEPST(NSTRS)= INCREMENT DE DEFORMATIONS TOTALES
  14. C VAR0(NVARI) = VARIABLES INTERNES DEBUT
  15. C XMAT(NCOMAT)= COMPOSANTES DE MATERIAU
  16. C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU
  17. C XCAR(ICARA) = CARACTERISTIQUES
  18. C ICARA = NOMBRE DE CARACTERISTIQUES
  19. C MALI = NUMERO DU MATERIAU LINEAIRE
  20. C INPLAS = NUMERO DU MATERIAU PLASTIQUE
  21. C NCOURB = NOMBRE DE POINTS SUR LA COURBE DE TRACTION
  22. C TRAC = COURBE DE TRACTION
  23. C PRECIS = PRECISION DES ITERATIONS
  24. * CMATE = NOM DU MATERIAU
  25. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  26. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  27. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  28. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  29. * MFR = NUMERO DE LA FORMULATION
  30. * IFOU = OPTION DE CALCUL
  31. * IB = NUMERO DE L ELEMENT COURANT
  32. * IGAU = NUMERO DU POINT COURANT
  33. * EPAIST= EPAISSEUR
  34. * NBPGAU= NBRE DE POINTS DE GAUSS
  35. * MELE = NUMERO DE L ELEMENT FINI
  36. * NPINT = NBRE DE POINTS D INTEGRATION
  37. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  38. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  39. * SECT = SECTION
  40. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  41. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX
  42. * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
  43. C
  44. C SORTIES
  45. C SIGF(NSTRS) = CONTRAINTES FINALES ET J
  46. C VARF(NVARI) = VARIABLES INTERNES FINALES
  47. C DEFP(NSTRS) = DEFORMATIONS PLASTIQUES
  48. C KERRE = 0 TOUT OK
  49. C 1 SI DLAMBDA NEGATIF
  50. C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  51. C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG
  52. C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  53. C 30 LIMITE ELASTIQUE NULLE
  54. C 75 SORTIE DE LA COURBE DE TRACTION
  55. C=======================================================================
  56. -INC CCREEL
  57. SEGMENT/WRK0/(XMAT(NCXMAT)*D)
  58. SEGMENT/WRK1/(DDHOOK(LHOOK,LHOOK)*D,SIG0(NSTRS)*D,
  59. . DEPST(NSTRS)*D,SIGF(NSTRS)*D,VAR0(NVARI)*D,
  60. . VARF(NVARI)*D,DEFP(NSTRS)*D,XCAR(ICARA)*D)
  61. SEGMENT/WRK2/(TRAC(LTRAC)*D)
  62. SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  63. SEGMENT/WTRAV/(DDAUX(LHOOK,LHOOK)*D,VALMAT(NUMAT)*D,
  64. . VALCAR(NUCAR)*D,DSIGT(NSTRS)*D,TXR(IDIM,IDIM)*D,
  65. . DDHOMU(LHOOK,LHOOK)*D,XLOC(3,3)*D,
  66. . XGLOB(3,3)*D,D1HOOK(LHOOK,LHOOK)*D,
  67. . ROTHOO(LHOOK,LHOOK)*D)
  68. PARAMETER(UNDEMI=.5D0,UN=1.D0)
  69. PARAMETER(SIX=6.D0)
  70. PARAMETER(NITERC=50)
  71. C
  72. DIMENSION CRIGI(*)
  73. CHARACTER*8 CMATE
  74. PREC = PRECIS*UNDEMI
  75. PRECM =-PRECIS*UNDEMI
  76. C
  77. KERRE=0
  78. C ON RECUPERE L EPAISSEUR
  79. C
  80. W = XCAR(1)
  81. FI = XCAR(2)
  82. QSI= FI / W
  83. C
  84. C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP)
  85. C
  86. YOU =XMAT(1)
  87. XNU =XMAT(2)
  88. IF(INPLAS.EQ.2) THEN
  89. CCC CAS DE LA PLASTICITE PARFAITE
  90. IF(XMAT(5).EQ.XZERO) THEN
  91. KERRE=30
  92. RETURN
  93. ENDIF
  94. NCOURB=2
  95. TRAC(1)=XMAT(5)
  96. TRAC(2)=XZERO
  97. TRAC(3)=XMAT(5)
  98. TRAC(4)=UN
  99. ELSE
  100. IF(INPLAS.EQ.27) THEN
  101. CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE
  102. C
  103. C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF
  104. C PENTE A L ORIGINE DE LA COURBE (M,PHI)
  105. C
  106. CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA)
  107. DDX= 2.D0*(1.D0 -XNU* XNU)/YOU
  108. CMM= ALFF*DDX*SIX*SIX/(W*W)
  109. XMAT(1)=1.D0/CMM
  110. CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  111. XMAT(1)=YOU
  112. IF(KERRE.NE.0) RETURN
  113. ENDIF
  114. PMOMM=TRAC(2*NCOURB-1)
  115. IF(PMOMM.EQ.0.D0) THEN
  116. KERRE=30
  117. RETURN
  118. ENDIF
  119. C
  120. C ON CALCULE SIG0 POUR LE MOMENT MAXI
  121. C
  122. XM0SS0=W*W/4.D0
  123. CALL LISPML(QSI,A)
  124. VSIG0=PMOMM/XM0SS0/A
  125. DO 100 I=1,NCOURB
  126. TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  127. 100 CONTINUE
  128. ENDIF
  129. C
  130. C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  131. C
  132. SEGINI WORK
  133. DO 2 I=1,NCOURB
  134. SIG(I)=TRAC(2*I-1)
  135. XLAM(I)=TRAC(2*I)
  136. 2 CONTINUE
  137. C
  138. C ON RECUPERE LES VARIABLES INTERNES
  139. C
  140. XLAM0=VAR0(1)
  141. IBI=0
  142. CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  143. IF(IBI.EQ.1) THEN
  144. KERRE=75
  145. GOTO 666
  146. ENDIF
  147. C
  148. C CALCUL DES INCREMENTS DE CONTRAINTES
  149. C
  150. CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR,
  151. 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU,
  152. 2 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  153. 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  154. *
  155. IF(IRTD.NE.1) THEN
  156. KERRE=69
  157. GOTO 666
  158. ENDIF
  159. *
  160. C
  161. C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION
  162. C SOLLICITANT LA FISSURE
  163. SIGF(2)=DSIGT(2) + SIG0(2)
  164. SIGF(3)=DSIGT(3) + SIG0(3)
  165. SIGF(5)=DSIGT(5) + SIG0(5)
  166. DEFP(2)=XZERO
  167. DEFP(3)=XZERO
  168. DEFP(5)=XZERO
  169. C
  170. C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE
  171. C ET SA DERIVEE
  172. CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F)
  173. C
  174. XN0=SIG0(1)
  175. XM0=SIG0(4)
  176. DNT=DSIGT(1)
  177. DMT=DSIGT(4)
  178. XNT=XN0+DNT
  179. XMT=XM0+DMT
  180. C
  181. C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE
  182. C
  183. CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1)
  184. CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2)
  185. C
  186. IF(Q1.GT.PREC) THEN
  187. KERRE=22
  188. ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN
  189. XNE =XNT
  190. XME =XMT
  191. XNP=XZERO
  192. XMP=XZERO
  193. DLAM=XZERO
  194. C
  195. ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN
  196. C
  197. C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE
  198. C
  199. DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT
  200. DLAM= 1.D0 - Q2 / DQDLAM
  201. DO 101 IA=1,NITERC
  202. XNTRA=XN0+DLAM*DNT
  203. XMTRA=XM0+DLAM*DMT
  204. CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ)
  205. DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT
  206. DLA1=DLAM - QQ / DQDLAM
  207. XNN = ABS(DLA1-DLAM)
  208. DLAM=DLA1
  209. IF(XNN.LT.PREC) GOTO 200
  210. 101 CONTINUE
  211. C
  212. C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS
  213. C
  214. KERRE=21
  215. GOTO 444
  216. 200 CONTINUE
  217. C
  218. C ON INTEGRE
  219. C
  220. C
  221. CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK,
  222. 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE)
  223. C
  224. C
  225. 444 CONTINUE
  226. ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN
  227. C
  228. C ON INTEGRE
  229. C
  230. CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
  231. 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE)
  232. C
  233. C
  234. ENDIF
  235. C
  236. C ON TRANSFORME LES EFFORTS EN CONTRAINTES
  237. C ET ON RECALCULE KI
  238. IF(KERRE.EQ.0) THEN
  239. SIGF(1)=XNE
  240. S1=XNE/W
  241. SIGF(4)=XME
  242. S4=XME*SIX/(W*W)
  243. C
  244. CALL LISPFI(QSI,FM,FF)
  245. XXX=XPI*FI
  246. XXX = SQRT(XXX)
  247. XKIEL = XXX*(FM*S1+FF*S4)
  248. C
  249. DEFP(1)=XNP
  250. DEFP(4)=2.D0*XMP/W
  251. C
  252. CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM)
  253. VARF(1)=ABS(DLAM)+VAR0(1)
  254. DJP=DFIDQS*DLAM/DFIDM/W
  255. VARF(2)=VAR0(2)+DJP
  256. C
  257. DEFP(6)=DJP
  258. SIGF(6)=XKIEL
  259. ENDIF
  260. C
  261. 666 RETURN
  262. END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  

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