Télécharger coml9.eso

Retour à la liste

Numérotation des lignes :

  1. C COML9 SOURCE PV 17/12/08 21:16:47 9660
  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. typree = .true.
  93. imadec = IMAMOD
  94. ifodec = IFOUR
  95. infdec(1) = 0
  96. infdec(2) = 0
  97. infdec(3) = NIFOUR
  98. infdec(4) = MINTE
  99. infdec(5) = 0
  100. infdec(6) = lesupp
  101. * cree melval
  102. c* Attention n2ptel <=> wrk53.n2ptel & n2el <=> wrk53.n2el
  103. n1ptel = wrk53.nbptel
  104. n1el = wrk53.nel
  105. n2ptel = 0
  106. n2el = 0
  107. segini,melval
  108. ieldec = melval
  109.  
  110. * boucle sur les modeles
  111. do 31 iv = 1,ivamod(/1)
  112. if (tymode(iv).eq.'IMODEL') then
  113. imode1 = ivamod(iv)
  114. segact,imode1
  115. else
  116. goto 31
  117. endif
  118. * somme les contributions
  119. do idcon = 1, lilcon(/1)
  120. dec1 = lilcon(idcon)
  121. if (dec1.gt.0) then
  122. if (dec1.nomdec.eq.nomdec.and.dec1.condec.eq.imode1.conmod)
  123. & then
  124. melva1 = dec1.ieldec
  125. ** segact,melva1
  126. im1 = melva1.velche(/1)
  127. jm1 = melva1.velche(/2)
  128.  
  129. do idco2 = 1,lilcon(/1)
  130. dec2 = lilcon(idco2)
  131. if (dec2.gt.0) then
  132. C-??-??- if (dec2.nomdec(1:8).eq.imode1.conmod(17:24)) then
  133. if (dec2.nomdec(1:4).eq.imode1.conmod(17:21)) then
  134. melva2 = dec2.ieldec
  135. ** segact,melva2
  136. im2 = melva2.velche(/1)
  137. jm2 = melva2.velche(/2)
  138. *
  139. do jel = 1,n1el
  140. j1 = min(jel,jm1)
  141. j2 = min(jel,jm2)
  142. do jptel = 1,n1ptel
  143. i1 = min(jptel,im1)
  144. i2 = min(jptel,im2)
  145. velche(jptel,jel) = ( melva1.velche(i1,j1)*melva2.velche(i2,j2))
  146. & + velche(jptel,jel)
  147. enddo
  148. enddo
  149. *** segdes,melva2
  150. endif
  151. endif
  152. enddo
  153. *** segdes,melva1
  154. endif
  155. endif
  156. enddo
  157. 31 continue
  158. enddo
  159.  
  160. segdes,nomid
  161. if (lsupco) segsup,nomid
  162. segsup,wrk53
  163.  
  164. RETURN
  165. END
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  

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