home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 13.ddi / AGET.FOR next >
Encoding:
Text File  |  1987-08-10  |  3.7 KB  |  87 lines
  1.       FUNCTION AGET(IIPOS)   
  2.       INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW    
  3.       LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD  
  4.       COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,        
  5.      1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                      
  6.      2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                    
  7.       AGET = BLANK                                       
  8.       IPOSIT = IIPOS                                     
  9. 500   IF (IPOSIT.GT.MAXSTR.OR.IPOSIT.LE.0) RETURN              
  10.       IF ((BEGIN+IPOSIT-1).LE.80) AGET = LINE (BEGIN+IPOSIT-1)
  11.       AGETW = AGET                                         
  12.       RETURN    
  13.       END  
  14.       FUNCTION IGET(II)     
  15.       INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW      
  16.       LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1         
  17.       COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                    
  18.      1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                     
  19.      2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT              
  20.       COMMON/FRECNM/MULTIP                                    
  21.       LOGICAL MODE   
  22.       DOUBLE PRECISION RNUMBR,DECIMA                           
  23.       DATA    IPER/1H./,LETE/1HE/,LETD/1HD/                   
  24.       II=0                                                     
  25.       MODE = .FALSE.    
  26.       IGET = .FALSE.   
  27. 100   IF(MULTIP.GT.0)GO TO 200    
  28.       IF (.NOT.GETWRD(GET001))RETURN
  29.       IF (LENGTH.EQ.0) RETURN
  30.       RNUMBR = DECIMA(ERROR)                           
  31.       IF(MULTIP.GT.0)GO TO 200    
  32.       IF (ERROR.AND.EPOINT.EQ.1) EPOINT = BEGIN    
  33.       IF (MODE)XX = RNUMBR                                  
  34.       IF (.NOT.MODE) II = RNUMBR    
  35.       IGET=ERR1(ERR001)    
  36.       RGET=ERR1(ERR001)    
  37.       RETURN   
  38. 200   MULTIP=MULTIP-1    
  39.       RETURN  
  40.       END    
  41.       FUNCTION AGETW(AGE001)  
  42.       INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW        
  43.       LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD                       
  44.       COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                 
  45.      1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                       
  46.      2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                 
  47.       AGETW = BLANK   
  48.       IPOSIT = 1   
  49.       IF (.NOT.GETWRD(GET001))RETURN                    
  50.        IF (LENGTH.EQ.0) RETURN
  51.       DO 450 ILOOP=BEGIN,80                                        
  52.       IF (LINE(ILOOP).EQ.ICOMMA) GO TO 460                         
  53. 450   CONTINUE     
  54. 460   MAXSTR = ILOOP - BEGIN    
  55. 500   IF (IPOSIT.GT.MAXSTR.OR.IPOSIT.LE.0) RETURN                  
  56.       IF ((BEGIN+IPOSIT-1).LE.80) AGET = LINE (BEGIN+IPOSIT-1)
  57.       AGETW = AGET   
  58.       RETURN    
  59.       END  
  60.       FUNCTION RGET(XX) 
  61.       INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,A
  62.       LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1     
  63.       COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,          
  64.      1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,             
  65.      2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT               
  66.       COMMON/FRECNM/MULTIP                                     
  67.       LOGICAL MODE     
  68.       DOUBLE PRECISION RNUMBR,DECIMA    
  69.       DATA    IPER/1H./,LETE/1HE/,LETD/1HD/    
  70.       MODE = .TRUE.    
  71.       RGET = .FALSE.   
  72.       XX=0.0    
  73. 100   IF(MULTIP.GT.0)GO TO 200  
  74.       IF (.NOT.GETWRD(GET001))RETURN
  75.       IF (LENGTH.EQ.0) RETURN
  76.       RNUMBR = DECIMA(ERROR)                        
  77.       IF(MULTIP.GT.0)GO TO 200    
  78.       IF (ERROR.AND.EPOINT.EQ.1) EPOINT = BEGIN             
  79.       IF (MODE)XX = RNUMBR   
  80.       IF (.NOT.MODE) II = RNUMBR  
  81.       IGET=ERR1(ERR001)   
  82.       RGET=ERR1(ERR001)   
  83.       RETURN   
  84. 200   MULTIP=MULTIP-1  
  85.       RETURN    
  86.       END   
  87.