H            Y/                                                      PGM116
     F********** 気象データ・ランキング *******************************         
     FPGM116FMCF  E                    WORKSTN                                  
     F                                        RRN1  KSFILE SFREC01              
     F                                              KINFDS INFDS                
     FJAPANL01IF  E           K        DISK                                     
     F*****************************************************************         
     E                    DSPDTA   1024  1                入力 ﾃﾞｰﾀ             
     E                    SAVDTA   1024  1                SAVE-ﾃﾞｰﾀ             
     I*       読み取り ﾌｧｲﾙ の FORMAT を外部 DS として READ                     
     IDATADS    E DSJAPANL01                                                    
     I                                        11024 DSPDTA                      
     I*                                                                         
     I*         -( ｻﾌﾞ･ﾌｧｲﾙ の ﾌｧｲﾙ 情報 )-                                     
     I*                                                                         
     IINFDS       DS                                                            
     I*( ｶｰｿﾙ の行と桁の取り込み )                                              
     I                                    B 370 3710LINE                        
     I*  TOPRRN: 今表示している ｻﾌﾞ･ﾌｧｲﾙ の先頭の RRN                           
     I                                    B 378 3790TOPRRN                      
     I* BRRN : ｻﾌﾞﾌｧｲﾙ の ﾚｺｰﾄﾞNO ( 2 進数 )                                    
     I                                    B 376 3770BRRN                        
     I*( WORK 日付 YYMMDD ﾃﾞｰﾀ 構造  )                                          
     IDATEDS      DS                                                            
     I                                        1   20SRY                         
     I                                        1   80SRYMD                       
     I                                        3   80YYMMDD                      
     I                                        3   60YYMM                        
     I                                        5   80MMDD                        
     I                                        3   40YY                          
     I                                        5   60MM                          
     I                                        7   80DD                          
     C*   : ＫＥＹをファイルにセット                                            
     C*----------------------------------------------------+                    
     C           SETKEY    KLIST                           |                    
     C                     KFLD           AVTMP            |                    
     C                     KFLD           AVMAX            |                    
     C                     KFLD           JPCODE           |                    
     C*----------------------------------------------------+                    
     C*( *LOVAL のセット )                                                      
     C                     MOVE *HIVAL    AVTMP                                 
     C                     MOVE *HIVAL    AVMAX                                 
     C*                     |                                                   
     C           SETKEY    SETGTJAPANL01                                        
     C                     EXSR SFLCLR                                          
     C*   : ファイルの読み取り                                                  
     C                     Z-ADD1         TOPRRN                                
     C                     EXSR READ                                            
     C                     Z-ADD1         DSPREC                                
     C*( サブ・ファイルの表示 )                                                 
     C                     WRITEDSPEND01                                        
     C*----------------------------------------------------+                    
     C           DSPLY     TAG                             |                    
     C                     SETON                     4142  |SFL-DSPLY           
     C                     EXFMTSFCTL01                    |                    
     C                     SETOF                     4142  |                    
     C*----------------------------------------------------+                    
     C                     SETOF                     99                         
     C*( CF03 )- 終了                                                           
     C           *IN03     IFEQ *ON                        CF03                 
     C                     SETON                     LR                         
     C   LR                RETRN                                                
     C                     GOTO DSPLY                                           
     C                     END                             CF03                 
     C*( ROLL UP )- 次ページ                                                    
     C           *IN14     IFEQ *ON                                             
     C                     EXSR ROLLUP                                          
     C                     GOTO DSPLY                                           
     C                     END                                                  
     C*( 実行キー )                                                             
     C                     GOTO DSPLY                                           
     C*                                                                         
     C           END       TAG                                                  
     C******************************************************                    
     C           *INZSR    BEGSR                                                
     C******************************************************                    
     C                     SETON                     45                         
     C                     MOVE 14        GYOSU   20        行数                
     C                     MOVE 07        STRGYO  20        開始行�Y            
     C                     MOVE 20170101  SRYMD                                 
     C                     MOVE 910101    DATE    60                            
     C                     ENDSR                                                
     C******************************************************                    
     C           READ      BEGSR                                                
     C******************************************************                    
     C                     MOVE *BLANKS   EOF     1                             
     C                     SETOF                     5945                       
     C*( データ・ベースの検索 )                                                 
     C           RTNRED    TAG                                                  
     C*                                                                         
     C           TOPRRN    ADD  GYOSU     ENDRRN  40                            
     C                     SUB  1         ENDRRN                                
     C*                                                                         
     C           TOPRRN    DO   ENDRRN    RRN1    40       READ                 
     C           AGAIN     TAG                                                  
     C                     SETOF                     50                         
     C                     READPJAPANL01                 50                     
     C   50                MOVE 'E'       EOF     1                             
     C   50                GOTO REDEND                                          
     C*( 行 NO に入れる )                                                       
     C                     MOVE RRN1      GYO                                   
     C*( マイナス温度は赤色で表示 )                                             
     C           AVMIN     COMP 0                      61                       
     C*( ｻﾌﾞﾌｧｲﾙ へ更新 )                                                       
     C*----------------------------------------------------+                    
     C                     WRITESFREC01                    |                    
     C*----------------------------------------------------+                    
     C  N59                Z-ADDRRN1      DSPREC                                
     C  N59                SETON                     59                         
     C                     Z-ADDRRN1      LSTRRN  40                            
     C                     END                             READ                 
     C           REDEND    ENDSR                                                
     C******************************************************                    
     C           SFLCLR    BEGSR                                                
     C******************************************************                    
     C*( SFL クリヤー )                                                         
     C*----------------------------------------------------+                    
     C                     SETON                     44    |                    
     C                     WRITESFCTL01                    |                    
     C                     SETOF                     44    |                    
     C*----------------------------------------------------+                    
     C                     ENDSR                                                
     C******************************************************                    
     C           ROLLUP    BEGSR                                                
     C******************************************************                    
     C           EOF       IFEQ 'E'                                             
     C                     SETON                     6199  ERRMSG               
     C   99                Z-ADDLSTRRN    DSPREC                                
     C   99                GOTO UPEND                                           
     C                     END                                                  
     C           ENDRRN    ADD  1         TOPRRN                                
     C                     EXSR READ                                            
     C           UPEND     ENDSR