Télécharger mocu2d.eso

Retour à la liste

Numérotation des lignes :

mocu2d
  1. C MOCU2D SOURCE PV 22/04/28 21:15:02 11344
  2. SUBROUTINE MOCU2D(IPCURZ,IPAXIA,IPMODL,IPCAR,IPEPAX,IPMOMZ
  3. . ,TOL,mtable,zveri)
  4. **********************************************************************
  5. *
  6. * OPERATEUR MOCU2D (MOment/CUrvature)
  7. *
  8. * IPCURZ : Histoire en courbure
  9. * IPAXIA : Histoire en effort normal
  10. * IPMODL : Modele
  11. * IPCAR : Materiau
  12. * IPEPAX : Histoire allongement axial
  13. * IPMOMZ : Histoire en moment
  14. * TOL: Tolerance
  15. *
  16. **********************************************************************
  17. * D'APRES MOCUR DC 98
  18. **********************************************************************
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. C
  22. DIMENSION DEPSI(3),SIGMA(3),CRIGI(12),CMASS(12)
  23. logical bool,zveri
  24. character*1 char1
  25.  
  26. C
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC SMLREEL
  30. -INC CCGEOME
  31. -INC CCREEL
  32. -INC SMMODEL
  33. -INC SMCHAML
  34. -INC SMTABLE
  35. POINTEUR IPCURZ.MLREEL,IPAXIA.MLREEL
  36. POINTEUR IPMOMZ.MLREEL,IPEPAX.MLREEL
  37. C
  38. NMAXIT = 50
  39. NSTRS2 = 3
  40. II = 0
  41. XVA = 0.D0
  42. BOOL =.FALSE.
  43. IOB = 0
  44. C
  45. *
  46. ICOUL1=IDCOUL
  47. C
  48. C------- NSTEPS --
  49. C
  50. SEGACT,IPCURZ,IPAXIA
  51. NSTEPS=IPCURZ.PROG(/1)
  52. IF(IPAXIA.PROG(/1).NE.NSTEPS)THEN
  53. SEGDES,IPCURZ,IPAXIA
  54. RETURN
  55. ENDIF
  56. C
  57. if (zveri) then
  58. m=3
  59. segini mtable
  60. m=nsteps + 1
  61. segini mtab1
  62. call ecctab (mtable,'MOT ',ii,xva,'CONTRAINTES',bool,iob,
  63. $ 'TABLE ',ii,xva,char1,bool,mtab1)
  64. segini mtab2
  65. call ecctab (mtable,'MOT ',ii,xva,'VARIABLES_INTERNES',bool,iob
  66. $ ,'TABLE ',ii,xva,char1,bool,mtab2)
  67. segini mtab3
  68. call ecctab (mtable,'MOT ',ii,xva,'DEFORMATIONS',
  69. $ bool,iob,
  70. $ 'TABLE ',ii,xva,char1,bool,mtab3)
  71. segdes mtable
  72. endif
  73. c
  74. C-------- INITIALIZING ---------------
  75. C
  76. CALL ZEROP(IPMODL,'CONTRAIN',IPSIG0)
  77. CALL ZEROP(IPMODL,'VARINTER',IPVAR0)
  78. DO IE1=1,3
  79. SIGMA(IE1)=0.D0
  80. END DO
  81. SZERO=0.0D0
  82. if (zveri) then
  83. call ecctab(mtab1,'ENTIER',0,xva,char1,bool,iob,
  84. $ 'MCHAML',ii,xva,char1,bool,ipsig0)
  85. call ecctab(mtab2,'ENTIER',0,xva,char1,bool,iob,
  86. $ 'MCHAML',ii,xva,char1,bool,ipvar0)
  87. call ecctab(mtab3,'ENTIER ',0,xva,char1,bool,iob,
  88. $ 'FLOTTANT',ii,szero,char1,bool,iob)
  89. endif
  90. C
  91. JG=NSTEPS
  92. SEGINI,IPMOMZ,IPEPAX
  93. C
  94. C INITIAL STIFNESS
  95. C
  96. CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
  97. XKFXEX=CRIGI(1)
  98. XKFXCZ=-CRIGI(2)
  99. C
  100. C NULL DEFORMATION INCREMENT
  101. C
  102. DEPSI(2)=0.D0
  103. C
  104. ZAUX0=0.D0
  105. ZAXI0=0.D0
  106. DEFOA=0.D0
  107. C
  108. C-------- LOOP ---------------
  109. C
  110. DO 2000 I=1,NSTEPS
  111. C
  112. ZAUX1=IPCURZ.PROG(I)
  113. ZAXI1=IPAXIA.PROG(I)
  114. DZCURV=ZAUX1-ZAUX0
  115. DFAXIA=ZAXI1-ZAXI0
  116. C
  117. SIGPRE=ZAXI0
  118. XKFXEX=CRIGI(1)
  119. DSITER=(DFAXIA-XKFXCZ*DZCURV)/XKFXEX
  120. SZERO =DSITER
  121. C
  122. DEPSI(3)=DZCURV
  123. C
  124. DO 5000 NITER=1,NMAXIT
  125. DEPSI(1)=SZERO
  126. C
  127. ** write(6,*) 'MOCU2D definition incorrecte de time0 et timef'
  128. time0=0.D0
  129. timef=0.D0
  130. CALL FCOUL1(DEPSI,IPMODL,IPSIG0,IPVAR0,IPCAR,time0,timef,
  131. $ SIGMA,IPSIGF,IPVARF,IRETO,NSTRS2)
  132. IF(IRETO.EQ.0) THEN
  133. SEGSUP,IPMOMZ,IPEPAX
  134. RETURN
  135. ENDIF
  136. C
  137. DSITET=(ZAXI1-SIGMA(1))/XKFXEX
  138. C
  139. IF(IIMPI.EQ.1789)THEN
  140. write(IOIMP,999)I,NITER,XKFXEX,DSITET
  141. 999 format(1x,'I=',I4,' NITER=',I2,' XKFXEX=',
  142. $ 1pd12.5,' DSITET=',1pd12.5)
  143. ENDIF
  144. C
  145. IF(ABS(DSITET).LT.TOL)GOTO 5010
  146. C
  147. C on tente une approximation quasi-newton apres la prediction ...
  148. C
  149. IF(NITER.GT.1) XKFXEX=(SIGMA(1)-SIGPRE)/DSITER
  150. SIGPRE=SIGMA(1)
  151. DSITER=(ZAXI1-SIGMA(1))/XKFXEX
  152. SZERO=SZERO+DSITER
  153. C
  154. CALL DTCHAM(IPSIGF)
  155. CALL DTCHAM(IPVARF)
  156. C
  157. 5000 CONTINUE
  158. C
  159. INTERR(1)=NMAXIT
  160. CALL ERREUR(638)
  161. CALL DTCHAM(IPSIG0)
  162. CALL DTCHAM(IPVAR0)
  163. SEGSUP,IPMOMZ,IPEPAX
  164. SEGDES,IPCURZ,IPAXIA
  165. RETURN
  166. C
  167. 5010 ZAXI0=SIGMA(1)
  168. ZAUX0=ZAUX1
  169. DEFOA=DEFOA+SZERO
  170. C
  171. if (.not.zveri) then
  172. CALL DTCHAM(IPSIG0)
  173. CALL DTCHAM(IPVAR0)
  174. endif
  175. IPSIG0=IPSIGF
  176. IPVAR0=IPVARF
  177. c
  178. if (zveri) then
  179. call ecctab(mtab1,'ENTIER',0,xva,char1,bool,iob,
  180. $ 'MCHAML',ii,xva,char1,bool,ipsig0)
  181. call ecctab(mtab2,'ENTIER',0,xva,char1,bool,iob,
  182. $ 'MCHAML',ii,xva,char1,bool,ipvar0)
  183. call ecctab(mtab3,'ENTIER ',I,xva,char1,bool,iob,
  184. $ 'FLOTTANT ',ii,DEFOA,char1,bool,iob)
  185. endif
  186. C
  187. IPMOMZ.PROG(I)=SIGMA(3)
  188. IPEPAX.PROG(I)=DEFOA
  189. C
  190. C
  191. 2000 CONTINUE
  192. C
  193. if (zveri) then
  194. segdes,mtab1,mtab2,mtab3
  195. else
  196. CALL DTCHAM(IPSIG0)
  197. CALL DTCHAM(IPVAR0)
  198. endif
  199. SEGDES,IPCURZ,IPAXIA
  200. C
  201. SEGDES,IPMOMZ,IPEPAX
  202. C
  203. RETURN
  204. END
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  

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