Esope source files

   1 : C LRCHT     SOURCE    CHAT      05/01/13    01:25:18     5004           
   2 :       SUBROUTINE LRCHT(MCHPOI,MPOVAL,TYPE,IGEOM)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C     
   7 : C Ce SP active le segment MPOVAL connaissant le pointeur MCHPOI
   8 : C uniquement en lecture a la difference de licht qui l'active
   9 : C en lecture et ecriture
  10 : C d'un CHPOINT et renvoie aussi le pointeur IGEOC (non actif)
  11 : C MSOUPO a lui aussi ete desactivé
  12 : C
  13 : C***********************************************************************
  14 : C HISTORIQUE : 26/10/98 : prise en compte du cas particulier
  15 : C              où MCHPOI est vide (NSOUPO=0 ou MCHPOI=0), 
  16 : C              on renvoie alors
  17 : C              MPOVAL=0 et IGEOM=0 sans messages d'erreur...
  18 : C HISTORIQUE : 21/09/00 Creation de LRCHT a partir de LICHT
  19 : C HISTORIQUE :
  20 : C***********************************************************************
  21 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  22 : C en cas de modification de ce sous-programme afin de faciliter
  23 : C la maintenance !
  24 : C***********************************************************************
  25 : -INC CCOPTIO
  26 : -INC SMCHPOI
  27 :       CHARACTER*8 TYPE
  28 :       IF (MCHPOI.NE.0) THEN
  29 :          SEGACT MCHPOI
  30 :          TYPE=MTYPOI
  31 :          NSOUPO=IPCHP(/1)
  32 :          IF(NSOUPO.EQ.0) THEN
  33 :             IGEOM=0
  34 :             MPOVAL=0
  35 :          ELSEIF(NSOUPO.EQ.1) THEN
  36 :             MSOUPO=IPCHP(1)
  37 :             SEGACT MSOUPO
  38 :             IGEOM=IGEOC
  39 :             MPOVAL=IPOVAL
  40 :             SEGDES MSOUPO
  41 :             SEGACT MPOVAL
  42 :          ELSE
  43 :             WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI
  44 :      $           ,'est partitionné..'
  45 :             WRITE(IOIMP,*) ' NSOUPO=',NSOUPO
  46 :             IGEOM=0
  47 :             MPOVAL=0
  48 :             GOTO 9999
  49 :          ENDIF
  50 :          SEGDES MCHPOI
  51 :       ELSE
  52 :          MPOVAL=0
  53 :          TYPE='        '
  54 :          IGEOM=0
  55 :       ENDIF
  56 : *
  57 : * Normal termination
  58 : *
  59 :       RETURN
  60 : *
  61 : * Error handling
  62 : *
  63 :  9999 CONTINUE
  64 :       WRITE(IOIMP,*) 'An error was detected in subroutine licht'
  65 :       RETURN
  66 :       END
  67 : 
  68 :  
  69 :  
  70 :  
  71 :