Télécharger lrcht.eso

Retour à la liste

Numérotation des lignes :

  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.  
  72.  

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