      PROGRAM BAR                                                                                                                   
C     PROGRAM BAR (Y,           INPUT,       OUTPUT,                    )       A2                                                  
C    1           TAPE1=Y, TAPE5=INPUT, TAPE6=OUTPUT)                                                                                
C     ----------------------------------------------                            A2                                                  
C                                                                               A2                                                  
C     AUG 23/07 - B. MIVILLE (ORIGINAL VERSION)                                 A2                                                  
C                                                                                                                                   
CBAR     - BAR CHARTS                                                   1  1 C  A1                                                  
C                                                                               A3                                                  
CAUTHORS - B. MIVILLE                                                           A3                                                  
C                                                                               A3                                                  
CPURPOSE - READ INPUT FIELD (Y) AND PLOT BAR CHARTS.                            A3                                                  
C                                                                               A3                                                  
CINPUT FILES...                                                                 A3                                                  
C                                                                               A3                                                  
C      Y = VALUES OF BAR TO BE PLOTTED ON Y-AXIS                                A3                                                  
C          READS ONE RECORD WITH IBUF(5) VALUES                                 A3                                                  
C                                                                               A3                                                  
CCARDS READ...                                                                  A5                                                  
C                                                                               A5                                                  
C      THREE CARDS                                                              A5                                                  
C                                                                               A5                                                  
C      CARD 1:  OPTIONS                                                         A5                                                  
C      -------                                                                  A5                                                  
C      OPTION CARD, NO OPTIONS YET                                              A5                                                  
C                                                                               A5                                                  
C      CARD 2:  TITLES FOR X AND Y AXIS AND TOP TITLE                           A5                                                  
C      -------                                                                  A5                                                  
C      READ (5,5004,END=902) IAX,JAX,TITLE                                      A5                                                  
C 5004 FORMAT(2A20,A40)                                                         A5                                                  
C                                                                               A5                                                  
C      IAX   = 20 CHAR. LABEL OF X-AXIS                                         A5                                                  
C      JAX   = 20 CHAR. LABEL OF Y-AXIS                                         A5                                                  
C      TITLE = 40 CHAR. TITLE LABEL OF PLOT                                     A5                                                  
C                                                                               A5                                                  
C      NOTE - ALL LEADING AND TRAILING SPACES TO THE LABELS ARE STRIPPED        A5                                                  
C             AND THEY ARE CENTERED AUTOMATICALLY.                              A5                                                  
C                                                                               A5                                                  
C      CARD 3:  X-AXIS BAR LABELS                                               A5                                                  
C      -------                                                                  A5                                                  
C      IF NLAB <= 12, CARD 3 will read one line.                                A5                                                  
C                                                                               A5                                                  
C      READ(5,5006) NLAB, IDIR, (ALAB(I),I=1,12)                                A5                                                  
C 5006 FORMAT(10X,2I5,12A5)                                                     A5                                                  
C                                                                               A5                                                  
C      NLAB        NUMBER OF DIFFERENT X-AXIS BAR LABELS  (MAXIMUM IS 36)       A5                                                  
C      IDIR        ORIENTATION OF X-AXIS LABELS                                 A5                                                  
C                  0 - HORIZONTAL, DEFAULT                                      A5                                                  
C                  1 - VERTICAL                                                 A5                                                  
C      ALAB(NLAB)  NLAB CHARACTER LABELS (MAXIMUM A5 EACH)                      A5                                                  
C                                                                               A5                                                  
C      IF 13 <= NLAB <= 24,  CARD 3 will read two lines.                        A5                                                  
C                                                                               A5                                                  
C      READ(5,5006) NLAB, IDIR, (ALAB(I),I=1,12)                                A5                                                  
C 5006 FORMAT(10X,2I5,12A5)                                                     A5                                                  
C      READ(5,5007) NLAB, (ALAB(I),I=13,NLAB)                                   A5                                                  
C 5007 FORMAT(20X,12A5)                                                         A5                                                  
C                                                                               A5                                                  
C      IF 25 <= NLAB <= 36,  CARD 3 will read three lines.                      A5                                                  
C                                                                               A5                                                  
C      READ(5,5006) NLAB, IDIR, (ALAB(I),I=1,12)                                A5                                                  
C 5006 FORMAT(10X,2I5,12A5)                                                     A5                                                  
C      READ(5,5007) NLAB, (ALAB(I),I=13,24)                                     A5                                                  
C      READ(5,5007) NLAB, (ALAB(I),I=25,NLAB)                                   A5                                                  
C 5007 FORMAT(20X,12A5)                                                         A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARDS...                                                      A5                                                  
C                                                                               A5                                                  
C* BAR.  (No options yet)                                                       A5                                                  
C* MONTH            PRECIPITATION (MM)  MONTHLY RAIN DISTRIBUTION               A5                                                  
C*           12    1  JAN  FEB  MAR  APR  MAY  JUN  JUL  AUG  SEP  OCT  NOV  DECA5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * MAXIMUM NUMBER OF BARS IS IM                                                                                                
C     * MAXIMUM NUMBER OF BARS ALLOWED IS BOUND BY "NDIM" VALUE.                                                                    
C                                                                                                                                   
      PARAMETER (IM=60,IM2=IM*2)                                                                                                    
      PARAMETER ( NDIM=40, NCLS=40, NWRK=163 )                                                                                      
                                                                                                                                    
      LOGICAL OK                                                                                                                    
      INTEGER IBUF,IDAT,MAXX                                                                                                        
      COMMON/ICOM/IBUF(8),IDAT(IM2)                                                                                                 
      DATA MAXX/IM2/                                                                                                                
