Download sais.eso

Back to the list

   1 : C SAIS      SOURCE    CHAT      11/05/27    21:15:28     6984           
   2 : C  Saisie interactive d'un objet
   3 : C
   4 :       SUBROUTINE SAIS
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : -INC CCOPTIO
   8 : -INC SMTEXTE
   9 :        character*8 LEGEND(1),type
  10 :        character*45 text
  11 :        character*80 chaine
  12 :         LEGEND(1)='   Ok  '
  12 :        call lircha(chaine,1,iretou)
  12 :        call lircha(type,1,iretou)
  13 :        if (ierr.ne.0) return
  14 :        ncou=16
  14 :        CALL TRINIT(25,DIOCAD,DIOCAD,TITREE,0.15,.TRUE.,ncou)
  15 :  400   CONTINUE
  15 :        CALL MENU(LEGEND,2,8)
  16 :        text=' '
  16 :        call trget(chaine,text)
  17 :        if( text(1:1) .ne. '''') then
  18 :          segini mtexte
  19 :          mtext=text
  20 :          ncart=45
  20 :          call ecrobj('TEXTE',mtexte)
  20 :          call lirobj(type,iobj,0,iretou)
  21 :          segsup mtexte
  22 :          if (iretou.ne.0)  goto 500
  22 :          call razpil
  23 :          goto 400
  24 :        else
  25 :          if( type.eq.'MOT     ') then
  26 :            do ifi=45,1,-1
  27 :              if(text(ifi:ifi).ne.' ') go to 401
  28 :            enddo
  29 :   401      continue
  30 :            ifi = ifi-1
  31 :            do ide=2,45
  32 :              if(text(ide:ide).ne.' ') go to 402
  33 :            enddo
  34 :   402      continue
  35 :            if(ide.gt.ifi) then
  35 :              call razpil
  36 :              go to 400
  37 :            endif           
  37 :            call ecrcha(text(ide:ifi))
  37 :            call ecrcha('MOT' )
  38 :            go to 500
  39 :          else 
  39 :            call razpil
  40 :            go to 400
  41 :          endif
  42 :        endif     
  43 :  500   CONTINUE
  43 :        call refus
  44 :       END
  45 : 
  46 :  
  47 :  
  48 :  
  49 :  
  50 :  
  51 :  
  52 :  
  53 :  

© Cast3M 2003 - All rights reserved.
Disclaimer