Télécharger kripad.eso

Retour à la liste

Numérotation des lignes :

  1. C KRIPAD SOURCE PV 13/04/12 21:15:43 7756
  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. -INC CCOPTIO
  21. -INC SMCOORD
  22. -INC SMLENTI
  23. -INC SMELEME
  24. POINTEUR MELEM1.MELEME
  25. POINTEUR MELEM0.MELEME
  26. CHARACTER*8 TYPE
  27. C***
  28. JG=XCOOR(/1)/(IDIM+1)
  29. SEGINI MLENTI
  30. MELEM1=0
  31. MELEME=MELEM0
  32. IF (MELEME.NE.0) THEN
  33. SEGACT MELEME
  34. IF(ITYPEL.NE.1)THEN
  35. CALL ECRCHA('POI1')
  36. CALL ECROBJ('MAILLAGE',MELEME)
  37. CALL PRCHAN
  38. TYPE='MAILLAGE'
  39. CALL LIROBJ(TYPE,MELEM1,1,IRET)
  40. IF(IRET.EQ.0)THEN
  41. WRITE(IOIMP,*) 'On n''arrive pas a creer'
  42. WRITE(IOIMP,*) 'un MELEME de POI1.'
  43. MLENTI=0
  44. C SEGDES MELEM0
  45. GOTO 9999
  46. ENDIF
  47. MELEME=MELEM1
  48. SEGACT MELEME
  49. ENDIF
  50. NPTD=NUM(/2)
  51. CALL RSETXI(LECT,NUM,NPTD)
  52. *** IF(MELEM1.NE.0)SEGSUP MELEM1
  53. C SEGDES MELEM0
  54. ENDIF
  55. *
  56. * Normal termination
  57. *
  58. RETURN
  59. *
  60. * Error handling
  61. *
  62. 9999 CONTINUE
  63. WRITE(IOIMP,*) 'An error was detected in subroutine kripad'
  64. RETURN
  65. END
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  

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