Télécharger lichtm.eso

Retour à la liste

Numérotation des lignes :

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

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