Esope source files

   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
  34 :             CALL ECRCHA('POI1')
  34 :             CALL ECROBJ('MAILLAGE',MELEME)
  34 :             CALL PRCHAN
  35 :             TYPE='MAILLAGE'
  35 :             CALL LIROBJ(TYPE,MELEM1,1,IRET)
  36 :             IF(IRET.EQ.0)THEN
  37 :                WRITE(IOIMP,*) 'On n''arrive pas a creer'
  38 :                WRITE(IOIMP,*) 'un MELEME de POI1.'
  39 :                MLENTI=0
  40 : C              SEGDES MELEM0
  41 :                GOTO 9999
  42 :             ENDIF
  43 :             MELEME=MELEM1
  44 :             SEGACT MELEME
  45 :          ENDIF
  46 :          NPTD=NUM(/2)
  46 :          CALL RSETXI(LECT,NUM,NPTD)
  47 : ***      IF(MELEM1.NE.0)SEGSUP MELEM1
  48 : C        SEGDES MELEM0
  49 :       ENDIF
  50 : *
  51 : * Normal termination
  52 : *
  53 :       RETURN
  54 : *
  55 : * Error handling
  56 : *
  57 :  9999 CONTINUE
  58 :       WRITE(IOIMP,*) 'An error was detected in subroutine kripad'
  59 :       RETURN
  60 :       END
  61 : 
  62 :  
  63 :  
  64 :  
  65 :