Télécharger mocu3d.eso

Retour à la liste

Numérotation des lignes :

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

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