Télécharger clispp.eso

Retour à la liste

Numérotation des lignes :

clispp
  1. C CLISPP SOURCE PV 22/04/22 21:15:06 11344
  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. dimension crigi(12)
  86. C
  87. PREC = PRECIS*UNDEMI
  88. PRECM =-PRECIS*UNDEMI
  89. C
  90. KERRE=0
  91. C ON RECUPERE L EPAISSEUR
  92. C
  93. * write(6,*) ' entree dans clispp iecou', iecou
  94. W = xcarb(1)
  95. FI = xcarb(2)
  96. QSI= FI / W
  97. C
  98. C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP)
  99. C
  100. YOU =XMAT(1)
  101. XNU =XMAT(2)
  102. IF(INPLAS.EQ.2) THEN
  103. CCC CAS DE LA PLASTICITE PARFAITE
  104. IF(XMAT(5).EQ.XZERO) THEN
  105. KERRE=30
  106. RETURN
  107. ENDIF
  108. NCOURB=2
  109. TRAC(1)=XMAT(5)
  110. TRAC(2)=XZERO
  111. TRAC(3)=XMAT(5)
  112. TRAC(4)=UN
  113. ELSE
  114. IF(INPLAS.EQ.27) THEN
  115. CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE
  116. C
  117. C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF
  118. C PENTE A L ORIGINE DE LA COURBE (M,PHI)
  119. C
  120. CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA)
  121. DDX= 2.D0*(1.D0 -XNU* XNU)/YOU
  122. CMM= ALFF*DDX*SIX*SIX/(W*W)
  123. XMAT(1)=1.D0/CMM
  124. call ccotra(wrk52,wrk2,NCOURB,wrk53)
  125. XMAT(1)=YOU
  126. IF(KERRE.NE.0) RETURN
  127. ENDIF
  128. PMOMM=TRAC(2*NCOURB-1)
  129. IF(PMOMM.EQ.0.D0) THEN
  130. KERRE=30
  131. RETURN
  132. ENDIF
  133. C
  134. C ON CALCULE SIG0 POUR LE MOMENT MAXI
  135. C
  136. XM0SS0=W*W/4.D0
  137. CALL LISPML(QSI,A)
  138. VSIG0=PMOMM/XM0SS0/A
  139. DO 100 I=1,NCOURB
  140. TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  141. 100 CONTINUE
  142. ENDIF
  143. C
  144. C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  145. C
  146. SEGINI WORK
  147. DO 2 I=1,NCOURB
  148. SIG(I)=TRAC(2*I-1)
  149. XLAM(I)=TRAC(2*I)
  150. 2 CONTINUE
  151. C
  152. C ON RECUPERE LES VARIABLES INTERNES
  153. C
  154. XLAM0=VAR0(1)
  155. IBI=0
  156. CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  157. IF(IBI.EQ.1) THEN
  158. KERRE=75
  159. GOTO 666
  160. ENDIF
  161. C
  162. C CALCUL DES INCREMENTS DE CONTRAINTES
  163. C
  164. nstrbi=nstrs1
  165. nbgmab=nbgmat
  166. nlmatb=nelmat
  167. * write(6,*) ' clispp appel a calsig mfr ', mfr
  168. CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR,
  169. 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU,
  170. 2 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,
  171. 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  172. * write(6,*) ' clispp apres calsig irtd ',irtd
  173. nstrs1=nstrbi
  174. nbgmat=nbgmab
  175. nelmat=nlmatb
  176. *
  177. IF(IRTD.NE.1) THEN
  178. KERRE=69
  179. GOTO 666
  180. ENDIF
  181. *
  182. C
  183. C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION
  184. C SOLLICITANT LA FISSURE
  185. SIGF(2)=DSIGT(2) + SIG0(2)
  186. SIGF(3)=DSIGT(3) + SIG0(3)
  187. SIGF(5)=DSIGT(5) + SIG0(5)
  188. DEFP(2)=XZERO
  189. DEFP(3)=XZERO
  190. DEFP(5)=XZERO
  191. C
  192. C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE
  193. C ET SA DERIVEE
  194. CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F)
  195. C
  196. XN0=SIG0(1)
  197. XM0=SIG0(4)
  198. DNT=DSIGT(1)
  199. DMT=DSIGT(4)
  200. XNT=XN0+DNT
  201. XMT=XM0+DMT
  202. C
  203. C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE
  204. C
  205. CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1)
  206. CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2)
  207. C
  208. IF(Q1.GT.PREC) THEN
  209. KERRE=22
  210. ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN
  211. XNE =XNT
  212. XME =XMT
  213. XNP=XZERO
  214. XMP=XZERO
  215. DLAM=XZERO
  216. C
  217. ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN
  218. C
  219. C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE
  220. C
  221. DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT
  222. DLAM= 1.D0 - Q2 / DQDLAM
  223. DO 101 IA=1,NITERC
  224. XNTRA=XN0+DLAM*DNT
  225. XMTRA=XM0+DLAM*DMT
  226. CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ)
  227. DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT
  228. DLA1=DLAM - QQ / DQDLAM
  229. XNN = ABS(DLA1-DLAM)
  230. DLAM=DLA1
  231. IF(XNN.LT.PREC) GOTO 200
  232. 101 CONTINUE
  233. C
  234. C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS
  235. C
  236. KERRE=21
  237. GOTO 444
  238. 200 CONTINUE
  239. C
  240. C ON INTEGRE
  241. C
  242. C
  243. prec1 = PRECIS
  244. kerre1 = KERRE
  245. CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK,
  246. 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
  247. PRECIS = prec1
  248. KERRE = kerre1
  249. C
  250. C
  251. 444 CONTINUE
  252. ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN
  253. C
  254. C ON INTEGRE
  255. C
  256. prec1 = PRECIS
  257. kerre1 = KERRE
  258. CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
  259. 1 XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
  260. PRECIS = prec1
  261. KERRE = kerre1
  262. C
  263. C
  264. ENDIF
  265. C
  266. C ON TRANSFORME LES EFFORTS EN CONTRAINTES
  267. C ET ON RECALCULE KI
  268. IF(KERRE.EQ.0) THEN
  269. SIGF(1)=XNE
  270. S1=XNE/W
  271. SIGF(4)=XME
  272. S4=XME*SIX/(W*W)
  273. C
  274. CALL LISPFI(QSI,FM,FF)
  275. XXX=XPI*FI
  276. XXX = SQRT(XXX)
  277. XKIEL = XXX*(FM*S1+FF*S4)
  278. C
  279. DEFP(1)=XNP
  280. DEFP(4)=2.D0*XMP/W
  281. C
  282. CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM)
  283. VARF(1)=ABS(DLAM)+VAR0(1)
  284. DJP=DFIDQS*DLAM/DFIDM/W
  285. VARF(2)=VAR0(2)+DJP
  286. C
  287. DEFP(6)=DJP
  288. SIGF(6)=XKIEL
  289. ENDIF
  290. C
  291. 666 RETURN
  292. END
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  

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