Télécharger coml9.eso

Retour à la liste

Numérotation des lignes :

  1. C COML9 SOURCE BP208322 17/03/01 21:16:24 9325
  2.  
  3. SUBROUTINE COML9(iqmod,ipcon,ipinf,indeso,IRETOU,insupp)
  4.  
  5. *-----------------------------------------------------------------------
  6. * coml9 :
  7. * traitement non-local
  8. * pour une loi de melange, etablir la contraite moyenne
  9. *-----------------------------------------------------------------------
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC SMCHAML
  16. -INC SMELEME
  17. -INC SMMODEL
  18. -INC DECHE
  19. SEGMENT INFO
  20. INTEGER INFELL(16)
  21. ENDSEGMENT
  22. LOGICAL lsupco
  23. CHARACTER*8 lcon
  24.  
  25. * Obligation d'initialiser ce segment WRK53 (DECHE) compte tenu du
  26. * fait que les variables de dimensionnement des melval ont le meme
  27. * nom que des variables contenues dans ce segment.
  28. * Si on ne le fait pas, plantage GEMAT !!!i
  29. * A revoir par la suite pour supprimer l'utilisation du segment wrk53.
  30. segini,wrk53
  31.  
  32. lilcon = ipcon
  33. IMODEL = IQMOD
  34.  
  35. meleme = IMAMOD
  36. SEGACT,meleme*nomod
  37. wrk53.nel = num(/2)
  38. SEGDES,meleme
  39.  
  40. c information sur l'element fini
  41. c____________________________________________________________________
  42. if (ipinf.ne.0) then
  43. INFO=IPINF
  44. c* segact,info
  45. MINTE = INFELL(11)
  46. wrk53.nbptel = INFELL(4)
  47. c* segdes,info
  48. else
  49. MINTE = INFMOD(2+insupp)
  50. wrk53.nbptel = INFELE(4)
  51. endif
  52. c
  53. c modele de melange mecanique : nom des composantes
  54. c
  55. lsupco=.false.
  56. do iv = 1 , ivamod(/1)
  57. if (tymode(iv).eq.'IMODEL') then
  58. imode1 = ivamod(iv)
  59. segact,imode1
  60. if (imode1.formod(1).eq.'MECANIQUE') then
  61. if (imode1.lnomid(4).ne.0) then
  62. mocomp = imode1.lnomid(4)
  63. else
  64. lsupco=.true.
  65. CALL IDCONT(IMODE1,IFOUR,MOCOMP,NOBL,NFAC)
  66. endif
  67. goto 11
  68. endif
  69. endif
  70. enddo
  71.  
  72. 11 CONTINUE
  73. lesupp = 5
  74. nomid = mocomp
  75. segact nomid*nomod
  76. nobl = lesobl(/2)
  77. nfac = lesfac(/2)
  78.  
  79. ijlcon = lilcon(/1)
  80. iilcon = ijlcon + nobl + nfac
  81. segadj lilcon
  82.  
  83. do icom = 1,nobl
  84. * cree deche
  85. N3 = 6
  86. segini deche
  87. lilcon(ijlcon + icom) = deche
  88. indec = indeso
  89. nomdec = lesobl(icom)
  90. condec = CONMOD
  91. typdec = 'REAL*8'
  92. imadec = IMAMOD
  93. ifodec = IFOUR
  94. infdec(1) = 0
  95. infdec(2) = 0
  96. infdec(3) = NIFOUR
  97. infdec(4) = MINTE
  98. infdec(5) = 0
  99. infdec(6) = lesupp
  100. * cree melval
  101. c* Attention n2ptel <=> wrk53.n2ptel & n2el <=> wrk53.n2el
  102. n1ptel = wrk53.nbptel
  103. n1el = wrk53.nel
  104. n2ptel = 0
  105. n2el = 0
  106. segini,melval
  107. ieldec = melval
  108.  
  109. * boucle sur les modeles
  110. do 31 iv = 1,ivamod(/1)
  111. if (tymode(iv).eq.'IMODEL') then
  112. imode1 = ivamod(iv)
  113. segact,imode1
  114. else
  115. goto 31
  116. endif
  117. * somme les contributions
  118. do idcon = 1, lilcon(/1)
  119. dec1 = lilcon(idcon)
  120. if (dec1.gt.0) then
  121. if (dec1.nomdec.eq.nomdec.and.dec1.condec.eq.imode1.conmod)
  122. & then
  123. melva1 = dec1.ieldec
  124. ** segact,melva1
  125. im1 = melva1.velche(/1)
  126. jm1 = melva1.velche(/2)
  127.  
  128. do idco2 = 1,lilcon(/1)
  129. dec2 = lilcon(idco2)
  130. if (dec2.gt.0) then
  131. C-??-??- if (dec2.nomdec(1:8).eq.imode1.conmod(17:24)) then
  132. if (dec2.nomdec(1:4).eq.imode1.conmod(17:21)) then
  133. melva2 = dec2.ieldec
  134. ** segact,melva2
  135. im2 = melva2.velche(/1)
  136. jm2 = melva2.velche(/2)
  137. *
  138. do jel = 1,n1el
  139. j1 = min(jel,jm1)
  140. j2 = min(jel,jm2)
  141. do jptel = 1,n1ptel
  142. i1 = min(jptel,im1)
  143. i2 = min(jptel,im2)
  144. velche(jptel,jel) = ( melva1.velche(i1,j1)*melva2.velche(i2,j2))
  145. & + velche(jptel,jel)
  146. enddo
  147. enddo
  148. *** segdes,melva2
  149. endif
  150. endif
  151. enddo
  152. *** segdes,melva1
  153. endif
  154. endif
  155. enddo
  156. 31 continue
  157. enddo
  158.  
  159. segdes,nomid
  160. if (lsupco) segsup,nomid
  161. segsup,wrk53
  162.  
  163. RETURN
  164. END
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  

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