Télécharger la plaquette Cast3M


fr en

Télécharger choi.eso

Retour à la liste

Numérotation des lignes : 

  1. C CHOI      SOURCE    JC220346  18/12/04    21:15:10     9991           
  2. C  positionnement d'un ensemble de flags
  3. C
  4.       SUBROUTINE CHOI
  5.       IMPLICIT INTEGER(I-N)
  6. -INC CCOPTIO
  7. -INC CCNOYAU
  8.       external long
  9.       dimension iob(22)
  10.       logical vale(22)
  11.       character*(LONOM)   choix(22)
  12.       character*(LONOM+3) 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.  
  58.  

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