Télécharger dbbcd.eso

Retour à la liste

Numérotation des lignes :

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

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