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

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