Télécharger dtmval.eso

Retour à la liste

Numérotation des lignes :

  1. C DTMVAL SOURCE CHAT 09/09/09 21:15:00 6496
  2. SUBROUTINE DTMVAL(MPTVOL,MODES)
  3. *
  4. *---------------------------------------------------------------*
  5. * utilitaire de desactivation/destruction associe au *
  6. * segment "MPTVAL" *
  7. * *
  8. * MPTVOL: pointeur sur un segment MPTVAL (actif) *
  9. * MODES : mode de desactivation des segments pointes par *
  10. * IVAL ==> 1 = SEGDES *
  11. * ==> 2 = SEGDES *
  12. * ==> 3 = SEGSUP *
  13. * *
  14. * PP 16/8/91 *
  15. * CLB 11/02/92 *
  16. *---------------------------------------------------------------*
  17. IMPLICIT INTEGER(I-N)
  18. -INC SMCHAML
  19. -INC CCOPTIO
  20. SEGMENT,MPTVAL
  21. INTEGER IPOS(NS) ,NSOF(NS)
  22. INTEGER IVAL(NCOSOU)
  23. CHARACTER*16 TYVAL(NCOSOU)
  24. ENDSEGMENT
  25. *
  26. IF (MPTVOL .NE. 0) THEN
  27. MPTVAL=MPTVOL
  28. LONG=IVAL(/1)
  29. IF (MODES .EQ.1) THEN
  30. DO 11 IO=1,LONG
  31. IF (IVAL(IO).NE.0) THEN
  32. MELVAL=IVAL(IO)
  33. SEGDES,MELVAL
  34. END IF
  35. 11 CONTINUE
  36. SEGSUP,MPTVAL
  37. * segdes mptval
  38. ELSE IF (MODES .EQ.2) THEN
  39. DO 21 IO=1,LONG
  40. IF (IVAL(IO).NE.0) THEN
  41. MELVAL=IVAL(IO)
  42. SEGDES,MELVAL
  43. END IF
  44. 21 CONTINUE
  45. SEGSUP,MPTVAL
  46. ELSE IF (MODES .EQ. 3)THEN
  47. DO 31 IO=1,LONG
  48. IF (IVAL(IO).NE.0) THEN
  49. MELVAL=IVAL(IO)
  50. SEGSUP,MELVAL
  51. * segdes melval
  52. END IF
  53. 31 CONTINUE
  54. SEGSUP,MPTVAL
  55. * segdes mptval
  56. ELSE
  57. INTERR(1)=MODES
  58. CALL ERREUR (555)
  59. END IF
  60. *
  61. END IF
  62. RETURN
  63. END
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  

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