Télécharger la plaquette Cast3M


fr en

Télécharger lrcht.eso

Retour à la liste

Numérotation des lignes : 

lrcht

  1. C LRCHT     SOURCE    CB215821  20/11/25    13:33:59     10792          
  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 PPARAM
  26. -INC CCOPTIO
  27. -INC SMCHPOI
  28.       CHARACTER*8 TYPE
  29.       IF (MCHPOI.NE.0) THEN
  30.          SEGACT MCHPOI
  31.          TYPE=MTYPOI
  32.          NSOUPO=IPCHP(/1)
  33.          IF(NSOUPO.EQ.0) THEN
  34.             IGEOM=0
  35.             MPOVAL=0
  36.          ELSEIF(NSOUPO.EQ.1) THEN
  37.             MSOUPO=IPCHP(1)
  38.             SEGACT MSOUPO
  39.             IGEOM=IGEOC
  40.             MPOVAL=IPOVAL
  41.             SEGDES MSOUPO
  42.             SEGACT MPOVAL
  43.          ELSE
  44.             WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI
  45.      $           ,'est partitionné..'
  46.             WRITE(IOIMP,*) ' NSOUPO=',NSOUPO
  47.             IGEOM=0
  48.             MPOVAL=0
  49.             GOTO 9999
  50.          ENDIF
  51.          SEGDES MCHPOI
  52.       ELSE
  53.          MPOVAL=0
  54.          TYPE='        '
  55.          IGEOM=0
  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 licht'
  66.       RETURN
  67.       END
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  

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