C                                                                                                                                   
      CHARACTER*1 IFC                                                                                                               
      REAL  DAT1(NDIM,2), WORK(NWRK)                                                                                                
      REAL  CLASS(NCLS+1)                                                                                                           
      REAL  SPAC(2)                                                                                                                 
C                                                                                                                                   
      CHARACTER*5 ALAB(IM)                                                                                                          
      CHARACTER*280 TALAB                                                                                                           
      CHARACTER*20 IAX,JAX                                                                                                          
      CHARACTER*40 TITLE                                                                                                            
      CHARACTER*80 LINE                                                                                                             
      EQUIVALENCE (ALAB,TALAB)                                                                                                      
      REAL YBAR(IM)                                                                                                                 
      REAL WINDOW(4)                                                                                                                
C                                                                                                                                   
C     * DECLARE NCAR PLUGINS EXTERNAL, SO CORRECT VERSION ON SGI                                                                    
C                                                                                                                                   
       EXTERNAL BFCRDF,BAR_HSTOPC,BAR_HSTOPL,BAR_HSTOPR,HISTO,                                                                      
     1          PSTART,PXIT,R_HSTOPC                                                                                                
                                                                                                                                    
C                                                                                                                                   
C     * DECLARE BLOCK DATAS EXTERNAL, SO INITIALIZATION HAPPENS                                                                     
C                                                                                                                                   
      EXTERNAL BAR_HSTBKD                                                                                                           
                                                                                                                                    
      DATA WINDOW /-1.,.7,.3,.7/                                                                                                    
C--------------------------------------------------------------------------------                                                   
C                                                                                                                                   
      NF=3                                                                                                                          
      CALL JCLPNT(NF,1,5,6)                                                                                                         
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ INPUT PARAMETERS FROM INPUT CARD (NO OPTIONS YET)                                                                      
C                                                                                                                                   
      READ(5,5002) LINE                                                                                                             
C                                                                                                                                   
C     * READ AXIS AND TOP TITLE                                                                                                     
C                                                                                                                                   
      READ (5,5004) IAX,JAX,TITLE                                                                                                   
C                                                                                                                                   
C     * READ X-AXIS BAR LABELS                                                                                                      
C                                                                                                                                   
      READ(5,5006) NLAB,IDIR,(ALAB(I),I=1,12)                                                                                       
C                                                                                                                                   
      IF (NLAB.GT.36) THEN                                                                                                          
         WRITE(6,*) 'ERROR - NUMBER OF BARS GREATER THAN 36'                                                                        
         CALL                                      XIT('BAR',-1)                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SET X-AXIS LABEL ANGLE                                                                                                      
C                                                                                                                                   
      IANG=0                                                                                                                        
      IF(IDIR.EQ.1) IANG=90                                                                                                         
