Télécharger comouw.eso

Retour à la liste

Numérotation des lignes :

comouw
  1. C COMOUW SOURCE JK148537 23/09/05 21:15:03 11727
  2. SUBROUTINE COMOUW(iqmod,ipcon,INDESO,ipil,iwrk52,iwrk53,
  3. &iretou,iwr522)
  4. *-------------------------------------------------
  5. * identifie les melval de la pile
  6. * - recherche d abord ceux lies au modele
  7. * - puis tous les autres rang
  8. * les active
  9. * !!!!!!!
  10. * points delicats : evite de passer certaines composantes de
  11. * constituants differents de celui du modele :
  12. * dans tous les cas, caracteristiques materiau et geometrique,
  13. * de plus pour la mecanique, contraintes,
  14. * variables internes et deformations inelastiques.
  15. * cependant pour les autres on croise les doigts en esperant que les noms
  16. * de composantes correspondent a un seul constituant
  17. * pas de garde fou
  18. * puis suivant les formulations cree les deche associes
  19. * aux noms de composantes des mchaml attendus en sortie
  20. * (le rang est INDESO)
  21. *-------------------------------------------------
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMMODEL
  28. -INC SMCHAML
  29. -INC DECHE
  30. logical nouvid
  31. c
  32. nouvid = .true.
  33. lilcon = ipcon
  34. wrk53 = iwrk53
  35. c
  36. imodel = iqmod
  37.  
  38. *-------------------------------------------------
  39. CALL oooprl(1)
  40. call comou2(iqmod,INDESO,ipil,iwrk52,iwrk53,iwr522)
  41. CALL oooprl(0)
  42.  
  43. liluc = ipil
  44. iiluc= liluc(/1)
  45. ijluc = iiluc
  46. wrk52 = iwrk52
  47. wrk522 = iwr522
  48. nexo = exova0(/1)
  49. c
  50. do icon = 1,lilcon(/1)
  51. deche = lilcon(icon)
  52.  
  53. C* Cas du test pouvant arriver ?
  54. if (deche.LE.0) GOTO 40
  55.  
  56. * recherche du nom de composante parmi celles qui existent
  57. *
  58. do juc = 1,ijluc
  59.  
  60. C composantes inutiles formulation MELANGE
  61. if (juc.ne.23.and.(cmate.eq.'PARALLEL'.or.
  62. &cmate.eq.'SERIE')) goto 35
  63. if ((.not.((juc.ge.13.and.juc.le.15).or.juc.eq.23.or.juc.eq.1
  64. &.or.juc.eq.2)).and.
  65. &formod(1)(1:8).eq.'MELANGE') goto 35
  66.  
  67. nomid = liluc(juc,1)
  68. C Cas du test ci-dessous puvant arriver ?
  69. if (nomid.le.0) goto 35
  70. nobl = lesobl(/2)
  71. nfac = lesfac(/2)
  72. pilnec = liluc(juc,2)
  73. if (nobl.gt.0) then
  74. do 30 jm =1,nobl
  75. if (nomdec.ne.lesobl(jm)) goto 30
  76. if (juc.eq.13.or.juc.eq.14) then
  77. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  78. if (pilobl(jm,indec).gt.0) then
  79. dec1 = pilobl(jm,indec)
  80. if (dec1.imadec.eq.imamod) then
  81. if (imadec.ne.imamod) then
  82. c surcharge stationnaire
  83. pilobl(jm,indec) = deche
  84. else
  85. * write(6,*) 'comredondonnees ',nomdec,conmod,imamod,indec,imadec
  86. * write(6,*) jm, dec1.imadec,dec1.indec
  87. call erreur(21)
  88. return
  89. endif
  90. else
  91. if (imadec.ne.imamod) then
  92. * write(6,*) 'comredondon2 ',nomdec,conmod,imamod,indec,imadec
  93. * write(6,*) jm, dec1.imadec,dec1.indec
  94. call erreur(21)
  95. return
  96. endif
  97. endif
  98. endif
  99. pilobl(jm,indec)=deche
  100. goto 40
  101. endif
  102. elseif (FORMOD(1)(1:10).EQ.'MECANIQUE '.and.
  103. & (juc.ge.11.and.juc.le.24.and.juc.ne.15)) then
  104. if (pilobl(jm,indec).eq.0) pilobl(jm,indec)=deche
  105. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  106. pilobl(jm,indec)=deche
  107. endif
  108. goto 40
  109. elseif (juc.eq.23.and.cmate.ne.'PARALLEL'.and.
  110. &cmate.ne.'SERIE') then
  111. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  112. if (pilobl(jm,indec).gt.0) then
  113. * write(6,*) 'comouw redondance donnees',nomdec,conmod,imamod
  114. call erreur(21)
  115. return
  116. endif
  117. pilobl(jm,indec)=deche
  118. goto 40
  119. endif
  120. else
  121. * if(juc.eq.15) then
  122. * write(6,*) 'cw15',deche,indec,pilobl(jm,indec)
  123. * endif
  124. * if (pilobl(jm,indec).gt.0) then
  125. * write(6,*) 'comouw redon4',nomdec,condec,indec,juc,jm
  126. * endif
  127. pilobl(jm,indec)=deche
  128. goto 40
  129. endif
  130. 30 continue
  131. endif
  132. if (nfac.gt.0) then
  133. do 31 jm =1,nfac
  134. if (nomdec.ne.lesfac(jm)) goto 31
  135. if (juc.eq.13.or.juc.eq.14) then
  136. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  137. pilfac(jm,indec)=deche
  138. goto 40
  139. endif
  140. elseif (FORMOD(1)(1:10).EQ.'MECANIQUE '.and.
  141. * & (juc.eq.11.or.juc.eq.20.or.juc.eq.24)) then
  142. & (juc.ge.10.and.juc.le.24.and.juc.ne.15)) then
  143. if (condec(1:LCONMO).eq.conmod(1:LCONMO)) then
  144. pilfac(jm,indec)=deche
  145. goto 40
  146. endif
  147. else
  148. pilfac(jm,indec)=deche
  149. goto 40
  150. endif
  151. 31 continue
  152. endif
  153.  
  154. ******** segdes nomid,pilnec
  155. 35 continue
  156. enddo
  157.  
  158. if (condec(1:LCONMO).ne.conmod(1:LCONMO)) goto 40
  159.  
  160. * pas dans les listes : reajuster wrk52
  161.  
  162. nsca = scal0(/1)
  163. ndep = depl0(/1)
  164. nfor = forc0(/1)
  165. ngra = grad0(/1)
  166. nstrs = SIG0(/1)
  167. ndefo = DEPST(/1)
  168. ncara = XMAT(/1)
  169. ncarb = XCARB(/1)
  170. ntur = ture0(/1)
  171. npri = prin0(/1)
  172. nmah = maho0(/1)
  173. nhot = hota0(/1)
  174. nvari = VAR0(/1)
  175. ngrf = graf0(/1)
  176. nrhi = rhas0(/1)
  177. ndein = DEFP(/1)
  178. nparex=PAREX0(/1)
  179. *
  180. if (nouvid) then
  181. * write(6,*) 'cwid', nomdec,indec,condec,conmod
  182. nouvid = .false.
  183. * creation d un nomid et du pilnec
  184. nbrobl=1
  185. nbrfac = 0
  186. segini nomid
  187. lesobl(1) = nomdec
  188. ijluc=ijluc+1
  189. if(ijluc.gt.iiluc) then
  190. iiluc=iiluc+1
  191. segadj liluc
  192. endif
  193. liluc(ijluc,1)=nomid
  194. mobl = 1
  195. mfac = 0
  196. mran = INDESO
  197. segini pilnec
  198. liluc(ijluc,2)=pilnec
  199. pilobl(1,indec) = deche
  200. nexo = nexo + 1
  201. *
  202. segadj wrk52,wrk522
  203. typexo(nexo) = typdec
  204. conexo(nexo) = condec
  205. nomexo(nexo) = nomdec
  206. goto 40
  207.  
  208. else
  209. knmid = ijluc
  210. nomid = liluc(knmid,1)
  211. nbrobl = lesobl(/2) + 1
  212. nbrfac = 0
  213. segadj nomid
  214. lesobl(nbrobl) = nomdec
  215. pilnec = liluc(knmid,2)
  216. mobl = nbrobl
  217. mfac = 0
  218. mran = indeso
  219. segadj pilnec
  220. pilobl(mobl,indec) = deche
  221. nexo = nexo + 1
  222. segadj wrk52,wrk522
  223. typexo(nexo) = typdec
  224. conexo(nexo) = condec
  225. nomexo(nexo) = nomdec
  226. goto 40
  227. endif
  228.  
  229. moterr(1:16) = condec
  230. moterr(17:24) = nomdec
  231. interr(1) = 1
  232. call erreur(943)
  233. return
  234.  
  235. 40 continue
  236. enddo
  237.  
  238. * controle
  239.  
  240. do juc = 13,14
  241. if ((juc.eq.14.and.imatee.eq.11.and.inatuu.eq.41).or.
  242. * jk148537 : materiau fluendo3D inextricable
  243. & (juc.eq.13.and.imatee.eq.1.and.inatuu.eq.187)) goto 50
  244. nomid = liluc(juc,1)
  245. if (nomid.gt.0) then
  246. nobl = lesobl(/2)
  247. pilnec = liluc(juc,2)
  248. do jm=1,nobl
  249. if (pilobl(jm,1).eq.0.and.pilobl(jm,2).eq.0) then
  250. * write(6,*) 'absence donnee materiau / caracteristique imodel',
  251. * & imodel, conmod
  252. write(6,*) cmatee,lesobl(jm),jm,nobl
  253. moterr(1:45) = 'absence donnee materiau / caracteristique '
  254. call erreur(-385)
  255. interr(1) = imodel
  256. moterr(1:16) = conmod
  257. moterr(17:24) = lesobl(jm)
  258. call erreur(-386)
  259. call erreur(21)
  260. return
  261. endif
  262. enddo
  263. endif
  264. enddo
  265.  
  266. 50 continue
  267.  
  268. if (FORMOD(1)(1:10).EQ.'MECANIQUE ') then
  269. juc = 12
  270. nomid = liluc(juc,1)
  271. nobl = lesobl(/2)
  272. pilnec = liluc(juc,2)
  273. do jm=1,nobl
  274. if (pilobl(jm,1).eq.0.or.pilobl(jm,2).eq.0) then
  275. * write(6,*) 'absence deformation initiale et/ou finale ',
  276. * & imodel, conmod
  277. * write(6,*) cmatee,lesobl(jm),jm,nobl
  278. moterr(1:50) = 'absence deformation initiale et/ou finale '
  279. call erreur(-385)
  280. interr(1) = imodel
  281. moterr(1:16) = conmod
  282. moterr(17:24) = lesobl(jm)
  283. call erreur(-386)
  284. call erreur(21)
  285. return
  286. endif
  287. enddo
  288. endif
  289.  
  290. if (FORMOD(1)(1:8).EQ.'MELANGE ') then
  291. juc = 23
  292. nomid = liluc(juc,1)
  293. nobl = lesobl(/2)
  294. pilnec = liluc(juc,2)
  295. do jm=1,nobl
  296. if (cmate.eq.'PARALLEL') then
  297. if (pilobl(jm,2).eq.0.and.pilobl(jm,3).eq.0) then
  298. moterr(1:50) = 'absence phase finale melange parallele'
  299. call erreur(-385)
  300. interr(1) = imodel
  301. moterr(1:16) = conmod
  302. moterr(17:24) = lesobl(jm)
  303. call erreur(-386)
  304. call erreur(21)
  305. return
  306. endif
  307. else
  308. if (pilobl(jm,1).eq.0) then
  309. moterr(1:50) = 'absence phase initiale melange'
  310. call erreur(-385)
  311. interr(1) = imodel
  312. moterr(1:16) = conmod
  313. moterr(17:24) = lesobl(jm)
  314. call erreur(-386)
  315. endif
  316. endif
  317. enddo
  318. endif
  319.  
  320.  
  321. *
  322. IF (INPLAS.EQ.-1) THEN
  323. NSIGM0 = SIG0(/1)
  324. NEPST0 = EPST0(/1)
  325. IF (NSIGM0.GT.0.AND.NEPST0.GT.0.AND.NSIGM0.NE.NEPST0) THEN
  326. CALL ERREUR(963)
  327. RETURN
  328. ENDIF
  329. ENDIF
  330. *-------------------------------------------------
  331. c
  332. ipil = liluc
  333. iwrk52 = wrk52
  334. c
  335. RETURN
  336. END
  337.  
  338.  
  339.  
  340.  
  341.  

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