Esope source files

   1 : C KRIPME    SOURCE    CHAT      05/01/13    01:07:29     5004           
   2 :       SUBROUTINE KRIPME(MAIL,NRANGE,
   3 :      $     KRENTI,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : KRIPME
   9 : C DESCRIPTION : Inspiré de KRIPAD.
  10 : C               On construit KRENTI tel que 
  11 : C               KRENTI(MAIL.NUM(1,i))=i
  12 : C               Les entiers de MAIL sont compris entre 1 et NRANGE
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELES          : RSETEE
  19 : C APPELES (UTIL.)  : OOOETA
  20 : C APPELE PAR       : PROMAT
  21 : C***********************************************************************
  22 : C ENTREES            : MAIL, NRANGE
  23 : C SORTIES            : KRENTI
  24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25 : C***********************************************************************
  26 : C VERSION    : v1, 03/02/99, version initiale
  27 : C HISTORIQUE : v1, 03/02/99, création
  28 : C HISTORIQUE :
  29 : C HISTORIQUE :
  30 : C***********************************************************************
  31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32 : C en cas de modification de ce sous-programme afin de faciliter
  33 : C la maintenance !
  34 : C***********************************************************************
  35 : -INC CCOPTIO
  36 : -INC SMELEME
  37 :       POINTEUR MAIL.MELEME
  38 : -INC SMLENTI
  39 :       INTEGER JG
  40 :       POINTEUR KRENTI.MLENTI
  41 : *
  42 :       INTEGER NRANGE
  43 :       INTEGER IMPR,IRET
  44 : *
  45 :       INTEGER MAETA
  46 :       INTEGER NSOUS,NPOEL,NELEM
  47 : *     
  48 : * Executable statements
  49 : *
  50 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans kripme.eso'
  51 :       JG=NRANGE
  52 :       SEGINI KRENTI
  52 :       CALL OOOETA(MAIL,MAETA)
  53 :       IF (MAETA.NE.1) SEGACT MAIL
  54 :       NSOUS=MAIL.LISOUS(/1)
  55 :       IF (NSOUS.NE.0) THEN
  56 :          WRITE(IOIMP,*) 'Maillage partitionné non autorisé'
  57 :          GOTO 9999
  58 :       ENDIF
  59 :       NPOEL=MAIL.NUM(/1)
  60 :       IF (NPOEL.NE.1) THEN
  61 :          WRITE(IOIMP,*) 'On veut un maillage de points'
  62 :          GOTO 9999
  63 :       ENDIF
  64 :       NELEM=MAIL.NUM(/2)
  64 :       CALL RSETEE(MAIL.NUM,NELEM,
  65 :      $     KRENTI.LECT,NRANGE,
  66 :      $     IMPR,IRET)
  67 :       IF (IRET.NE.0) GOTO 9999
  68 :       IF (MAETA.NE.1) SEGDES MAIL
  69 :       SEGDES KRENTI
  70 : *     
  71 : * Normal termination
  72 : *
  73 :       IRET=0
  74 :       RETURN
  75 : *
  76 : * Format handling
  77 : *
  78 : *
  79 : * Error handling
  80 : *
  81 :  9999 CONTINUE
  82 :       IRET=1
  83 :       WRITE(IOIMP,*) 'An error was detected in subroutine kripme'
  84 :       RETURN
  85 : *
  86 : * End of subroutine KRIPME
  87 : *
  88 :       END
  89 : 
  90 : 
  91 :  
  92 :  
  93 :  
  94 :