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

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