Télécharger mocu3d.eso

Retour à la liste

Numérotation des lignes :

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

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