Télécharger cmaxta.eso

Retour à la liste

Numérotation des lignes :

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

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