Télécharger coml9.eso

Retour à la liste

Numérotation des lignes :

  1. C COML9 SOURCE CB215821 18/09/13 21:15:23 9917
  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.
  123. & dec1.condec(1:LCONMO).eq.imode1.conmod(1:LCONMO))
  124. & then
  125. melva1 = dec1.ieldec
  126. ** segact,melva1
  127. im1 = melva1.velche(/1)
  128. jm1 = melva1.velche(/2)
  129.  
  130. do idco2 = 1,lilcon(/1)
  131. dec2 = lilcon(idco2)
  132. if (dec2.gt.0) then
  133. C-??-??- if (dec2.nomdec(1:8).eq.imode1.conmod(17:24)) then
  134. if (dec2.nomdec(1:4).eq.imode1.conmod(17:20)) then
  135. melva2 = dec2.ieldec
  136. ** segact,melva2
  137. im2 = melva2.velche(/1)
  138. jm2 = melva2.velche(/2)
  139. *
  140. do jel = 1,n1el
  141. j1 = min(jel,jm1)
  142. j2 = min(jel,jm2)
  143. do jptel = 1,n1ptel
  144. i1 = min(jptel,im1)
  145. i2 = min(jptel,im2)
  146. velche(jptel,jel) = ( melva1.velche(i1,j1)*melva2.velche(i2,j2))
  147. & + velche(jptel,jel)
  148. enddo
  149. enddo
  150. *** segdes,melva2
  151. endif
  152. endif
  153. enddo
  154. *** segdes,melva1
  155. endif
  156. endif
  157. enddo
  158. 31 continue
  159. enddo
  160.  
  161. segdes,nomid
  162. if (lsupco) segsup,nomid
  163. segsup,wrk53
  164.  
  165. RETURN
  166. END
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  

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