Télécharger cmaxta.eso

Retour à la liste

Numérotation des lignes :

  1. C CMAXTA SOURCE CB215821 17/11/10 21:15:03 9608
  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. IF (WR12 .EQ. 0) THEN
  161. SEGINI,WR12
  162.  
  163. ELSE
  164. IF (EM0(/1).NE.2 .OR. EM0(/2).NE.NWA(1) .OR.
  165. & EM1(/2).NE.NWA(2) .OR. EM2(/2).NE.NWA(3) .OR.
  166. & EM3(/2).NE.NWA(4) .OR. EM4(/2).NE.NWA(5) .OR.
  167. & EM5(/2).NE.NWA(6) .OR. EM5(/2).NE.NWA(7) .OR.
  168. & EM7(/2).NE.NWA(8) .OR. EM8(/2).NE.NWA(9) .OR.
  169. & SM0(/1).NE. NSTRS) THEN
  170. SEGADJ,WR12
  171. ENDIF
  172. ENDIF
  173. *
  174. * recuperation des proprietes materielles
  175. * et des variables internes
  176. * D'abord les composantes obligatoires
  177. *
  178. DO JC=1,5
  179. MLREEL=IPX(JC)
  180. MLREE1=IPY(JC)
  181. SEGACT MLREE1
  182.  
  183. MLREE2=NINT(VAR0(JC+1))
  184. SEGACT MLREE2
  185. IF(JC.EQ.1) THEN
  186. DO JD=1,NWA(1)
  187. EM0(1,JD)=PROG(JD)
  188. EM0(2,JD)=MLREE1.PROG(JD)
  189. END DO
  190. DO JD=1,NSTRS
  191. SM0(JD)=MLREE2.PROG(JD)
  192. END DO
  193. ELSE IF(JC.EQ.2) THEN
  194. DO JD=1,NWA(2)
  195. EM1(1,JD)=PROG(JD)
  196. EM1(2,JD)=MLREE1.PROG(JD)
  197. END DO
  198. DO JD=1,NSTRS
  199. SM1(JD)=MLREE2.PROG(JD)
  200. END DO
  201. ELSE IF(JC.EQ.3) THEN
  202. DO JD=1,NWA(3)
  203. EM2(1,JD)=PROG(JD)
  204. EM2(2,JD)=MLREE1.PROG(JD)
  205. END DO
  206. DO JD=1,NSTRS
  207. SM2(JD)=MLREE2.PROG(JD)
  208. END DO
  209. ELSE IF(JC.EQ.4) THEN
  210. DO JD=1,NWA(4)
  211. EM3(1,JD)=PROG(JD)
  212. EM3(2,JD)=MLREE1.PROG(JD)
  213. END DO
  214. DO JD=1,NSTRS
  215. SM3(JD)=MLREE2.PROG(JD)
  216. END DO
  217. ELSE IF(JC.EQ.5) THEN
  218. DO JD=1,NWA(5)
  219. EM4(1,JD)=PROG(JD)
  220. EM4(2,JD)=MLREE1.PROG(JD)
  221. END DO
  222. DO JD=1,NSTRS
  223. SM4(JD)=MLREE2.PROG(JD)
  224. END DO
  225. ENDIF
  226. END DO
  227. *
  228. * traitement des composantes facultatives
  229. *
  230. DO JC=6,9
  231. IF(IPX(JC).NE.0) THEN
  232. MLREEL=IPX(JC)
  233. MLREE1=IPY(JC)
  234. SEGACT MLREE1
  235. MLREE2=NINT(VAR0(JC+1))
  236. SEGACT MLREE2
  237. IF(JC.EQ.6) THEN
  238. DO JD=1,NWA(6)
  239. EM5(1,JD)=PROG(JD)
  240. EM5(2,JD)=MLREE1.PROG(JD)
  241. END DO
  242. DO JD=1,NSTRS
  243. SM5(JD)=MLREE2.PROG(JD)
  244. END DO
  245. ELSE IF(JC.EQ.7) THEN
  246. DO JD=1,NWA(7)
  247. EM6(1,JD)=PROG(JD)
  248. EM6(2,JD)=MLREE1.PROG(JD)
  249. END DO
  250. DO JD=1,NSTRS
  251. SM6(JD)=MLREE2.PROG(JD)
  252. END DO
  253. ELSE IF(JC.EQ.8) THEN
  254. DO JD=1,NWA(8)
  255. EM7(1,JD)=PROG(JD)
  256. EM7(2,JD)=MLREE1.PROG(JD)
  257. END DO
  258. DO JD=1,NSTRS
  259. SM7(JD)=MLREE2.PROG(JD)
  260. END DO
  261. ELSE IF(JC.EQ.9) THEN
  262. DO JD=1,NWA(9)
  263. EM8(1,JD)=PROG(JD)
  264. EM8(2,JD)=MLREE1.PROG(JD)
  265. END DO
  266. DO JD=1,NSTRS
  267. SM8(JD)=MLREE2.PROG(JD)
  268. END DO
  269. ENDIF
  270. ENDIF
  271. END DO
  272. *
  273. * ROTATION DES TENSEURS SI BESOIN
  274. *
  275. *
  276. ******* Cas d'une formulation unidirectionnelle
  277. *
  278.  
  279. IF(CMATE.EQ.'UNIDIREC') THEN
  280.  
  281.  
  282. IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  283. CALL CMAXRO(wrk52,wrk53,wrk54,IB,IGAU,NBGMAT,NELMAT)
  284. IF(IERR.NE.0) RETURN
  285.  
  286. ICAS=1
  287. CALL CMAXR2(wrk52,wrk53,wrk54,ICAS,WR12,NCHAIN)
  288.  
  289. ELSE
  290. CALL ERREUR(251)
  291. RETURN
  292. ENDIF
  293.  
  294. ENDIF
  295.  
  296. *
  297. * DESACTIVATION DES SEGMENTS PROG
  298. *
  299. DO 10 JC=1,9
  300. C# MC : la dimension est definie au depart = 9
  301. IF (IPX(JC).EQ.0) GO TO 10
  302. MLREEL=IPX(JC)
  303. SEGDES MLREEL*NOMOD
  304. MLREE1=IPY(JC)
  305. SEGDES MLREE1*NOMOD
  306. MLREE2=NINT(VAR0(JC+1))
  307. SEGDES MLREE2*NOMOD
  308. 10 CONTINUE
  309. *
  310. RETURN
  311. END
  312.  
  313.  
  314.  
  315.  

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