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