Télécharger clispp.eso

Retour à la liste

Numérotation des lignes :

  1. C CLISPP SOURCE PV 17/12/08 21:15:50 9660
  2. SUBROUTINE CLISPP(WRK52,WRK53,WRK54,WRK2,IFOU,IB,IGAU,
  3. 1 NBPGAU,iecou)
  4. C LISPP0 SOURCE KICH 98/06/30 23:19:33 3239
  5. c SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,
  6. c 1 KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
  7. c 2 MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. C======================================================================
  11. C PLASTICITE LINESPRING
  12. C
  13. C ENTREES
  14. C SIG0(NSTRS1) = CONTRAINTES INITIALES
  15. C NSTRS1 = NOMBRE DE CONTRAINTES
  16. C DEPST(NSTRS1)= INCREMENT DE DEFORMATIONS TOTALES
  17. C VAR0(NVARI) = VARIABLES INTERNES DEBUT
  18. C XMAT(NCOMAT)= COMPOSANTES DE MATERIAU
  19. C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU
  20. C xcarb(ICARA) = CARACTERISTIQUES
  21. C ICARA = NOMBRE DE CARACTERISTIQUES
  22. C MALI = NUMERO DU MATERIAU LINEAIRE
  23. C INPLAS = NUMERO DU MATERIAU PLASTIQUE
  24. C NCOURB = NOMBRE DE POINTS SUR LA COURBE DE TRACTION
  25. C TRAC = COURBE DE TRACTION
  26. C PRECIS = PRECISION DES ITERATIONS
  27. * CMATE = NOM DU MATERIAU
  28. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  29. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  30. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  31. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  32. * MFR = NUMERO DE LA FORMULATION
  33. * IFOU = OPTION DE CALCUL
  34. * IB = NUMERO DE L ELEMENT COURANT
  35. * IGAU = NUMERO DU POINT COURANT
  36. * EPAIST= EPAISSEUR
  37. * NBPGAU= NBRE DE POINTS DE GAUSS
  38. * MELE = NUMERO DE L ELEMENT FINI
  39. * NPINT = NBRE DE POINTS D INTEGRATION
  40. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  41. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  42. * SECT = SECTION
  43. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  44. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX
  45. * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
  46. C
  47. C SORTIES
  48. C SIGF(NSTRS1) = CONTRAINTES FINALES ET J
  49. C VARF(NVARI) = VARIABLES INTERNES FINALES
  50. C DEFP(NSTRS1) = DEFORMATIONS PLASTIQUES
  51. C KERRE = 0 TOUT OK
  52. C 1 SI DLAMBDA NEGATIF
  53. C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  54. C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG
  55. C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  56. C 30 LIMITE ELASTIQUE NULLE
  57. C 75 SORTIE DE LA COURBE DE TRACTION
  58. C=======================================================================
  59. -INC CCREEL
  60. -INC DECHE
  61. SEGMENT IECOU
  62. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  63. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  64. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  65. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  66. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  67. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  68. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  69. 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  70. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  71. 4 icow32,icow33,NSTRS1,icow35,NBGMAT,NELMAT,icow38,
  72. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  73. 5 icow39,icow40,icow41,icow42,icow43,icow44
  74. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  75. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  76. . icow51,icow52,icow53,icow54,icow55,icow56
  77. . icow57,icow58
  78. ENDSEGMENT
  79.  
  80. SEGMENT/WRK2/(TRAC(LTRAC)*D)
  81. SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  82. PARAMETER(UNDEMI=.5D0,UN=1.D0)
  83. PARAMETER(SIX=6.D0)
  84. PARAMETER(NITERC=50)
  85. C
  86. PREC = PRECIS*UNDEMI
  87. PRECM =-PRECIS*UNDEMI
  88. C
  89. KERRE=0
  90. C ON RECUPERE L EPAISSEUR
  91. C
  92. * write(6,*) ' entree dans clispp iecou', iecou
  93. W = xcarb(1)
  94. FI = xcarb(2)
  95. QSI= FI / W
  96. C
  97. C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP)
  98. C
  99. YOU =XMAT(1)
  100. XNU =XMAT(2)
  101. IF(INPLAS.EQ.2) THEN
  102. CCC CAS DE LA PLASTICITE PARFAITE
  103. IF(XMAT(5).EQ.XZERO) THEN
  104. KERRE=30
  105. RETURN
  106. ENDIF
  107. NCOURB=2
  108. TRAC(1)=XMAT(5)
  109. TRAC(2)=XZERO
  110. TRAC(3)=XMAT(5)
  111. TRAC(4)=UN
  112. ELSE
  113. IF(INPLAS.EQ.27) THEN
  114. CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE
  115. C
  116. C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF
  117. C PENTE A L ORIGINE DE LA COURBE (M,PHI)
  118. C
  119. CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA)
  120. DDX= 2.D0*(1.D0 -XNU* XNU)/YOU
  121. CMM= ALFF*DDX*SIX*SIX/(W*W)
  122. XMAT(1)=1.D0/CMM
  123. call ccotra(wrk52,wrk2,NCOURB,wrk53)
  124. XMAT(1)=YOU
  125. IF(KERRE.NE.0) RETURN
  126. ENDIF
  127. PMOMM=TRAC(2*NCOURB-1)
  128. IF(PMOMM.EQ.0.D0) THEN
  129. KERRE=30
  130. RETURN
  131. ENDIF
  132. C
  133. C ON CALCULE SIG0 POUR LE MOMENT MAXI
  134. C
  135. XM0SS0=W*W/4.D0
  136. CALL LISPML(QSI,A)
  137. VSIG0=PMOMM/XM0SS0/A
  138. DO 100 I=1,NCOURB
  139. TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  140. 100 CONTINUE
  141. ENDIF
  142. C
  143. C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  144. C
  145. SEGINI WORK
  146. DO 2 I=1,NCOURB
  147. SIG(I)=TRAC(2*I-1)
  148. XLAM(I)=TRAC(2*I)
  149. 2 CONTINUE
  150. C
  151. C ON RECUPERE LES VARIABLES INTERNES
  152. C
  153. XLAM0=VAR0(1)
  154. IBI=0
  155. CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  156. IF(IBI.EQ.1) THEN
  157. KERRE=75
  158. GOTO 666
  159. ENDIF
  160. C
  161. C CALCUL DES INCREMENTS DE CONTRAINTES
  162. C
  163. nstrbi=nstrs1
  164. nbgmab=nbgmat
  165. nlmatb=nelmat
  166. * write(6,*) ' clispp appel a calsig mfr ', mfr
  167. CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR,
  168. 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU,
  169. 2 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,
  170. 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  171. * write(6,*) ' clispp apres calsig irtd ',irtd
  172. nstrs1=nstrbi
  173. nbgmat=nbgmab
  174. nelmat=nlmatb
  175. *
  176. IF(IRTD.NE.1) THEN
  177. KERRE=69
  178. GOTO 666
  179. ENDIF
  180. *
  181. C
  182. C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION
  183. C SOLLICITANT LA FISSURE
  184. SIGF(2)=DSIGT(2) + SIG0(2)
  185. SIGF(3)=DSIGT(3) + SIG0(3)
  186. SIGF(5)=DSIGT(5) + SIG0(5)
  187. DEFP(2)=XZERO
  188. DEFP(3)=XZERO
  189. DEFP(5)=XZERO
  190. C
  191. C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE
  192. C ET SA DERIVEE
  193. CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F)
  194. C
  195. XN0=SIG0(1)
  196. XM0=SIG0(4)
  197. DNT=DSIGT(1)
  198. DMT=DSIGT(4)
  199. XNT=XN0+DNT
  200. XMT=XM0+DMT
  201. C
  202. C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE
  203. C
  204. CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1)
  205. CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2)
  206. C
  207. IF(Q1.GT.PREC) THEN
  208. KERRE=22
  209. ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN
  210. XNE =XNT
  211. XME =XMT
  212. XNP=XZERO
  213. XMP=XZERO
  214. DLAM=XZERO
  215. C
  216. ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN
  217. C
  218. C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE
  219. C
  220. DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT
  221. DLAM= 1.D0 - Q2 / DQDLAM
  222. DO 101 IA=1,NITERC
  223. XNTRA=XN0+DLAM*DNT
  224. XMTRA=XM0+DLAM*DMT
  225. CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ)
  226. DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT
  227. DLA1=DLAM - QQ / DQDLAM
  228. XNN = ABS(DLA1-DLAM)
  229. DLAM=DLA1
  230. IF(XNN.LT.PREC) GOTO 200
  231. 101 CONTINUE
  232. C
  233. C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS
  234. C
  235. KERRE=21
  236. GOTO 444
  237. 200 CONTINUE
  238. C
  239. C ON INTEGRE
  240. C
  241. C
  242. prec1 = PRECIS
  243. kerre1 = KERRE
  244. CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK,
  245. 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
  246. PRECIS = prec1
  247. KERRE = kerre1
  248. C
  249. C
  250. 444 CONTINUE
  251. ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN
  252. C
  253. C ON INTEGRE
  254. C
  255. prec1 = PRECIS
  256. kerre1 = KERRE
  257. CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
  258. 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
  259. PRECIS = prec1
  260. KERRE = kerre1
  261. C
  262. C
  263. ENDIF
  264. C
  265. C ON TRANSFORME LES EFFORTS EN CONTRAINTES
  266. C ET ON RECALCULE KI
  267. IF(KERRE.EQ.0) THEN
  268. SIGF(1)=XNE
  269. S1=XNE/W
  270. SIGF(4)=XME
  271. S4=XME*SIX/(W*W)
  272. C
  273. CALL LISPFI(QSI,FM,FF)
  274. XXX=XPI*FI
  275. XXX = SQRT(XXX)
  276. XKIEL = XXX*(FM*S1+FF*S4)
  277. C
  278. DEFP(1)=XNP
  279. DEFP(4)=2.D0*XMP/W
  280. C
  281. CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM)
  282. VARF(1)=ABS(DLAM)+VAR0(1)
  283. DJP=DFIDQS*DLAM/DFIDM/W
  284. VARF(2)=VAR0(2)+DJP
  285. C
  286. DEFP(6)=DJP
  287. SIGF(6)=XKIEL
  288. ENDIF
  289. C
  290. 666 RETURN
  291. END
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  

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