Télécharger la plaquette Cast3M


fr en

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