Télécharger comouw.eso

Retour à la liste

Numérotation des lignes :

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

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