Télécharger choi.eso

Retour à la liste

Numérotation des lignes :

  1. C CHOI SOURCE CHAT 05/01/12 22:00:47 5004
  2. C positionnement d'un ensemble de flags
  3. C
  4. SUBROUTINE CHOI
  5. IMPLICIT INTEGER(I-N)
  6. -INC CCOPTIO
  7. -INC SMLMOTS
  8. external long
  9. dimension iob(22)
  10. logical vale(22)
  11. character*8 choix(22)
  12. character*11 choi2(23)
  13. character*3 oui,non
  14. character*72 messag
  15. oui='(X)'
  16. non='( )'
  17. call lircha(messag,1,iretou)
  18. if (iretou.eq.0) messag='Dans choi'
  19. llong=7
  20. choi2(1)='Ok'
  21. * d'abord recuperer les noms a proposer
  22. do 10 i=1,22
  23. call lirlog(vale(i),0,iretou)
  24. if (iretou.eq.0) goto 11
  25. call quenom(choix(i))
  26. llong=max(long(choix(i)),llong)
  27. 10 continue
  28. 11 continue
  29. if (ierr.ne.0) return
  30. nbr=i-1
  31. ncou=16
  32. CALL TRINIT(25,DIOCAD,DIOCAD,TITREE,0.15,.TRUE.,ncou)
  33. 30 continue
  34. do 20 i=1,nbr
  35. if (vale(i)) then
  36. choi2(i+1)=oui//choix(i)
  37. else
  38. choi2(i+1)=non//choix(i)
  39. endif
  40. 20 continue
  41. CALL MENU(choi2,nbr+1,11)
  42. call trmess(messag(1:long(messag)))
  43. CALL TRaff(ICLE)
  44. irep=icle+1
  45. if (irep.eq.1) goto 50
  46. vale(irep-1)=.not.vale(irep-1)
  47. goto 30
  48. 50 continue
  49. do 60 i=nbr,1,-1
  50. call ecrlog(vale(i))
  51. 60 continue
  52. end
  53.  
  54.  
  55.  
  56.  
  57.  

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