Télécharger maxtra.eso

Retour à la liste

Numérotation des lignes :

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

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