Télécharger dbbcf.eso

Retour à la liste

Numérotation des lignes :

  1. C DBBCF SOURCE PV 06/03/14 21:15:01 5334
  2. * dedualise les valeurs d'un champ en fonction d'un meleme de dedoublement de noeuds
  3. *
  4. subroutine dbbcf(mchpoi,ipt8)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. -INC CCOPTIO
  8. -INC SMELEME
  9. -INC SMCHPOI
  10. -INC SMCOORD
  11. segment valc(ipt8.num(/2))
  12. segment ivalc(ipt8.num(/2))
  13. segment trav
  14. integer lag1(xcoor(/1)/(idim+1))
  15. endsegment
  16. * ne fonctionne que pour des LX, on suppose qu'il n'y a qu'une inconnue
  17. * par noeud dédoublé
  18. if (ipt8.eq.0) return
  19. segact mchpoi,ipt8
  20. segini valc,ivalc
  21. segini trav
  22. do 300 i=1,ipt8.num(/2)
  23. lag1(ipt8.num(1,i))=i
  24. lag1(ipt8.num(2,i))=i
  25. 300 continue
  26. do 10 isoupo=1,ipchp(/1)
  27. msoupo=ipchp(isoupo)
  28. segact msoupo*mod
  29. if (nocomp(/2).ne.1) goto 11
  30. if (nocomp(1).ne.'LX') goto 11
  31. meleme=igeoc
  32. mpoval=ipoval
  33. segini,ipt1=meleme,mpova1=mpoval
  34. nbnn=ipt1.num(/1)
  35. nbelem=ipt1.num(/2)
  36. nbele=nbelem
  37. nbsous=0
  38. nbref=0
  39. ic=0
  40. do 100 j=1,nbele
  41. val=mpova1.vpocha(j,1)
  42. if (lag1(ipt1.num(1,j)).ne.0) then
  43. jj=lag1(ipt1.num(1,j))
  44. valc(jj)=valc(jj)+val
  45. if (ivalc(jj).ne.0) then
  46. ipt1.num(1,ivalc(jj))=ipt8.num(1,jj)
  47. mpova1.vpocha(ivalc(jj),1)=valc(jj)
  48. goto 100
  49. endif
  50. ivalc(jj)=ic+1
  51. endif
  52. 110 continue
  53. ic=ic+1
  54. ipt1.num(1,ic)=ipt1.num(1,j)
  55. mpova1.vpocha(ic,1)=val
  56. 100 continue
  57. nbelem=ic
  58. segadj ipt1
  59. segdes ipt1
  60. n=ic
  61. nc=1
  62. segadj mpova1
  63. segdes mpova1
  64. igeoc=ipt1
  65. ipoval=mpova1
  66. segsup mpoval
  67. segdes meleme
  68. 11 continue
  69. segdes msoupo
  70. 10 continue
  71. segsup valc,ivalc,trav
  72. return
  73. end
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  

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