Télécharger cmaxoa.eso

Retour à la liste

Numérotation des lignes :

  1. C CMAXOA SOURCE BP208322 17/03/01 21:15:41 9325
  2. SUBROUTINE CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAT,
  3. & NELMAT,NWA,NCHAIN,EPSFLU)
  4. *
  5. * MODELE MAXOTT : RECUPERATION DES INFORMATIONS
  6. *
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. *
  10. -INC CCOPTIO
  11. -INC SMEVOLL
  12. -INC SMLREEL
  13. -INC CCHAMP
  14. -INC DECHE
  15. *
  16. SEGMENT WR12
  17. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  18. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  19. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  20. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  21. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  22. REAL*8 SM8(NSTRS)
  23. ENDSEGMENT
  24.  
  25. DIMENSION NWA(9),IPX(9),IPY(9)
  26. DIMENSION EPSFLU(8)
  27.  
  28. *
  29. *---------------------------------------
  30. * donnees materielles de type evolution
  31. *---------------------------------------
  32.  
  33. DO JC=1,9
  34. NWA(JC)=0
  35. IPX(JC)=0
  36. IPY(JC)=0
  37. END DO
  38. * offsets pour caracteristiques de type 'evolution'
  39. *
  40. * deformations planes / axisymetrique
  41. *
  42. IF ((IFOMOD.EQ.-1.AND.IFOUR.NE.-2).OR.
  43. & (IFOMOD.EQ.0.OR.IFOMOD.EQ.1)) THEN
  44. IMAXOBL = 10
  45. IMAXFAC = 51
  46. *
  47. * contraintes planes / 3D coques minces
  48. *
  49. ELSE IF((IFOMOD.EQ.-1.AND.IFOUR.EQ.-2).OR.
  50. & (IFOMOD.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9))) THEN
  51. IMAXOBL = 10
  52. IMAXFAC = 46
  53. *
  54. * tridimensionnelle massive
  55. *
  56. ELSE
  57. IMAXOBL = 15
  58. IMAXFAC = 57
  59. ENDIF
  60. *
  61. * em0
  62. *
  63.  
  64. MEVOLL=NINT(XMAT(IMAXOBL))
  65. SEGACT MEVOLL
  66. KEVOLL=IEVOLL(1)
  67. SEGACT KEVOLL
  68. MLREEL=IPROGX
  69. IPX(1)=IPROGX
  70. IPY(1)=IPROGY
  71. SEGACT MLREEL
  72. NWA(1)=PROG(/1)
  73. SEGDES KEVOLL*NOMOD
  74. SEGDES MEVOLL*NOMOD
  75.  
  76. *
  77. * em1 a em4
  78. *
  79. KED=IMAXOBL+1
  80. DO JC=2,5
  81. MEVOLL=NINT(XMAT(KED))
  82. KED=KED+2
  83. SEGACT MEVOLL
  84. KEVOLL=IEVOLL(1)
  85. SEGACT KEVOLL
  86. MLREEL=IPROGX
  87. IPX(JC)=IPROGX
  88. IPY(JC)=IPROGY
  89. SEGACT MLREEL
  90. NWA(JC)=PROG(/1)
  91. SEGDES KEVOLL*NOMOD
  92. SEGDES MEVOLL*NOMOD
  93. END DO
  94.  
  95. *
  96. * em5 a em8
  97. *
  98. NCHAIN=5
  99. KED=IMAXFAC
  100. DO JC=6,9
  101. MEVOLL=NINT(XMAT(KED))
  102. KED=KED+2
  103. IF(MEVOLL.GT.0) THEN
  104. SEGACT MEVOLL
  105. KEVOLL=IEVOLL(1)
  106. SEGACT KEVOLL
  107. MLREEL=IPROGX
  108. IPX(JC)=IPROGX
  109. IPY(JC)=IPROGY
  110. SEGACT MLREEL
  111. NWA(JC)=PROG(/1)
  112. NCHAIN=NCHAIN+1
  113. SEGDES KEVOLL*NOMOD
  114. SEGDES MEVOLL*NOMOD
  115. ENDIF
  116. END DO
  117.  
  118.  
  119. *------------------------------------
  120. * creation du segment de travail
  121. *------------------------------------
  122. SEGINI WR12
  123. *
  124. * recuperation des caracteristiques
  125. * materielles et des variables internes
  126. * D'abord les composantes obligatoires
  127. *
  128. * tridimensionnelle massive
  129. *
  130. IF(IFOUR.EQ.2.AND.MFR.EQ.1) THEN
  131. MXVREE = 22
  132. *
  133. * deformations planes / axisymetrique
  134. *
  135. ELSE IF(IFOUR.EQ.-1.OR.IFOUR.EQ.-3
  136. & .OR.IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  137. MXVREE = 17
  138. *
  139. * contraintes planes / 3D coques minces
  140. *
  141. ELSE
  142. MXVREE = 14
  143. ENDIF
  144. *
  145. DO JC=0,5
  146. IF(JC.NE.0) THEN
  147. MLREEL=IPX(JC)
  148. MLREE1=IPY(JC)
  149. SEGACT MLREE1
  150. ENDIF
  151. MLREE2=NINT(VAR0(JC+MXVREE))
  152. SEGACT MLREE2
  153. IF(JC.EQ.0) THEN
  154. DO JD=1,NSTRS
  155. EPSFLU(JD)=MLREE2.PROG(JD)
  156. END DO
  157. ELSE IF(JC.EQ.1) THEN
  158. DO JD=1,NWA(1)
  159. EM0(1,JD)=PROG(JD)
  160. EM0(2,JD)=MLREE1.PROG(JD)
  161. END DO
  162. DO JD=1,NSTRS
  163. SM0(JD)=MLREE2.PROG(JD)
  164. END DO
  165. ELSE IF(JC.EQ.2) THEN
  166. DO JD=1,NWA(2)
  167. EM1(1,JD)=PROG(JD)
  168. EM1(2,JD)=MLREE1.PROG(JD)
  169. END DO
  170. DO JD=1,NSTRS
  171. SM1(JD)=MLREE2.PROG(JD)
  172. END DO
  173. ELSE IF(JC.EQ.3) THEN
  174. DO JD=1,NWA(3)
  175. EM2(1,JD)=PROG(JD)
  176. EM2(2,JD)=MLREE1.PROG(JD)
  177. END DO
  178. DO JD=1,NSTRS
  179. SM2(JD)=MLREE2.PROG(JD)
  180. END DO
  181. ELSE IF(JC.EQ.4) THEN
  182. DO JD=1,NWA(4)
  183. EM3(1,JD)=PROG(JD)
  184. EM3(2,JD)=MLREE1.PROG(JD)
  185. END DO
  186. DO JD=1,NSTRS
  187. SM3(JD)=MLREE2.PROG(JD)
  188. END DO
  189. ELSE IF(JC.EQ.5) THEN
  190. DO JD=1,NWA(5)
  191. EM4(1,JD)=PROG(JD)
  192. EM4(2,JD)=MLREE1.PROG(JD)
  193. END DO
  194. DO JD=1,NSTRS
  195. SM4(JD)=MLREE2.PROG(JD)
  196. END DO
  197. ENDIF
  198. END DO
  199. *
  200. * traitement des composantes facultatives
  201. *
  202. DO JC=6,9
  203. IF(IPX(JC).NE.0) THEN
  204. MLREEL=IPX(JC)
  205. MLREE1=IPY(JC)
  206. SEGACT MLREE1
  207. MLREE2=NINT(VAR0(JC+MXVREE))
  208. SEGACT MLREE2
  209. IF(JC.EQ.6) THEN
  210. DO JD=1,NWA(6)
  211. EM5(1,JD)=PROG(JD)
  212. EM5(2,JD)=MLREE1.PROG(JD)
  213. END DO
  214. DO JD=1,NSTRS
  215. SM5(JD)=MLREE2.PROG(JD)
  216. END DO
  217. ELSE IF(JC.EQ.7) THEN
  218. DO JD=1,NWA(7)
  219. EM6(1,JD)=PROG(JD)
  220. EM6(2,JD)=MLREE1.PROG(JD)
  221. END DO
  222. DO JD=1,NSTRS
  223. SM6(JD)=MLREE2.PROG(JD)
  224. END DO
  225. ELSE IF(JC.EQ.8) THEN
  226. DO JD=1,NWA(8)
  227. EM7(1,JD)=PROG(JD)
  228. EM7(2,JD)=MLREE1.PROG(JD)
  229. END DO
  230. DO JD=1,NSTRS
  231. SM7(JD)=MLREE2.PROG(JD)
  232. END DO
  233. ELSE IF(JC.EQ.9) THEN
  234. DO JD=1,NWA(9)
  235. EM8(1,JD)=PROG(JD)
  236. EM8(2,JD)=MLREE1.PROG(JD)
  237. END DO
  238. DO JD=1,NSTRS
  239. SM8(JD)=MLREE2.PROG(JD)
  240. END DO
  241. ENDIF
  242. ENDIF
  243. END DO
  244.  
  245. *
  246. * DESACTIVATION DES SEGMENTS PROG
  247. *
  248. DO 10 JC=0,9
  249. IF (IPX(JC).EQ.0) GO TO 10
  250. IF (JC.NE.0) THEN
  251. MLREEL=IPX(JC)
  252. SEGDES MLREEL*NOMOD
  253. MLREE1=IPY(JC)
  254. SEGDES MLREE1*NOMOD
  255. ENDIF
  256. MLREE2=NINT(VAR0(JC+MXVREE))
  257. SEGDES MLREE2*NOMOD
  258. 10 CONTINUE
  259.  
  260. *
  261. RETURN
  262. END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  

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