Télécharger licht.eso

Retour à la liste

Numérotation des lignes :

  1. C LICHT SOURCE MAGN 17/02/24 21:15:21 9323
  2. SUBROUTINE LICHT(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 en lecture/ecriture (Historique)
  8. C connaissant le pointeur MCHPOI, (comme LICHTM, voir aussi LICHTL),
  9. C d'un CHPOINT et renvoie aussi le pointeur IGEOC (non actif)
  10. C MSOUPO a lui aussi ete desactivé
  11. C
  12. C***********************************************************************
  13. C HISTORIQUE : 26/10/98 : prise en compte du cas particulier
  14. C où MCHPOI est vide (NSOUPO=0 ou MCHPOI=0),
  15. C on renvoie alors
  16. C MPOVAL=0 et IGEOM=0 sans messages d'erreur...
  17. C HISTORIQUE :
  18. C HISTORIQUE :
  19. C***********************************************************************
  20. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  21. C en cas de modification de ce sous-programme afin de faciliter
  22. C la maintenance !
  23. C***********************************************************************
  24. -INC CCOPTIO
  25. -INC SMCHPOI
  26. CHARACTER*8 TYPE
  27. IF (MCHPOI.NE.0) THEN
  28. SEGACT MCHPOI
  29. TYPE=MTYPOI
  30. NSOUPO=IPCHP(/1)
  31. IF(NSOUPO.EQ.0) THEN
  32. IGEOM=0
  33. MPOVAL=0
  34. ELSEIF(NSOUPO.EQ.1) THEN
  35. MSOUPO=IPCHP(1)
  36. SEGACT MSOUPO
  37. IGEOM=IGEOC
  38. MPOVAL=IPOVAL
  39. SEGDES MSOUPO
  40. SEGACT MPOVAL*MOD
  41. ELSE
  42. * WRITE(IOIMP,*) ' Le chpoint MCHPOI=',MCHPOI
  43. * $ ,'est partitionné..'
  44. * WRITE(IOIMP,*) ' NSOUPO=',NSOUPO
  45. IGEOM=0
  46. MPOVAL=0
  47. * GOTO 9999
  48. ENDIF
  49. SEGDES MCHPOI
  50. ELSE
  51. MPOVAL=0
  52. TYPE=' '
  53. IGEOM=0
  54. ENDIF
  55. *
  56. * Normal termination
  57. *
  58. RETURN
  59. *
  60. * Error handling
  61. *
  62. 9999 CONTINUE
  63. WRITE(IOIMP,*) 'An error was detected in subroutine licht'
  64. RETURN
  65. END
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  

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