Télécharger comouw.eso

Retour à la liste

Numérotation des lignes :

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

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