Télécharger la plaquette Cast3M


fr en

Télécharger kripad.eso

Retour à la liste

Numérotation des lignes : 

kripad

  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