Télécharger dtmval.eso

Retour à la liste

Numérotation des lignes :

  1. C DTMVAL SOURCE CB215821 19/07/30 21:15:51 10273
  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 .EQ. 0 .OR. MODES.NE.3) RETURN
  27.  
  28. MPTVAL=MPTVOL
  29. LONG=IVAL(/1)
  30. IF (MODES .EQ.1) THEN
  31. DO 11 IO=1,LONG
  32. IF (IVAL(IO).NE.0) THEN
  33. MELVAL=IVAL(IO)
  34. SEGDES,MELVAL
  35. END IF
  36. 11 CONTINUE
  37. SEGSUP,MPTVAL
  38. * segdes mptval
  39. ELSE IF (MODES .EQ.2) THEN
  40. DO 21 IO=1,LONG
  41. IF (IVAL(IO).NE.0) THEN
  42. MELVAL=IVAL(IO)
  43. SEGDES,MELVAL
  44. END IF
  45. 21 CONTINUE
  46. SEGSUP,MPTVAL
  47. ELSE IF (MODES .EQ. 3)THEN
  48. DO 31 IO=1,LONG
  49. IF (IVAL(IO).NE.0) THEN
  50. MELVAL=IVAL(IO)
  51. SEGSUP,MELVAL
  52. * segdes melval
  53. END IF
  54. 31 CONTINUE
  55. SEGSUP,MPTVAL
  56. * segdes mptval
  57. ELSE
  58. INTERR(1)=MODES
  59. CALL ERREUR (555)
  60. END IF
  61. END
  62.  
  63.  
  64.  

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