Télécharger cmaxta.eso

Retour à la liste

Numérotation des lignes :

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

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