Télécharger mocu2d.eso

Retour à la liste

Numérotation des lignes :

  1. C MOCU2D SOURCE BP208322 16/11/18 21:19:17 9177
  2. C MOCU2D SOURCE GOUNAND 97/10/13 22:21:06 2872
  3. SUBROUTINE MOCU2D(IPCURZ,IPAXIA,IPMODL,IPCAR,IPEPAX,IPMOMZ
  4. . ,TOL,mtable,zveri)
  5. **********************************************************************
  6. *
  7. * OPERATEUR MOCU2D (MOment/CUrvature)
  8. *
  9. * IPCURZ : Histoire en courbure
  10. * IPAXIA : Histoire en effort normal
  11. * IPMODL : Modele
  12. * IPCAR : Materiau
  13. * IPEPAX : Histoire allongement axial
  14. * IPMOMZ : Histoire en moment
  15. * TOL: Tolerance
  16. *
  17. **********************************************************************
  18. * D'APRES MOCUR DC 98
  19. **********************************************************************
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. C
  23. DIMENSION DEPSI(3),SIGMA(3),CRIGI(12),CMASS(12)
  24. logical bool,zveri
  25. character*1 char1
  26.  
  27. C
  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. CALL FCOUL1(DEPSI,IPMODL,IPSIG0,IPVAR0,IPCAR,
  128. $ SIGMA,IPSIGF,IPVARF,IRETO,NSTRS2)
  129. IF(IRETO.EQ.0) THEN
  130. SEGSUP,IPMOMZ,IPEPAX
  131. RETURN
  132. ENDIF
  133. C
  134. DSITET=(ZAXI1-SIGMA(1))/XKFXEX
  135. C
  136. IF(IIMPI.EQ.1789)THEN
  137. write(IOIMP,999)I,NITER,XKFXEX,DSITET
  138. 999 format(1x,'I=',I4,' NITER=',I2,' XKFXEX=',
  139. $ 1pd12.5,' DSITET=',1pd12.5)
  140. ENDIF
  141. C
  142. IF(ABS(DSITET).LT.TOL)GOTO 5010
  143. C
  144. C on tente une approximation quasi-newton apres la prediction ...
  145. C
  146. IF(NITER.GT.1) XKFXEX=(SIGMA(1)-SIGPRE)/DSITER
  147. SIGPRE=SIGMA(1)
  148. DSITER=(ZAXI1-SIGMA(1))/XKFXEX
  149. SZERO=SZERO+DSITER
  150. C
  151. CALL DTCHAM(IPSIGF)
  152. CALL DTCHAM(IPVARF)
  153. C
  154. 5000 CONTINUE
  155. C
  156. INTERR(1)=NMAXIT
  157. CALL ERREUR(638)
  158. CALL DTCHAM(IPSIG0)
  159. CALL DTCHAM(IPVAR0)
  160. SEGSUP,IPMOMZ,IPEPAX
  161. SEGDES,IPCURZ,IPAXIA
  162. RETURN
  163. C
  164. 5010 ZAXI0=SIGMA(1)
  165. ZAUX0=ZAUX1
  166. DEFOA=DEFOA+SZERO
  167. C
  168. if (.not.zveri) then
  169. CALL DTCHAM(IPSIG0)
  170. CALL DTCHAM(IPVAR0)
  171. endif
  172. IPSIG0=IPSIGF
  173. IPVAR0=IPVARF
  174. c
  175. if (zveri) then
  176. call ecctab(mtab1,'ENTIER',0,xva,char1,bool,iob,
  177. $ 'MCHAML',ii,xva,char1,bool,ipsig0)
  178. call ecctab(mtab2,'ENTIER',0,xva,char1,bool,iob,
  179. $ 'MCHAML',ii,xva,char1,bool,ipvar0)
  180. call ecctab(mtab3,'ENTIER ',I,xva,char1,bool,iob,
  181. $ 'FLOTTANT ',ii,DEFOA,char1,bool,iob)
  182. endif
  183. C
  184. IPMOMZ.PROG(I)=SIGMA(3)
  185. IPEPAX.PROG(I)=DEFOA
  186. C
  187. C
  188. 2000 CONTINUE
  189. C
  190. if (zveri) then
  191. segdes,mtab1,mtab2,mtab3
  192. else
  193. CALL DTCHAM(IPSIG0)
  194. CALL DTCHAM(IPVAR0)
  195. endif
  196. SEGDES,IPCURZ,IPAXIA
  197. C
  198. SEGDES,IPMOMZ,IPEPAX
  199. C
  200. RETURN
  201. END
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  

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