      PROGRAM BARG                                                                                                                  
C     PROGRAM BARG (INFILE,       INPUT,       OUTPUT,                  )       A2                                                  
C              TAPE=INFILE, TAPE5=INPUT, TAPE6=OUTPUT)                                                                              
C     ------------------------------------------------                          A2                                                  
C                                                                               A2                                                  
C     APR 25/13 - F.MAJAESS (INITIALIZE "YMAX"/"IDIV")                          A2                                                  
C     AUG 23/07 - B.MIVILLE - ORIGINAL VERSION                                                                                      
C                                                                               A2                                                  
CBARG - BAR GRAPH DIAGRAM                                               1  1 C  A1                                                  
C                                                                               A3                                                  
CAUTHORS - B. MIVILLE                                                           A3                                                  
C                                                                               A3                                                  
CPURPOSE - READ ONE ARRAY OF VALUES FROM A STANDARD CCCMA BINARY FILES AND      A3                                                  
C          PRODUCES A BAR GRAPH.                                                A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C   INFILE = ONE RECORD OF VALUES                                               A3                                                  
C                                                                               A3                                                  
CINPUT PARAMETER...                                                                                                                 
C                                                                               A5                                                  
C      CARD 1- MAIN CARD                                                        A5                                                  
C                                                                               A5                                                  
C      READ(5,5010) IA,IB,IC,IAC,IBCK,ISZ,IDIR,IHGRID,IVGRID,NINT               A5                                                  
C 5010 FORMAT(10X,11I5)                                                         A5                                                  
C                                                                               A5                                                  
C      IA     = COLOR OF ABOVE ZERO BARS (DEFAULT BLACK CODE 149)               A5                                                  
C      IB     = COLOR OF BELOW ZERO BARS (DEFAULT BLACK CODE 149)               A5                                                  
C      IC     = COLOR OF A SPECIFIC BAR DETERMINE BY IAC (DEFAULT NO COLOR)     A5                                                  
C      IAC    = BAR NUMBER TO BE COLORED WITH IC (DEFAULT NO BAR COLORED)       A5                                                  
C      IBCK   = COLOR OF THE BACKGROUND (DEFAULT WHITE CODE 140)                A5                                                  
C      ISZ    = WIDTH OF BAR IN PERCENTAGE OF DEFAULT VALUE (DEFAULT 85)        A5                                                  
C      IDIR   = ANGLE OF X-AXIS LABELS (DEFAULT 0 DEGREE)                       A5                                                  
C      IHGRID = HORIZONTAL GRID LINES (AT Y TICK MARKS)                         A5                                                  
C             = 0 NO HORIZONTAL GRID LINES (DEFAULT)                            A5                                                  
C             = 1 HORIZONTAL GRID LINES                                         A5                                                  
C      IVGRID = VERTICAL GRID SHADES (AT X LABELS)                              A5                                                  
C             = 0 NO VERTICAL GRID LINES (DEFAULT)                              A5                                                  
C             = 1 VERTICAL GRID LINES                                           A5                                                  
C      NINT   = INTERVAL AT WHICH YOU WANT THE XLABES TO BE VISIBLE (DEFAULT 1) A5                                                  
C             = 1 WILL DISPLAY EVERY XLABELS ON THE X-AXIS                      A5                                                  
C             = 2 WILL DISPLAY EVERY SECOND XLABELS, ETC.                       A5                                                  
C      IYLAB  = 0 PROGRAM DECIDE ON THE VALUE OF THE MAX Y AXIS LABEL AND       A5                                                  
C                 DIVIDE EVENLY THE INTERVALS  (DEFAULT)                        A5                                                  
C             = 1 EXPECT INPUT CARD AFTER Y AXIS TITLE CARD AND WILL READ THE   A5                                                  
C                 MIN Y AND MAX Y AXIS LABEL VALUES AND INTERVAL FOR TICK MARKS A5                                                  
C                                                                               A5                                                  
C      CARD 2- TITLE                                                            A5                                                  
C                                                                               A5                                                  
C      READ(5,5011) MTITLE                                                      A5                                                  
C 5011 FORMAT(10X,80A1)                                                         A5                                                  
C                                                                               A5                                                  
C      MTITLE = TITLE OF DIAGRAM (80 CHARACTERS MAXIMUM)                        A5                                                  
C                                                                               A5                                                  
C      CARD 3- X AXIS TITLE                                                     A5                                                  
C                                                                               A5                                                  
C      READ(5,5012) MXTITLE                                                     A5                                                  
C 5012 FORMAT(10X,40A1)                                                         A5                                                  
C                                                                               A5                                                  
C      MXTITLE = X AXIS TITLE (40 CHARACTERS MAXIMUM)                           A5                                                  
C                                                                               A5                                                  
C      CARD 4- Y AXIS TITLE                                                     A5                                                  
C                                                                               A5                                                  
C      READ(5,5012) MYTITLE                                                     A5                                                  
C 5012 FORMAT(10X,40A1)                                                         A5                                                  
C                                                                               A5                                                  
C      MYTITLE = Y AXIS TITLE (40 CHARACTERS MAXIMUM)                           A5                                                  
C                                                                               A5                                                  
C      CARD 5- Y AXIS LABELS                                                    A5                                                  
C                                                                               A5                                                  
C      READ(5,5013) YMINV, YMAXV, YINTV                                         A5                                                  
C 5013 FORMAT(10X,3G10.4)                                                       A5                                                  
C                                                                               A5                                                  
C      YMINV = Y MINIMUM AXIS VALUE                                             A5                                                  
C      YMAXV = Y MAXIMUM AXIS VALUE                                             A5                                                  
C      YINTV = Y INTERVAL AXIS VALUE FOR THE TICK MARKS                         A5                                                  
C                                                                               A5                                                  
C      CARD 6-...- X AXIS LABELS                                                A5                                                  
C                                                                               A5                                                  
C      DO K=1,NBAR,6                                                            A5                                                  
C         READ(5,5006) (ALAB(I),I=K,K+5)                                        A5                                                  
C      ENDDO                                                                    A5                                                  
C 5006 FORMAT(10X,6A10)                                                         A5                                                  
C                                                                               A5                                                  
C      ALAB = X-AXIS LABELS (MAXIMUM OF 10 CHARACTERS, RIGH JUSTIFY)            A5                                                  
C             MAXIMUM OF 400 LABELS, 6 PER LINES. NUMBER OF LABELS MUST MATCH   A5                                                  
C             WITH NBAR                                                         A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARD...                                                       A5                                                  
C+   .    :    .    :    .    :    .    :    .    :    .    :    .    :    .    A5                                                  
CBARG       100  120  119   37  350   55   90    1    1    4    1               A5                                                  
C         Main title                                                            A5                                                  
C         X-AXIS title                                                          A5                                                  
C         Y-AXIS title                                                          A5                                                  
C               -1.0       2.0       0.2                                        A5                                                  
C           2000/JAN  2000/FEB  2000/MAR  2000/APR  2000/MAY  2000/JUN          A5                                                  
C           2000/JUL  2000/AUG  2000/SEP  2000/OCT  2000/NOV  2000/DEC          A5                                                  
C           2001/JAN  2001/FEB  2001/MAR  2001/APR  2001/MAY  2001/JUN          A5                                                  
C           2001/JUL  2001/AUG  2001/SEP  2001/OCT  2001/NOV  2001/DEC          A5                                                  
C           2002/JAN  2002/FEB  2002/MAR  2002/APR  2002/MAY  2002/JUN          A5                                                  
C           2002/JUL  2002/AUG  2002/SEP  2002/OCT  2002/NOV  2002/DEC          A5                                                  
C                                                                               A5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * Store data, position and title.                                                                                             
C                                                                                                                                   
      INTEGER MOM,NMX                                                                                                               
      PARAMETER (NMX=400, NMXV=NMX*2)                                                                                               
      REAL VAL(NMX),YMAX                                                                                                            
      CHARACTER*16 YTICK,YTICKMX,YTICKMN,YTICKZ                                                                                     
      CHARACTER*1 NYTICK(16),NYTICKMX(16),NYTICKMN(16),NYTICKZ(16)                                                                  
      CHARACTER*80 NTITLE                                                                                                           
      CHARACTER*40 NXTITLE,NYTITLE                                                                                                  
      CHARACTER*1 MTITLE(80),MXTITLE(40),MYTITLE(40)                                                                                
      CHARACTER*10 ALAB(NMX)                                                                                                        
