Télécharger repart.eso

Retour à la liste

Numérotation des lignes :

  1. C REPART SOURCE FANDEUR 10/01/12 21:15:51 6600
  2. subroutine repart(mrigid)
  3. *
  4. * repartitionne une raideur pour la limiter a un enregistrement gemat
  5. * par sous-zone. Ca optimise gemat.
  6. *
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. -INC SMELEME
  11. -INC SMRIGID
  12.  
  13. MACRO, MSLS1(IS) = JSG(IS+1)
  14. MACRO, JSG = OOV
  15. MACRO, JDE = OOA
  16. MACRO, MDISG(ID)
  17. MDISG = (SIGN(ABS(JDE(OOT+(ID))+OOT),OOT)-MSLZ1)
  18. ENDMACRO
  19. MACRO, MSLZ1 = 4
  20.  
  21. INTEGER OOOVAL
  22. *
  23. LTRK=OOOVAL(1,4)
  24. if (LTRK.eq.0) LTRK=oooval(1,1)
  25.  
  26. iafair=0
  27. nbs=0
  28. segact mrigid
  29. do 100 irig=1,irigel(/2)
  30. xmatri=irigel(4,irig)
  31. LSEG=MSLS1(MDISG(xmatri))
  32. * write (6,*) ' repart lseg ',lseg
  33. nblprt=(LSEG-1)/LTRK + 1
  34. meleme=irigel(1,irig)
  35. segact meleme
  36. nbelem=num(/2)
  37. nblmax=(nbelem-1)/nblprt+1
  38. nblprt=(nbelem-1)/nblmax+1
  39. if (nbelem.gt.nblmax) iafair=1
  40. * if (nblprt.gt.1) iafair=1
  41. nbs=nbs+nblprt
  42. * write (6,*) ' re nblmax ',nbelem,nblmax
  43. * write (6,*) ' nblprt vaut ',nblprt
  44. segdes meleme
  45. 100 continue
  46. * write(6,*) 'nrigel nbs',irigel(/1),nbs
  47. if (iafair.eq.0) then
  48. segdes,mrigid
  49. return
  50. endif
  51. *
  52. * il y a du travail à faire
  53. nrigel=nbs
  54. segini ri1
  55. ri1.iforig=iforig
  56. ri1.mtymat=mtymat
  57. nbs=0
  58. nbsous=0
  59. nbref=0
  60. do 200 irig=1,irigel(/2)
  61. xmatri=irigel(4,irig)
  62. LSEG=MSLS1(MDISG(xmatri))
  63. nblprt=(LSEG+1)/LTRK + 1
  64. meleme=irigel(1,irig)
  65. segact meleme
  66. nbnn=num(/1)
  67. nbelee=num(/2)
  68. nblmax=(nbelee-1)/nblprt+1
  69. nblprt=(nbelee-1)/nblmax+1
  70. if (nbelee.le.nblmax) then
  71. * if (nblprt.eq.1) then
  72. nbs=nbs+1
  73. ri1.coerig(nbs)=coerig(irig)
  74. do im=1,irigel(/1)
  75. ri1.irigel(im,nbs)=irigel(im,irig)
  76. enddo
  77. else
  78. segact xmatri
  79. nligrd=re(/1)
  80. nligrp=re(/2)
  81. do 250 ipar=1,nblprt
  82. nbs=nbs+1
  83. jpar=nblmax*(ipar-1)
  84. nbelem=min(nblmax,nbelee-jpar)
  85. segini ipt2
  86. ipt2.itypel=itypel
  87. do 260 iel=1,nbelem
  88. jel=iel+jpar
  89. do 270 in=1,nbnn
  90. ipt2.num(in,iel)=num(in,jel)
  91. 270 continue
  92. ipt2.icolor(iel)=icolor(jel)
  93. 260 continue
  94. segdes ipt2
  95. nelrig=nbelem
  96. segini xmatr1
  97. do 280 iel=1,nelrig
  98. jel=iel+jpar
  99. do 280 ip=1,nligrp
  100. do 280 id=1,nligrd
  101. xmatr1.re(id,ip,iel)=re(id,ip,jel)
  102. 280 continue
  103. segdes xmatr1
  104. ri1.coerig(nbs)=coerig(irig)
  105. ri1.irigel(1,nbs)=ipt2
  106. ri1.irigel(2,nbs)=irigel(2,irig)
  107. ri1.irigel(3,nbs)=irigel(3,irig)
  108. ri1.irigel(4,nbs)=xmatr1
  109. do im=5,irigel(/1)
  110. ri1.irigel(im,nbs)=irigel(im,irig)
  111. enddo
  112. 250 continue
  113. segsup xmatri
  114. endif
  115. segdes meleme
  116. 200 continue
  117. segdes ri1
  118. segsup mrigid
  119. mrigid=ri1
  120. return
  121. end
  122.  
  123.  
  124.  

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