C                                                                                                                                   
      IF(NLAB.GT.12.AND.NLAB.LE.24) THEN                                                                                            
         READ(5,5007) (ALAB(I),I=13,NLAB)                                                                                           
      ELSEIF(NLAB.GT.24.AND.NLAB.LE.36) THEN                                                                                        
         READ(5,5007) (ALAB(I),I=13,24)                                                                                             
         READ(5,5007) (ALAB(I),I=25,NLAB)                                                                                           
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * READ IN Y-AXIS BAR VALUES                                                                                                   
C                                                                                                                                   
      CALL GETFLD2(1,YBAR,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                 
C                                                                                                                                   
C     * START PLOTTING PROCESS                                                                                                      
C                                                                                                                                   
      CALL PSTART                                                                                                                   
      CALL GSFAIS (1)                                                                                                               
      CALL BFCRDF(0)                                                                                                                
C                                                                                                                                   
      CALL GSCR(1, 0, 1.0, 1.0, 1.0)                                                                                                
      CALL GSCR(1, 1, 0.0, 0.0, 0.0)                                                                                                
C                                                                                                                                   
C     * Change the Plotchar special character code from a : to a @                                                                  
C                                                                                                                                   
      IFC(1:1) = '@'                                                                                                                
      CALL PCSETC('FC',IFC)                                                                                                         
C                                                                                                                                   
C     * (First call HSTOPL('DEF=ON') to activate all default options.)                                                              
C                                                                                                                                   
      CALL BAR_HSTOPL('DE=ON')                                                                                                      
C                                                                                                                                   
C     * Flush PLOTIT's buffers.                                                                                                     
C                                                                                                                                   
      CALL PLOTIT(0,0,0)                                                                                                            
C                                                                                                                                   
C     * SET BAR CHARTS PARAMETERS                                                                                                   
C                                                                                                                                   
      IFLAG = 3                                                                                                                     
      NCLASS = NLAB                                                                                                                 
      NPTS2 = NLAB                                                                                                                  
C                                                                                                                                   
      DO 200 I=1,NPTS2                                                                                                              
         DAT1(I,1)=YBAR(I)                                                                                                          
         CLASS(I)=FLOAT(I)                                                                                                          
 200  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * (First call HSTOPL('DEF=ON') to activate all default options.)                                                              
C                                                                                                                                   
      CALL BAR_HSTOPL('DE=ON')                                                                                                      
C                                                                                                                                   
C      CALL HSTOPI('COL=ON',2,0,COLORS,8)                                                                                           
C                                                                                                                                   
C     * Choose large, horizontal alphanumeric labels for class labels.                                                              
C                                                                                                                                   
      CALL PCSETI('FN - FONT NUMBER OR NAME', 21)                                                                                   
      CALL BAR_HSTOPC('TI=ON',TITLE,7,3)                                                                                            
      CALL BAR_HSTOPL('PR=ON')                                                                                                      
      CALL BAR_HSTOPC('FQ=ON',JAX,7,3)                                                                                              
      CALL BAR_HSTOPC('FO=ON','(F5.0)',NLAB,3)                                                                                      
      ISZ=3                                                                                                                         
      IF(NLAB.GT.24) ISZ=1                                                                                                          
      CALL HSTOPI('CLA=ON',ISZ,IANG,DUMMY,8)                                                                                        
      CALL BAR_HSTOPC('CH=ON',TALAB,NLAB,5)                                                                                         
      CALL BAR_HSTOPC('LA=ON',IAX,7,3)                                                                                              
      SPAC(1) = 2.0                                                                                                                 
C      SPAC(2) = -1.5                                                                                                               
      CALL BAR_HSTOPR('SP=ON',SPAC,1)                                                                                               
      CALL BAR_HSTOPL('PER=OFF')                                                                                                    
      CALL BAR_HSTOPR('WIN=OFF',WINDOW,4)                                                                                           
C      CALL HSTOPL('PRM=ON')                                                                                                        
C      CALL HSTOPL('DRL=ON')                                                                                                        
C      CALL HSTOPL('SHA=OFF')                                                                                                       
C                                                                                                                                   
C     * The second argument must be the actual dimension size of DAT1.                                                              
C                                                                                                                                   
      CALL HISTO(DAT1, NDIM, NPTS2, IFLAG, CLASS, NCLASS, WORK, NWRK)                                                               
C                                                                                                                                   
C      CALL FRAME                                                                                                                   
      CALL                                         PXIT('BAR',0)                                                                    
C                                                                                                                                   
C----------------------------------------------------------------------------                                                       
 5002 FORMAT(A80)                                                                                                                   
 5004 FORMAT(2A20,A40)                                                                                                              
 5006 FORMAT(10X,2I5,12A5)                                                                                                          
 5007 FORMAT(20X,12A5)                                                                                                              
C                                                                                                                                   
      END                                                                                                                           