C                                                                                                                                   
C     * Array W stores hafton color values of the bars                                                                              
C                                                                                                                                   
      INTEGER W(NMX+2)                                                                                                              
C                                                                                                                                   
      REAL HSVV(3,NMX+2)                                                                                                            
C                                                                                                                                   
      EQUIVALENCE(NTITLE,MTITLE),(NXTITLE,MXTITLE),(NYTITLE,MYTITLE)                                                                
      EQUIVALENCE(YTICK,NYTICK),(YTICKMX,NYTICKMX),(YTICKMN,NYTICKMN)                                                               
      EQUIVALENCE(YTICKZ,NYTICKZ)                                                                                                   
                                                                                                                                    
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER IBUF,IDAT,MAXX                                                                                                        
      COMMON/ICOM/IBUF(8),IDAT(NMXV)                                                                                                
      DATA MAXX/NMXV/                                                                                                               
C                                                                                                                                   
C-------------------------------------------------------------------------                                                          
C                                                                                                                                   
C    * I/O FILES                                                                                                                    
C                                                                                                                                   
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,5,6)                                                                                                        
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ INPUT BAR VALUES                                                                                                       
C                                                                                                                                   
      CALL GETFLD2(1,VAL,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                  
C                                                                                                                                   
      NBAR=IBUF(5)                                                                                                                  
C                                                                                                                                   
      IF (NBAR.GT.NMX) THEN                                                                                                         
         WRITE(6,*) 'ERROR - NUMBER OF BARS GREATER THAN ',NMX                                                                      
         CALL                                      XIT('BARG',-1)                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * INITIALIZE COLOR TO BLACK FOR ALL BARS                                                                                      
C                                                                                                                                   
      DO I=1,NBAR                                                                                                                   
         W(I)=149                                                                                                                   
      ENDDO                                                                                                                         
C                                                                                                                                   
      W(NBAR+1)=140                                                                                                                 
C                                                                                                                                   
C     * READ INPUT CARDS                                                                                                            
C                                                                                                                                   
      READ(5,5010) IA,IB,IC,IAC,IBCK,ISZ,IDIR,IHGRID,IVGRID,NINT,IYLAB                                                              
C                                                                                                                                   
      IF(IA.EQ.0) IA=149                                                                                                            
      IF(IB.EQ.0) IB=IA                                                                                                             
      IF(IC.EQ.0.OR.IBCK.EQ.0) IC=IA                                                                                                
      IF(NINT.EQ.0) NINT=1                                                                                                          
C                                                                                                                                   
      DO I=1,NBAR                                                                                                                   
         IF(VAL(I).LT.0.) THEN                                                                                                      
            W(I)=IB                                                                                                                 
         ELSE                                                                                                                       
            W(I)=IA                                                                                                                 
         ENDIF                                                                                                                      
      ENDDO                                                                                                                         
C                                                                                                                                   
      IF(IAC.NE.0.AND.IC.NE.0) W(IAC)=IC                                                                                            
C                                                                                                                                   
C     * READ TITLE                                                                                                                  
C                                                                                                                                   
      READ(5,5011) MTITLE                                                                                                           
C                                                                                                                                   
C     * READ X-AXIS TITLE                                                                                                           
C                                                                                                                                   
      READ(5,5012) MXTITLE                                                                                                          
C                                                                                                                                   
C     * READ Y-AXIS TITLE                                                                                                           
C                                                                                                                                   
      READ(5,5012) MYTITLE                                                                                                          
C                                                                                                                                   
C     * READ Y-AXIS LABELS MIN,MAX,INT VALUES (IYLAB=1)                                                                             
C                                                                                                                                   
      IF(IYLAB.EQ.1) THEN                                                                                                           
           READ(5,5013) YMINV,YMAXV,YINTV                                                                                           
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * READ X-AXIS BAR LABELS                                                                                                      
C                                                                                                                                   
      DO K=1,NBAR,6                                                                                                                 
         READ(5,5006) (ALAB(I),I=K,K+5)                                                                                             
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * START GRAPHICS                                                                                                              
C                                                                                                                                   
      CALL PSTART                                                                                                                   
C                                                                                                                                   
C     * FONT                                                                                                                        
C                                                                                                                                   
      CALL PCSETI('FN', 21)                                                                                                         
C                                                                                                                                   
C     * COLOR                                                                                                                       
C                                                                                                                                   
      W(NBAR+1)=IBCK                                                                                                                
      W(NBAR+2)=141                                                                                                                 
      NCLRS=-(NBAR+2)                                                                                                               
      CALL DFCLRS(NCLRS,HSVV,W)                                                                                                     
C                                                                                                                                   
C     * USE COMPLEX CHARACTER SET OF  PLOTCHAR.                                                                                     
C                                                                                                                                   
      CALL PCSETI('CC',1)                                                                                                           
C                                                                                                                                   
C     * FIND MAXIMUM Y VALUE                                                                                                        
C                                                                                                                                   
      YBOUND1 = VAL(1)                                                                                                              
C                                                                                                                                   
      DO I=1,NBAR-2                                                                                                                 
         YBOUND1=AMAX1(YBOUND1,VAL(I+1),VAL(I+2))                                                                                   
      ENDDO                                                                                                                         
C                                                                                                                                   
      WRITE(6,*) 'MAXIMUM INPUT VALUE= ',YBOUND1                                                                                    
C                                                                                                                                   
C     * FIND MINIMUM Y VALUE                                                                                                        
C                                                                                                                                   
      YBOUND2 = VAL(1)                                                                                                              
                                                                                                                                    
      DO I=1,NBAR-2                                                                                                                 
         YBOUND2=AMIN1(YBOUND2,VAL(I+1),VAL(I+2))                                                                                   
      ENDDO                                                                                                                         
C                                                                                                                                   
      WRITE(6,*) 'MINIMUM INPUT VALUE= ',YBOUND2                                                                                    
C                                                                                                                                   
      IF(IYLAB.EQ.1) THEN                                                                                                           
         IF(YBOUND2.LT.YMINV) THEN                                                                                                  
            WRITE(6,*) 'ERROR MINIMUM DATA VALUE= ',YBOUND2                                                                         
            WRITE(6,*) 'IS SMALLER THEN MINIMUM Y LABEL VALUE= ',YMINV                                                              
            CALL                                    XIT('BARG',-2)                                                                  
         ENDIF                                                                                                                      
         IF(YBOUND1.GT.YMAXV) THEN                                                                                                  
            WRITE(6,*) 'ERROR MAXIMUM DATA VALUE= ',YBOUND1                                                                         
            WRITE(6,*) 'IS LARGER THAN MAXIMUM Y LABEL VALUE= ',YMAXV                                                               
            CALL                                    XIT('BARG',-3)                                                                  
         ENDIF                                                                                                                      
      ENDIF                                                                                                                         
                                                                                                                                    
C     * FIND MAXIMUM ABSOLUTE VALUE                                                                                                 
C                                                                                                                                   
      YSCALE=AMAX1(ABS(YBOUND1),ABS(YBOUND2))                                                                                       
      YMAX=YSCALE                                                                                                                   
      IDIV=4                                                                                                                        
C                                                                                                                                   
C     * ADJUST MAXIMUM ABSOLUTE VALUE TO A NICER VALUE                                                                              
C     * FOR THE Y-AXIS SCALE                                                                                                        
C                                                                                                                                   
      IF(IYLAB.NE.1) THEN                                                                                                           
         DO I=1,7                                                                                                                   
            YI=0.01*10.**I                                                                                                          
            YT=(YSCALE/YI)                                                                                                          
            IF(YT.LT.10.0.AND.YT.GE.1.0) THEN                                                                                       
               YTT=YT-INT(YT)                                                                                                       
               IF(YTT.GE.0.5) THEN                                                                                                  
                  YMAX=(INT(YT)+1.0)*YI                                                                                             
                  IDIV=4                                                                                                            
               ELSEIF(YTT.LT.0.5.AND.YTT.NE.0.) THEN                                                                                
                  YMAX=(INT(YT)+0.5)*YI                                                                                             
                  IDIV=5                                                                                                            
               ELSE                                                                                                                 
                  YMAX=INT(YT)*YI                                                                                                   
                  IDIV=4                                                                                                            
               ENDIF                                                                                                                
               GOTO 700                                                                                                             
            ENDIF                                                                                                                   
         ENDDO                                                                                                                      
C                                                                                                                                   
 700     WRITE(6,*) 'NEW MAXIMUM ABSOLUTE VALUE= ',YMAX                                                                             
      ENDIF                                                                                                                         
C                                                                                                                                   
C    * PLOTTING FRAME                                                                                                               
C                                                                                                                                   
      VXMN=0.15                                                                                                                     
      VXMX=0.98                                                                                                                     
      VYMN=0.15                                                                                                                     
      VYMX=0.90                                                                                                                     
      XMN=0.0                                                                                                                       
      XMX=1.0                                                                                                                       
      IF(IYLAB.NE.1) THEN                                                                                                           
         IF(YBOUND2.LT.0.) THEN                                                                                                     
            YMN=-YMAX                                                                                                               
         ELSE                                                                                                                       
            YMN=0.0                                                                                                                 
         ENDIF                                                                                                                      
         IF(YBOUND1.GT.0.) THEN                                                                                                     
            YMX=YMAX                                                                                                                
         ELSE                                                                                                                       
            YMX=0.0                                                                                                                 
         ENDIF                                                                                                                      
      ELSE                                                                                                                          
         YMN=YMINV                                                                                                                  
         YMX=YMAXV                                                                                                                  
      ENDIF                                                                                                                         
      WTIC=(YMX-YMN)*0.01                                                                                                           
      WYTIC=0.01                                                                                                                    
      WYLAB=0.02                                                                                                                    
      TTIC=(YMX-YMN)*0.015                                                                                                          
      CALL SET(VXMN,VXMX,VYMN,VYMX,XMN,XMX,YMN,YMX,1)                                                                               
      CALL GSCR(1,1,0.,0.,0.)                                                                                                       
      CALL GSCR(1,0,1.,1.,1.)                                                                                                       
      CALL GSTXCI(1)                                                                                                                
      CALL GSPMCI(1)                                                                                                                
      CALL GSPLCI(1)                                                                                                                
      CALL GSLN(1)                                                                                                                  
      CALL GSCLIP (0)                                                                                                               
      IF(IBCK.GE.100.AND.IBCK.LE.199) THEN                                                                                          
        MOM=IBCK-98                                                                                                                 
      ELSE                                                                                                                          
       IF(IBCK.GE.350.AND.IBCK.LE.420) MOM=IBCK-248                                                                                 
      ENDIF                                                                                                                         
      CALL GSFACI(MOM)                                                                                                              
      CALL DRBOX(XMN,YMN,(XMX-XMN),(YMX-YMN),1)                                                                                     
C                                                                                                                                   
C     * CALCULATE BAR SIZE BASED ON NUMBER OF BAR                                                                                   
C                                                                                                                                   
      X0=1.0/FLOAT(NBAR)                                                                                                            
      IF(ISZ.EQ.0.OR.ISZ.GT.100) ISZ=85                                                                                             
      XSZ=(X0*FLOAT(ISZ)/100.)                                                                                                      
      X1=(X0-XSZ)/2.                                                                                                                
C                                                                                                                                   
C     * DRAW MINIMUM AND MAXIMUM AND ZERO TICK MARKS                                                                                
C                                                                                                                                   
C      YZ=0.0                                                                                                                       
C      IF (YMAX .GT. 1998.) THEN                                                                                                    
C         WRITE(YTICKMX,7000) INT(YMX)                                                                                              
C         WRITE(YTICKMN,7000) INT(YMN)                                                                                              
C         WRITE(YTICKZ,7000) INT(YZ)                                                                                                
C      ELSEIF(YMAX.GT.10.) THEN                                                                                                     
C         WRITE(YTICKMX,7002) YMX                                                                                                   
C         WRITE(YTICKMN,7002) YMN                                                                                                   
C         WRITE(YTICKZ,7002) YZ                                                                                                     
C      ELSEIF(YMAX.LE.10..AND.YMAX.GT.0.1) THEN                                                                                     
C         WRITE(YTICKMX,7004) YMX                                                                                                   
C         WRITE(YTICKMN,7004) YMN                                                                                                   
C         WRITE(YTICKZ,7004) YZ                                                                                                     
C      ELSEIF(YMAX.LE.0.1) THEN                                                                                                     
C         WRITE(YTICKMX,7006) YMX                                                                                                   
C         WRITE(YTICKMN,7006) YMN                                                                                                   
C         WRITE(YTICKZ,7006) YZ                                                                                                     
C      ENDIF                                                                                                                        
C      CALL LINE(0.,YMN,0.-WYTIC,YMN)                                                                                               
C      CALL PLCHHQ(0.-WYLAB,YMN,                                                                                                    
C     1     YTICKMN(LSTRBEG(YTICKMN):LSTREND(YTICKMN)),0.012,0.,1.)                                                                 
C      CALL LINE(0.,YMX,0.-WYTIC,YMX)                                                                                               
C      CALL PLCHHQ(0.-WYLAB,YMX,                                                                                                    
C     1     YTICKMX(LSTRBEG(YTICKMX):LSTREND(YTICKMX)),0.012,0.,1.)                                                                 
C      CALL LINE(0.,0.,0.-WYTIC,0.)                                                                                                 
C      CALL PLCHHQ(0.-WYLAB,0.0,YTICKZ(LSTRBEG(YTICKZ):LSTREND(YTICKZ)),                                                            
C     1     0.012,0.,1.)                                                                                                            
C                                                                                                                                   
C     * DRAW X-AXIS LABELS AND GRID SHADES AT CERTAIN INTERVAL                                                                      
C                                                                                                                                   
      DO I=1,NBAR,NINT                                                                                                              
         X=X1+FLOAT(I-1)*X0                                                                                                         
         Y=.0                                                                                                                       
         SZX=XSZ                                                                                                                    
         SZY=VAL(I)                                                                                                                 
         XL=X-X1                                                                                                                    
         XR=X+X0-X1                                                                                                                 
         XT=X+SZX/2.                                                                                                                
         CALL PLCHHQ(XT,YMN-TTIC,ALAB(I),0.012,FLOAT(IDIR),1.)                                                                      
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * GRID EVERY SECOND SHADES                                                                                                    
C                                                                                                                                   
      IF(IVGRID.EQ.1) THEN                                                                                                          
         DO I=1,NBAR,2                                                                                                              
            X=X1+FLOAT(I-1)*X0                                                                                                      
            XL=X-X1                                                                                                                 
            CALL GSFACI(W(NBAR+2)-98)                                                                                               
            IF(YMN.LT.0..AND.YMX.GT.0..AND.IYLAB.NE.1) THEN                                                                         
               YYMX=2.0*YMX                                                                                                         
            ELSEIF(IYLAB.EQ.1) THEN                                                                                                 
               YYMX=YMX-YMN                                                                                                         
            ELSE                                                                                                                    
               YYMX=YMX                                                                                                             
            ENDIF                                                                                                                   
            CALL DRBOX(XL,YMN,X0,YYMX,0)                                                                                            
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DRAW TICK MARKS AND LABELS FOR Y-AXIS                                                                                       
C                                                                                                                                   
      IF(IYLAB.NE.1) THEN                                                                                                           
         DY=YMAX/FLOAT(IDIV)                                                                                                        
         IDIVPN=ABS((YMX-YMN)/DY)                                                                                                   
      ELSE                                                                                                                          
         DY=YINTV                                                                                                                   
         IDIVPN=ABS((YMX-YMN)/DY)                                                                                                   
      ENDIF                                                                                                                         
C     * POSITIVE                                                                                                                    
      DO I=0,IDIVPN                                                                                                                 
         YT=YMX-DY*FLOAT(I)                                                                                                         
         CALL LINE(0.,YT,0.-WYTIC,YT)                                                                                               
         IF (YMX .GT. 1998.) THEN                                                                                                   
            WRITE(YTICK,7000) YT                                                                                                    
         ELSEIF(YMX.GT.10.) THEN                                                                                                    
            WRITE(YTICK,7002) YT                                                                                                    
         ELSEIF(YMX.LE.10..AND.YMX.GT.0.1) THEN                                                                                     
            WRITE(YTICK,7004) YT                                                                                                    
         ELSEIF(YMX.LE.0.1) THEN                                                                                                    
C           WRITE(YTICK,7006) YT                                                                                                    
            WRITE(YTICK,7007) YT                                                                                                    
         ENDIF                                                                                                                      
         CALL PLCHHQ(0.-WYLAB,YT,YTICK(LSTRBEG(YTICK):LSTREND(YTICK)),                                                              
     1        0.012,0.,1.)                                                                                                          
         IF(IHGRID.EQ.1) CALL LINE(XMN,YT,XMX,YT)                                                                                   
      ENDDO                                                                                                                         
C     * NEGATIVE                                                                                                                    
      IF(YMN.LT.-1110.) THEN                                                                                                        
         DO I=1,IDIVM                                                                                                               
            YT=0.-DY*FLOAT(I)                                                                                                       
            CALL LINE(0.,YT,0.-WYTIC,YT)                                                                                            
            IF (YMN .GT. 1998.) THEN                                                                                                
               WRITE(YTICK,7000) INT(YT)                                                                                            
            ELSEIF(YMN.GT.10.) THEN                                                                                                 
               WRITE(YTICK,7002) YT                                                                                                 
            ELSEIF(YMN.LE.10..AND.YMX.GT.0.1) THEN                                                                                  
               WRITE(YTICK,7004) YT                                                                                                 
            ELSEIF(YMN.LE.0.1) THEN                                                                                                 
C              WRITE(YTICK,7006) YT                                                                                                 
               WRITE(YTICK,7007) YT                                                                                                 
            ENDIF                                                                                                                   
            IF((YTICK.EQ.'.0').OR.(YTICK.EQ.'.00').OR.                                                                              
     1         (YTICK.EQ.'.0000')) THEN                                                                                             
               WRITE(YTICK,7010)                                                                                                    
               IZERO=1                                                                                                              
            ELSE                                                                                                                    
               CALL PLCHHQ(0.-WYLAB,YT,                                                                                             
     1         YTICK(LSTRBEG(YTICK):LSTREND(YTICK)),0.012,0.,1.)                                                                    
               IZERO=0                                                                                                              
            ENDIF                                                                                                                   
            IF(IHGRID.EQ.1) CALL LINE(XMN,YT,XMX,YT)                                                                                
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DRAW ZERO LABEL IF NEEDED                                                                                                   
C                                                                                                                                   
      IF(IZERO.EQ.0) THEN                                                                                                           
         WRITE(YTICK,7010)                                                                                                          
         CALL LINE(0.,0.,0.-WYTIC,0.)                                                                                               
         CALL PLCHHQ(0.-WYLAB,0.0,                                                                                                  
     1    YTICK(LSTRBEG(YTICK):LSTREND(YTICK)),0.012,0.,1.)                                                                         
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C     * DRAW THE BARS                                                                                                               
C                                                                                                                                   
      DO I=1,NBAR                                                                                                                   
         IF(W(I).GE.100.AND.W(I).LE.199) MOM=W(I)-98                                                                                
         IF(W(I).GE.350.AND.W(I).LE.420) MOM=W(I)-248                                                                               
         CALL GSFACI(MOM)                                                                                                           
         X=X1+FLOAT(I-1)*X0                                                                                                         
         Y=.0                                                                                                                       
         SZX=XSZ                                                                                                                    
         SZY=VAL(I)                                                                                                                 
         XL=X+X0-X1                                                                                                                 
         XT=X+SZX/2.                                                                                                                
         CALL DRBOX(X,Y,SZX,SZY,1)                                                                                                  
         IF(I.NE.NBAR) CALL LINE(XL,YMN,XL,YMN-WTIC)                                                                                
C         CALL LINE(0.,YMN,0.-WYTIC,YMN)                                                                                            
C         CALL LINE(0.,YMX,0.-WYTIC,YMX)                                                                                            
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * DRAW PERIMETER AND ZERO LINE                                                                                                
C                                                                                                                                   
      CALL LINE(XMN,0.0,XMX,0.0)                                                                                                    
      CALL LINE(0.,YMN,0.,YMX)                                                                                                      
      CALL LINE(XMN,YMX,XMX,YMX)                                                                                                    
      CALL LINE(XMN,YMN,XMX,YMN)                                                                                                    
      CALL LINE(XMX,YMN,XMX,YMX)                                                                                                    
C                                                                                                                                   
C     * WRITE TITLES                                                                                                                
C                                                                                                                                   
      CALL SET(0.0,1.0,0.0,1.0,0.0,1.0,0.0,1.0,1)                                                                                   
C                                                                                                                                   
      XMID=(VXMX-VXMN)/2.+VXMN                                                                                                      
      YMID=(VYMX-VYMN)/2.+VYMN                                                                                                      
      CALL PLCHHQ(XMID,.95,NTITLE(LSTRBEG(NTITLE):LSTREND(NTITLE)),                                                                 
     1     0.016,0.,0.)                                                                                                             
      CALL PLCHHQ(XMID,.02,NXTITLE(LSTRBEG(NXTITLE):LSTREND(NXTITLE)),                                                              
     1     0.012,0.,0.)                                                                                                             
      CALL PLCHHQ(.02,YMID,NYTITLE(LSTRBEG(NYTITLE):LSTREND(NYTITLE)),                                                              
     1     0.012,90.,0.)                                                                                                            
                                                                                                                                    
      CALL FRAME                                                                                                                    
C                                                                                                                                   
  901 CONTINUE                                                                                                                      
C                                                                                                                                   
      CALL                                         PXIT('BARG',0)                                                                   
C-------------------------------------------------------------------------                                                          
 5006 FORMAT(10X,6A10)                                                                                                              
 5010 FORMAT(10X,11I5)                                                                                                              
 5011 FORMAT(10X,80A1)                                                                                                              
 5012 FORMAT(10X,40A1)                                                                                                              
 5013 FORMAT(10X,3G10.4)                                                                                                            
 7000 FORMAT(I10)                                                                                                                   
 7002 FORMAT(F6.1)                                                                                                                  
 7004 FORMAT(F7.2)                                                                                                                  
 7006 FORMAT(F7.4)                                                                                                                  
 7007 FORMAT(F7.3)                                                                                                                  
 7010 FORMAT ('0')                                                                                                                  
      END                                                                                                                           
