Download choi.eso

Back to the list

   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='( )'
  16 :       call lircha(messag,1,iretou)
  17 :       if (iretou.eq.0) messag='Dans choi'
  18 :       llong=7
  19 :       choi2(1)='Ok'
  20 : *  d'abord recuperer les noms a proposer
  21 :       do 10 i=1,22
  21 :         call lirlog(vale(i),0,iretou)
  22 :         if (iretou.eq.0) goto 11
  22 :         call quenom(choix(i))
  23 :         llong=max(long(choix(i)),llong)
  24 :   10  continue
  25 :   11  continue
  26 :       if (ierr.ne.0) return
  27 :       nbr=i-1
  28 :       ncou=16
  28 :       CALL TRINIT(25,DIOCAD,DIOCAD,TITREE,0.15,.TRUE.,ncou)
  29 :   30  continue
  30 :       do 20 i=1,nbr
  31 :         if (vale(i)) then
  32 :           choi2(i+1)=oui//choix(i)
  33 :         else
  34 :           choi2(i+1)=non//choix(i)
  35 :         endif
  36 :   20  continue
  36 :       CALL MENU(choi2,nbr+1,11)
  36 :       call trmess(messag(1:long(messag)))
  36 :       CALL TRaff(ICLE)
  37 :       irep=icle+1
  38 :       if (irep.eq.1) goto 50
  39 :       vale(irep-1)=.not.vale(irep-1)
  40 :       goto 30
  41 :   50  continue
  42 :       do 60 i=nbr,1,-1
  42 :        call ecrlog(vale(i))
  43 :   60  continue
  44 :       end
  45 :  
  46 :  
  47 :  
  48 :  

© Cast3M 2003 - All rights reserved.
Disclaimer