Télécharger kamlpt.eso

Retour à la liste

Numérotation des lignes :

  1. C KAMLPT SOURCE CHAT 05/01/13 00:51:11 5004
  2. SUBROUTINE KAMLPT(MELEM1,MELEMI,MELEMO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*****************************************************************************
  6. C
  7. C Dans les references les objets maillages originaux apparaissent
  8. C dans la numerotation locale
  9. C
  10. C*****************************************************************************
  11.  
  12. -INC SMELEME
  13. POINTEUR MELEM1.MELEME,MELEMI.MELEME,MELEMO.MELEME
  14. POINTEUR MELEMG.MELEME
  15.  
  16.  
  17. SEGACT MELEM1
  18. NPT=MELEM1.NUM(/2)
  19. C n1=MELEM1.NUM(/1)
  20. C write(6,*)' DAns kamlpt DEBUT :npt=',npt,' n1=',n1
  21. C & ,'MELEM1=',melem1
  22. C write(6,1001)(melem1.num(1,ii),ii=1,npt)
  23.  
  24. CALL CREMLG(NPT,MELEMG)
  25.  
  26. MELEME=MELEMI
  27. SEGACT MELEME
  28. NBSOUS=LISOUS(/1)
  29. IF(NBSOUS.EQ.0)NBSOUS=1
  30.  
  31. NBSI=NBSOUS
  32.  
  33. NBNN=1
  34. NBELEM=NPT
  35. NBSOUS=0
  36. NBREF=NBSI+1
  37. SEGINI MELEME
  38. ITYPEL=1
  39. MELEMO=MELEME
  40.  
  41. DO 3 K=1,NBELEM
  42. NUM(1,K)=MELEM1.NUM(1,K)
  43. 3 CONTINUE
  44.  
  45. C write(6,*)' DAns kamlpt NUM = NPT=',npt,nbelem
  46. C & ,'MELEMO=',melemo
  47. C write(6,1001)(num(1,ii),ii=1,npt)
  48.  
  49. SEGACT MELEMI
  50. DO 4 KS=1,NBSI
  51. IPT1=MELEMI
  52. IF(NBSI.NE.1)IPT1=MELEMI.LISOUS(KS)
  53. MELEMO.LISREF(KS)=IPT1
  54. SEGDES IPT1
  55. 4 CONTINUE
  56. MELEMO.LISREF(NBREF)=MELEMG
  57. SEGDES MELEMI,MELEMO,MELEM1
  58.  
  59. RETURN
  60. 1001 FORMAT(20(1x,I5))
  61. END
  62.  
  63.  

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