Download infopn.eso

Back to the list

   1 : C INFOPN    SOURCE    CHAT      05/01/13    00:36:39     5004           
   2 :       SUBROUTINE INFOPN(IAREA,IRET)                                             
   3 :       IMPLICIT INTEGER(I-N)
   4 :       SAVE LINDEX,SINDEX,NINDEX,ISTAT,IULENO,IUTINO                                           
   5 :       CHARACTER*4 IRET                                                          
   6 :       CHARACTER*(*) IAREA                                                       
   7 :       SEGMENT SINDEX                                                            
   8 :        CHARACTER*8 CINDEX((IND2-IND1+1)*5)                                     
   9 :        INTEGER      INDEX((IND2-IND1+1)*5)                                     
  10 :       ENDSEGMENT                                                                
  11 :       ISTAT=1                                                                   
  12 :       READ(33,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  13 :       if (iostat.ne.0) goto 1000
  14 :       ISTAT=0                                                                   
  15 :       SEGINI SINDEX                                                                                                            
  16 :       J=1                                                                       
  17 :       DO 1 I=IND1,IND2                                                          
  18 :       READ(33,REC=I,FMT=101,IOSTAT=IOSTAT)
  19 :      *  (CINDEX(J+K-1),INDEX(J+K-1),K=1,5)
  20 :       if (iostat.ne.0) goto 1000
  21 :       J=J+5                                                                    
  22 :     1 CONTINUE                                                                  
  23 :       NINDEX=J-1
  24 :       IUTINO=NINDEX
  25 :       IRET='9999' 
  26 :       READ(37,REC=1,FMT=100,IOSTAT=IOSTAT)IND11,IND21
  27 :       if (iostat.ne.0) goto 1000
  28 :       IND2=IND2 + IND21+1
  29 :       IND1 = IND1 + IND11
  30 :       SEGADJ SINDEX 
  31 :       DO 18 I=IND11,IND21                                                          
  32 :       READ(37,REC=I,FMT=101,IOSTAT=IOSTAT)
  33 :      *  (CINDEX(J+K-1),INDEX(J+K-1),K=1,5)
  34 :       if (iostat.ne.0) goto 1000
  35 :       J=J+5                                                                    
  36 :    18 CONTINUE 
  37 :       NINDEX=J-1                                                                                                                
  38 :  1000 RETURN                                                                    
  39 :       ENTRY INFOPO(IAREA,IRET)                                                      
  40 :       IRET='0'                                                                  
  41 :       IF (ISTAT.NE.0)RETURN                                                     
  42 :       IF (IAREA(1:8).EQ.'        ') GOTO 11                                     
  43 :       DO 10 I=NINDEX,1,-1                                                          
  44 :       IF(CINDEX(I).EQ.IAREA(1:8))GO TO 15                                       
  45 :    10 CONTINUE                                                                  
  46 :    11 CONTINUE                                                                  
  47 :       IRET='9999'                                                               
  48 :       RETURN                                                                    
  49 :    15 CONTINUE 
  50 :       IF(I.LE.IUTINO) THEN
  51 :         IULENO=33
  52 :       ELSE
  53 :         IULENO=37
  54 :       ENDIF                                                                 
  55 :       LINDEX=INDEX(I)+1                                                         
  56 :       RETURN                                                                    
  57 :       ENTRY INFOLI(IAREA,IRET)                                                  
  58 :       IRET='9999'                                                               
  59 :       IF (ISTAT.NE.0) RETURN                                                    
  60 :       IRET='0'                                                                  
  61 :       READ(IULENO,REC=LINDEX,FMT=102,IOSTAT=IOSTAT) IAREA
  62 :       if (iostat.ne.0) goto 1000
  63 :       IF(IAREA(1:4).EQ.'$$$$') IRET='9999'                                      
  64 :       LINDEX=LINDEX+1                                                           
  65 :       RETURN                                                                    
  66 :   100 FORMAT (2I6)                                                              
  67 :   101 FORMAT(5(A8,I6))                                                          
  68 :   102 FORMAT(A72)                                                               
  69 :       END                                                                       
  70 :  
  71 :  

© Cast3M 2003 - All rights reserved.
Disclaimer