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.  
  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*(LONOM+3) choi2(23)
  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=7
  22.       choi2(1)='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.   30  continue
  36.       do 20 i=1,nbr
  37.         if (vale(i)) then
  38.           choi2(i+1)=oui//choix(i)
  39.         else
  40.           choi2(i+1)=non//choix(i)
  41.         endif
  42.   20  continue
  43.       CALL MENU(choi2,nbr+1,11)
  44.       call trmess(messag(1:long(messag)))
  45.       CALL TRaff(ICLE)
  46.       irep=icle+1
  47.       if (irep.eq.1) goto 50
  48.       vale(irep-1)=.not.vale(irep-1)
  49.       goto 30
  50.   50  continue
  51.       do 60 i=nbr,1,-1
  52.        call ecrlog(vale(i))
  53.   60  continue
  54.       end
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  

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