Télécharger dtmval.eso

Retour à la liste

Numérotation des lignes :

dtmval
  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.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. SEGMENT,MPTVAL
  23. INTEGER IPOS(NS) ,NSOF(NS)
  24. INTEGER IVAL(NCOSOU)
  25. CHARACTER*16 TYVAL(NCOSOU)
  26. ENDSEGMENT
  27. *
  28. IF (MPTVOL .EQ. 0 .OR. MODES.NE.3) RETURN
  29.  
  30. MPTVAL=MPTVOL
  31. LONG=IVAL(/1)
  32. IF (MODES .EQ.1) THEN
  33. DO 11 IO=1,LONG
  34. IF (IVAL(IO).NE.0) THEN
  35. MELVAL=IVAL(IO)
  36. SEGDES,MELVAL
  37. END IF
  38. 11 CONTINUE
  39. SEGSUP,MPTVAL
  40. * segdes mptval
  41. ELSE IF (MODES .EQ.2) THEN
  42. DO 21 IO=1,LONG
  43. IF (IVAL(IO).NE.0) THEN
  44. MELVAL=IVAL(IO)
  45. SEGDES,MELVAL
  46. END IF
  47. 21 CONTINUE
  48. SEGSUP,MPTVAL
  49. ELSE IF (MODES .EQ. 3)THEN
  50. DO 31 IO=1,LONG
  51. IF (IVAL(IO).NE.0) THEN
  52. MELVAL=IVAL(IO)
  53. SEGSUP,MELVAL
  54. * segdes melval
  55. END IF
  56. 31 CONTINUE
  57. SEGSUP,MPTVAL
  58. * segdes mptval
  59. ELSE
  60. INTERR(1)=MODES
  61. CALL ERREUR (555)
  62. END IF
  63. END
  64.  
  65.  
  66.  

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