Télécharger cmaxoa.eso

Retour à la liste

Numérotation des lignes :

  1. C CMAXOA SOURCE CB215821 17/10/17 21:15:00 9591
  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. IF (WR12.NE. 0) 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.  

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