Télécharger comouw.eso

Retour à la liste

Numérotation des lignes :

  1. C COMOUW SOURCE BP208322 17/03/01 21:16:26 9325
  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. -INC CCOPTIO
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC DECHE
  28. logical nouvid
  29. c
  30. nouvid = .true.
  31. lilcon = ipcon
  32. wrk53 = iwrk53
  33. c
  34. imodel = iqmod
  35.  
  36. *-------------------------------------------------
  37. call comou2(iqmod,INDESO,ipil,iwrk52,iwrk53,iwr522)
  38.  
  39. liluc = ipil
  40. iiluc= liluc(/1)
  41. ijluc = iiluc
  42. wrk52 = iwrk52
  43. wrk522 = iwr522
  44. nexo = exova0(/1)
  45. c
  46. do icon = 1,lilcon(/1)
  47. deche = lilcon(icon)
  48.  
  49. C* Cas du test pouvant arriver ?
  50. if (deche.LE.0) GOTO 40
  51. * write (6,*) ' comouw condec ',condec,' conmod ',conmod
  52. * recherche du nom de composante parmi celles qui existent
  53. *
  54. do juc = 1,ijluc
  55.  
  56.  
  57. nomid = liluc(juc,1)
  58. C Cas du test ci-dessous puvant arriver ?
  59. if (nomid.le.0) goto 35
  60. nobl = lesobl(/2)
  61. nfac = lesfac(/2)
  62. pilnec = liluc(juc,2)
  63. ** segact nomid*nomod
  64. ** segact pilnec*mod
  65. if (nobl.gt.0) then
  66. do 30 jm =1,nobl
  67. if (nomdec.ne.lesobl(jm)) goto 30
  68. if (juc.eq.13.or.juc.eq.14) then
  69. if (condec.eq.conmod) then
  70. pilobl(jm,indec)=deche
  71. melval = ieldec
  72. ** segact melval
  73. goto 40
  74. endif
  75. if (FORMOD(1).EQ.'MELANGE'.and.cmate.eq.'PARALLEL'
  76. &.and.indec.eq.indeso) then
  77. segini,dec1=deche
  78. dec1.condec=conmod
  79. * write(6,*) nomdec,indec,condec,conmod
  80. pilobl(jm,indec)=dec1
  81. goto 40
  82. endif
  83. elseif (FORMOD(1).EQ.'MECANIQUE'.and.
  84. & (juc.eq.11.or.juc.eq.20.or.juc.eq.24)) then
  85. if (condec.eq.conmod) then
  86. pilobl(jm,indec)=deche
  87. melval = ieldec
  88. ** segact melval
  89. ** segact melval*nomod
  90. goto 40
  91. endif
  92. else
  93. pilobl(jm,indec)=deche
  94. melval = ieldec
  95. ** segact melval
  96. goto 40
  97. endif
  98. 30 continue
  99. endif
  100. if (nfac.gt.0) then
  101. do 31 jm =1,nfac
  102. if (nomdec.ne.lesfac(jm)) goto 31
  103. if (juc.eq.13.or.juc.eq.14) then
  104. if (condec.eq.conmod) then
  105. pilfac(jm,indec)=deche
  106. melval = ieldec
  107. ** segact melval
  108. goto 40
  109. endif
  110. elseif (FORMOD(1).EQ.'MECANIQUE'.and.
  111. & (juc.eq.11.or.juc.eq.20.or.juc.eq.24)) then
  112. if (condec.eq.conmod) then
  113. pilfac(jm,indec)=deche
  114. melval = ieldec
  115. ** segact melval
  116. goto 40
  117. endif
  118. else
  119. pilfac(jm,indec)=deche
  120. melval = ieldec
  121. ** segact melval
  122. goto 40
  123. endif
  124. 31 continue
  125. endif
  126.  
  127. ******** segdes nomid,pilnec
  128. 35 continue
  129. enddo
  130.  
  131. * pas dans les listes : reajuster wrk52
  132.  
  133. nsca = scal0(/1)
  134. ndep = depl0(/1)
  135. nfor = forc0(/1)
  136. ngra = grad0(/1)
  137. nstrs = SIG0(/1)
  138. ndefo = DEPST(/1)
  139. ncara = XMAT(/1)
  140. ncarb = XCARB(/1)
  141. ntur = ture0(/1)
  142. npri = prin0(/1)
  143. nmah = maho0(/1)
  144. nhot = hota0(/1)
  145. nvari = VAR0(/1)
  146. ngrf = graf0(/1)
  147. nrhi = rhas0(/1)
  148. ndein = DEFP(/1)
  149. nparex=PAREX0(/1)
  150. *
  151. if (nouvid) then
  152. nouvid = .false.
  153. * creation d un nomid et du pilnec
  154. nbrobl=1
  155. nbrfac = 0
  156. segini nomid
  157. lesobl(1) = nomdec
  158. **** segdes nomid
  159. ijluc=ijluc+1
  160. if(ijluc.gt.iiluc) then
  161. iiluc=iiluc+1
  162. segadj liluc
  163. endif
  164. liluc(ijluc,1)=nomid
  165. mobl = 1
  166. mfac = 0
  167. mran = INDESO
  168. segini pilnec
  169. liluc(ijluc,2)=pilnec
  170. pilobl(1,indec) = deche
  171. melval = ieldec
  172. ****** segact melval*nomod
  173. ** segact melval
  174. nexo = nexo + 1
  175. ******* segdes pilnec
  176. *
  177. segadj wrk52,wrk522
  178. typexo(nexo) = typdec
  179. conexo(nexo) = condec
  180. nomexo(nexo) = nomdec
  181. c write(6,*) 'suite',mobl,deche, nomdec, nexo ,liluc(/1)
  182. goto 40
  183.  
  184. else
  185. knmid = ijluc
  186. nomid = liluc(knmid,1)
  187. *pv segact nomid*mod
  188. nbrobl = lesobl(/2) + 1
  189. nbrfac = 0
  190. segadj nomid
  191. lesobl(nbrobl) = nomdec
  192. pilnec = liluc(knmid,2)
  193. *pv segact pilnec*mod
  194. mobl = nbrobl
  195. mfac = 0
  196. mran = indeso
  197. segadj pilnec
  198. pilobl(mobl,indec) = deche
  199. melval = ieldec
  200. ** segact melval
  201. ******** segact melval*nomod
  202. nexo = nexo + 1
  203. segadj wrk52,wrk522
  204. typexo(nexo) = typdec
  205. conexo(nexo) = condec
  206. nomexo(nexo) = nomdec
  207. * write(6,*) ' comouw ajout 2 ', pilnec ,nomid
  208. * write(6,*) 'suite',mobl,deche, nomdec, melval,nexo ,knmid
  209. goto 40
  210. endif
  211.  
  212. moterr(1:16) = condec
  213. moterr(17:24) = nomdec
  214. interr(1) = 1
  215. * write(6,*) ' comouw : pb classer ' , nomdec , deche
  216. call erreur(943)
  217. return
  218.  
  219. 40 continue
  220. enddo
  221. *
  222. *-------------------------------------------------
  223. c
  224. ipil = liluc
  225. iwrk52 = wrk52
  226. c
  227. RETURN
  228. END
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  

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