Télécharger choi.eso

Retour à la liste

Numérotation des lignes :

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

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