Télécharger kripad.eso

Retour à la liste

Numérotation des lignes :

  1. C KRIPAD SOURCE PV 20/03/30 21:20:37 10567
  2. SUBROUTINE KRIPAD(MELEM0,MLENTI)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C Cree et remplit un segment MLENTI avec le meleme qu'on lui envoie
  7. C Si le meleme envoyé n'est pas composé de POI1 On le cree
  8. C et on le detruit apres
  9. C*************************************************************************
  10. C HISTORIQUE : 26/10/98 : si on envoie un MELEM0 de pointeur
  11. C nul alors le MLENTI en sortie ne contient que
  12. C des zeros.
  13. C HISTORIQUE :
  14. C HISTORIQUE :
  15. C***********************************************************************
  16. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  17. C en cas de modification de ce sous-programme afin de faciliter
  18. C la maintenance !
  19. C***********************************************************************
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMCOORD
  24. -INC SMLENTI
  25. -INC SMELEME
  26. POINTEUR MELEM1.MELEME
  27. POINTEUR MELEM0.MELEME
  28. CHARACTER*8 TYPE
  29. C***
  30. JG=nbpts
  31. SEGINI MLENTI
  32. MELEM1=0
  33. MELEME=MELEM0
  34. IF (MELEME.NE.0) THEN
  35. SEGACT MELEME
  36. IF(ITYPEL.NE.1)THEN
  37. CALL ECRCHA('POI1')
  38. CALL ECROBJ('MAILLAGE',MELEME)
  39. CALL PRCHAN
  40. TYPE='MAILLAGE'
  41. CALL LIROBJ(TYPE,MELEM1,1,IRET)
  42. IF(IRET.EQ.0)THEN
  43. WRITE(IOIMP,*) 'On n''arrive pas a creer'
  44. WRITE(IOIMP,*) 'un MELEME de POI1.'
  45. MLENTI=0
  46. C SEGDES MELEM0
  47. GOTO 9999
  48. ENDIF
  49. MELEME=MELEM1
  50. SEGACT MELEME
  51. ENDIF
  52. NPTD=NUM(/2)
  53. CALL RSETXI(LECT,NUM,NPTD)
  54. *** IF(MELEM1.NE.0)SEGSUP MELEM1
  55. C SEGDES MELEM0
  56. ENDIF
  57. *
  58. * Normal termination
  59. *
  60. RETURN
  61. *
  62. * Error handling
  63. *
  64. 9999 CONTINUE
  65. WRITE(IOIMP,*) 'An error was detected in subroutine kripad'
  66. RETURN
  67. END
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  

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