Download liresc.eso

Back to the list

   1 : C LIRESC    SOURCE    PV        11/04/08    21:16:09     6934           
   2 : C   Lire emascule a l'usage d'un esclave
   3 : C
   4 :       SUBROUTINE LIRESC(ITYPE,IRET,ICODE,IRETOU)
   5 :       IMPLICIT INTEGER(I-N)
   6 : -INC CCOPTIO
   7 : -INC CCASSIS
   8 :       character*(*) itype
   9 :       character*(8) ityp
  10 :       ith=0
  10 :       call ooonth(ith)
  10 :       if (ith.eq.0) call erreur(5)
  11 :       mescla=imescl(ith)
  12 :       iretou=0
  13 :       if (icode.eq.-1) then
  14 :         esoplu(imotlv)=.false.
  15 :         return
  16 :       endif
  17 :       if (ierr.ne.0) return
  18 :       ityp=' '
  19 :       if (itype.eq.'FLOTTANT  ') ityp='ENTIER'
  20 :       do 10 i=1,100
  21 :        if (esoplu(i)) goto 10
  22 : *  si on tombe sur un esclave on le remplace par sa valeur
  23 :        if (esopty(i).eq.'ESCLAVE') then
  24 :        mesres=esopva(i)
  25 :        segact mesres
  26 :        nesres=iesres
  27 :        segact nesres
  28 :        if (.not.loremp) then
  29 :    5   continue
  30 :           segdes nesres*record
  31 :           segdes mesres
  32 :           SEGACT NESRES*(ECR=1,MOD)
  33 :           segact mesres
  34 :             if (.not.loremp) then
  35 :              write(6,*) ' loremp pas vrai dans liresc '
  36 :              goto  5
  37 :             endif
  38 :        endif
  39 :           segdes mesres
  40 :        esopty(i)=esrety
  41 :        if ( esrety.eq.'LOGIQUE ') then
  42 :            esoplo(i)=esrelo
  43 :        elseif(esrety.eq.'FLOTTANT') then
  44 :            esopre(i)=esrere
  45 :        elseif (esrety.eq.'MOT     ') then
  46 :            esopch(i)=esrech
  47 :        else
  48 :            esopva(i)=esreva
  49 :        end if
  50 :          SEGDES NESRES
  51 :        endif
  52 : 
  53 : 
  54 : 
  55 :        if (itype.eq.'        ') goto 20
  56 :        if (itype.eq.esopty(i)) goto 20
  57 :        if (ityp .eq.esopty(i)) goto 20
  58 :   10  continue
  59 :       iretou=0
  60 :       if (icode.eq.1) then
  61 :         moterr(1:8)=itype
  61 :         call erreur(37)
  62 :        endif
  63 :        return
  64 :   20   continue
  65 :        imotlv=i
  66 :        iretou=1
  67 :        itype=esopty(i)
  68 :        iret=esopva(i)
  69 :        esoplu(i)=.true.
  70 :        if (itype.eq.'FLOTTANT') iret=i
  71 :        if (itype.eq.'MOT     ') iret=i
  72 :        if (itype.eq.'LOGIQUE ') iret=i
  73 :        end
  74 : 
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  

© Cast3M 2003 - All rights reserved.
Disclaimer